CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
C
C  NAME : READUMP_NMC_DATA.F
C
C  USAGE : THIS PROGRAM READS UARS LEVEL 3 NMC DATA FILES DISTRIBUTED 
C          FROM THE GSFC DAAC.  TO RUN THIS PROGRAM, TYPE IN THE PROGRAM 
C          NAME. THE PROGRAM WILL PROMPT YOU FOR THE METADATA FILE NAME
C          (*MERA EXTENSION).
C          EXAMPLE: READUMP_NMC_DATA 
C                   PLEASE ENTER MATA DATA FILE NAME BELLOW :
C                   CORR_ZNMC_STEMP_D0090.V0001_C01_META
C
C  DESCRIPTION : THIS PROGRAM FIRST OPENS THE METADATA FILE (*.*META) 
C                TO GET THE DATA FILE NAME (*.*PROD), AND ITS PHYSICAL 
C                RECORD SIZE.  THE DATA FILE IS THEN OPENED, AND ITS
C                CONTENTS ARE READ AND DUMPED TO THE SCREEN.
C
C  AUTHOR : KE - JUN SUN   HUGHES_STX
C
C  DATE : FEBRUARY 2, 1994
C
C  LIMITATIONS : THIS PROGRAM AND THE DATA IT READS ARE DESIGNED FOR 
C              MACHINES RUNNING A UNIX OPERATING SYSTEM, AND HAVING  
C              32-BIT ARCHITECTURE. IEEE FLOATING POINT AND/OR INTEGER  
C              VALUES WILL NOT TRANSLATE CORRECTLY ON OTHER MACHINES!
C
C  NOTES : SINCE THIS PROGRAM USES THE METADATA FILE (*.*META) TO GET 
C          THE DATA FILE NAME (*.*PROD) AND RECORD SIZE, BOTH THE DATA 
C          FILE AND ITS CORRESPONDING METADATA FILE MUST BE IN THE SAME 
C          DIRECTORY.
C          NAGWare (nag_decs and nag_pfort) AND ftnchek WERE USED
C          ON THIS PROGRAM TO ENHANCE NETWORK PORTABILITY.
C
C  ALGORITHM INFORMATION : NO CALCULATION IS PERFORMED IN THIS PROGRAM.
C
C  VERSION : 0
C
C  TO COMPILE THIS PROGAM :
C         f77 -o READUMP_NMC_DATA READUMP_NMC_DATA.F
C       or for SUN machines
C         f77 -DSUNF -o READUMP_NMC_DATA READUMP_NMC_DATA.F
C     EXECUTABLE CODE WILL BE NAMED READUMP_NMC_DATA
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC


C--------------------------------------------------------------
C  PROMPT FOR AND OPEN SPECIFIC NMC CORRELATIVE META DATA FILE
C--------------------------------------------------------------

C     .. Local Scalars ..
      CHARACTER DPUNIT*20,TMIDC*24,CORPAR*48,DATAFN*170,METAFN*170,
     +          CMT*80,CSFDU*88,CUARSH*212,LINE*255
      INTEGER COL,DTYPE,I,IRDATA,RECSIZ,RLEN,ROW,NUMREC
      REAL XI,XJ
C     ..
C     .. Local Arrays ..
      INTEGER IARRAY(5),SFTYPE(2)
      REAL GRID(65,65),NLTGRD(65,65),NLNGRD(65,65),SFVAL(2),
     +     SLTGRD(65,65),SLNGRD(65,65)
C     ..
C     .. External Subroutines ..
      EXTERNAL W3FB05
C     ..
C     .. Intrinsic Functions ..
      INTRINSIC FLOAT
C     ..

      DO 666 I = 1,170
       DATAFN(I:I) = ' '
 666  CONTINUE

C
C     ** REMOVE THE C-COMMENT BELOW IF USING PROGRAM OUT OF SCRIPT
C     WRITE (6,FMT=*) ' PLEASE ENTER NMC META DATA FILE NAME '
      READ (5,FMT='(A)') METAFN

      OPEN (UNIT=20,FILE=METAFN,STATUS='OLD',ERR=991)

C   SKIP 9 LINES IN META FILE

      DO 101 I = 1,9
          READ (20,FMT=50) LINE
  101 CONTINUE

C   GET FILE NAME FROM 10TH LINE OR FROM META DATA FILE

      READ (20,FMT=50) LINE
C      DO 112 I = 1,70
C          DATAFN(I:I) = LINE(14+I:14+I)
C  112 CONTINUE

      I = 1
      DO 777 WHILE (METAFN(I:I).NE.' ')
       I = I + 1
 777  CONTINUE
      I = I - 4
      DO 888 K = 1,I
        DATAFN(K:K) = METAFN(K:K)
 888  CONTINUE
      DATAFN(I:I+4) = 'PROD'

C   SKIP ONE LINE


      READ (20,FMT=50) LINE

C   GET RECORD SIZE

      READ (20,FMT=50) LINE
   50 FORMAT (A80)

      READ (LINE(17:21),FMT=303) RECSIZ
  303 FORMAT (I5)

C   CLOSE META FILE

      CLOSE (20)


      WRITE (6,FMT=*) '  '
      WRITE (6,FMT=*) '  '
      WRITE (6,FMT=*) ' READING ',DATAFN

C----------------------------------------------------------
C  NOTE: SGI AND HP READ 4 BYTE WORDS, SUN READS 1 BYTE.
C        ADDED BY JAMES JOHNSON 09/27/94.
C----------------------------------------------------------
#ifndef SUNF
      RLEN=RECSIZ/4
#endif
#ifdef SUNF
      RLEN=RECSIZ
#endif

      OPEN (UNIT=10,FILE=DATAFN,STATUS='OLD',FORM='UNFORMATTED',ERR=992,
     +     ACCESS='DIRECT',RECL=RLEN)
C----------------------------------------------------------------
C  CALL SUBROUTINE W3FB05  TO FILL NORTHERN/SOUTHERN LAT/LON GRID
C----------------------------------------------------------------
      DO 111 ROW = -32,32
          XJ = FLOAT(ROW)
          DO 222 COL = -32,32
              XI = FLOAT(COL)
              CALL W3FB05(XI,XJ,381.0,80.0,NLTGRD(COL+33,ROW+33),
     +                    NLNGRD(COL+33,ROW+33))
               IF (NLNGRD(COL+33,ROW+33).GE.180.0) THEN
                 NLNGRD(COL+33,ROW+33)=360.0-NLNGRD(COL+33,ROW+33)
               ELSE IF(NLNGRD(COL+33,ROW+33).LE.180.0) THEN
                 NLNGRD(COL+33,ROW+33)=-NLNGRD(COL+33,ROW+33)
               ENDIF

              CALL W3FB05(XI,XJ,-381.0,260.0,SLTGRD(COL+33,ROW+33),
     +                    SLNGRD(COL+33,ROW+33))
               IF (SLNGRD(COL+33,ROW+33).GE.180.0) THEN
                 SLNGRD(COL+33,ROW+33)=360.0-SLNGRD(COL+33,ROW+33)
               ELSE IF(SLNGRD(COL+33,ROW+33).LE.180.0) THEN
                 SLNGRD(COL+33,ROW+33)=-SLNGRD(COL+33,ROW+33)
               ENDIF

  222     CONTINUE
  111 CONTINUE

C-------------------------------------------------------
C  READ SFDU AND HEADER INFORMATION IN FIRST RECORD
C-------------------------------------------------------
#ifdef SUNF
      READ (10,REC=1,IOSTAT=IOSTT,END=993) CSFDU,CUARSH,CMT,CORPAR
#endif
#ifndef SUNF
      READ (10,REC=1,IOSTAT=IOSTT,ERR=993) CSFDU,CUARSH,CMT,CORPAR
#endif

      WRITE (6,FMT=*) ' '
      WRITE (6,FMT=*) '   ------------------------- '
      WRITE (6,FMT=*) '   SFDU INFORMATION FOR FILE '
      WRITE (6,FMT=*) '   ------------------------- '
      WRITE (6,FMT=*) '   TZ FIELD :  ',CSFDU(1:12)
      WRITE (6,FMT=*) '   LZ FIELD :  ',CSFDU(13:20)
      WRITE (6,FMT=*) '   TI FIELD :  ',CSFDU(21:32)
      WRITE (6,FMT=*) '   LI FIELD :  ',CSFDU(33:40)
      WRITE (6,FMT=*) '   VI FIELD :  ',CSFDU(41:88)
      WRITE (6,FMT=*) ' '
      WRITE (6,FMT=*) ' '
      WRITE (6,FMT=*) '   -------------------------------- '
      WRITE (6,FMT=*) '   UARS HEADER INFORMATION FOR FILE '
      WRITE (6,FMT=*) '   -------------------------------- '
      WRITE (6,FMT=*) '   PROJECT NAME    :  ',CUARSH(1:4)
      WRITE (6,FMT=*) '   UARS PI         :  ',CUARSH(5:24)
      WRITE (6,FMT=*) '   UARS CMI        :  ',CUARSH(25:44)
      WRITE (6,FMT=*) '   CORR DATA CLASS :  ',CUARSH(45:52)
      WRITE (6,FMT=*) '   INSTRUMENT TYPE :  ',CUARSH(53:64)
      WRITE (6,FMT=*) '   OBS STATION ID  :  ',CUARSH(65:76)
      WRITE (6,FMT=*) '   CORR DATA FT ID :  ',CUARSH(77:88)
      WRITE (6,FMT=*) '   FILE START TIME :  ',CUARSH(89:111)
      WRITE (6,FMT=*) '   FILE STOP TIME  :  ',CUARSH(112:134)
      WRITE (6,FMT=*) '   MAXIMUM LAT     :  ',CUARSH(135:141)
      WRITE (6,FMT=*) '   MINIMUM LAT     :  ',CUARSH(142:148)
      WRITE (6,FMT=*) '   MAXIMUM LON     :  ',CUARSH(149:155)
      WRITE (6,FMT=*) '   MINIMUM LON     :  ',CUARSH(156:162)
      WRITE (6,FMT=*) '   MAXIMUM ALT KM  :  ',CUARSH(163:170)
      WRITE (6,FMT=*) '   MINIMUM ALT KM  :  ',CUARSH(171:178)
      WRITE (6,FMT=*) '   MAXIMUM ALT MB  :  ',CUARSH(179:186)
      WRITE (6,FMT=*) '   MINIMUM ALT MB  :  ',CUARSH(187:194)
      WRITE (6,FMT=*) '   RECORD SIZE     :  ',CUARSH(195:200)
      WRITE (6,FMT=*) '   NUM REC FILE    :  ',CUARSH(201:206)
      WRITE (6,FMT=*) '   DATA QUALITY 1  :  ',CUARSH(207:209)
      WRITE (6,FMT=*) '   DATA QUALITY 2  :  ',CUARSH(210:212)
      WRITE (6,FMT=*) '   USER COMMENTS   :  ',CMT(1:79)
      WRITE (6,FMT=*) '   CORR PARAM 1    :  ',CORPAR(1:12)
      WRITE (6,FMT=*) '   CORR PARAM 2    :  ',CORPAR(13:24)
      WRITE (6,FMT=*) '   CORR PARAM 3    :  ',CORPAR(25:36)
      WRITE (6,FMT=*) '   CORR PARAM 4    :  ',CORPAR(37:48)

      READ (CUARSH(201:206),FMT='(I6)') NUMREC
C      NRDATA = NUMREC - 1

      IRDATA = 1 
C-------------------------------------------------------
C  READ DATA RECORDS AND PRINT OUT SUBSAMPLED NMC DATA
C-------------------------------------------------------
   10 CONTINUE

C----------------------------------------------------------
C  NOTE: SGI AND HP USE ERR OPTION, SUN USES END INSTEAD
C        ADDED BY JAMES JOHNSON 09/27/94.                
C----------------------------------------------------------
#ifdef SUNF
      READ (10,REC=IRDATA+1,IOSTAT=IOSTT,END=993) DTYPE,SFTYPE(1),
     +  SFVAL(1),SFTYPE(2),SFVAL(2),IARRAY,TMIDC,GRID
#endif
#ifndef SUNF
      READ (10,REC=IRDATA+1,IOSTAT=IOSTT,ERR=993) DTYPE,SFTYPE(1),
     +  SFVAL(1),SFTYPE(2),SFVAL(2),IARRAY,TMIDC,GRID
#endif

      WRITE (6,FMT=*) '  '
      WRITE (6,FMT=*) '   -------------------------------- '
      WRITE (6,FMT=*) '   DATA RECORD NUMBER ',IRDATA
      WRITE (6,FMT=*) '   -------------------------------- '
      IF (DTYPE.EQ.16) DPUNIT = 'TEMPERATURE  (K)'
      IF (DTYPE.EQ.1) DPUNIT = 'HEIGHT       (M)'
      IF (DTYPE.EQ.88) DPUNIT = 'MOISTURE     (PERCENT)'
      IF (DTYPE.EQ.48) DPUNIT = 'U WIND       (M/S)'
      IF (DTYPE.EQ.49) DPUNIT = 'V WIND       (M/S)'

      WRITE (6,FMT=*) '   DATA TYPE       :  ',DPUNIT(1:12)
      WRITE (6,FMT=*) '   SURF TYPE 1     :  ',SFTYPE(1)
      WRITE (6,FMT=300) SFVAL(1)
  300 FORMAT ('    SURF VALUE 1    :   ',F6.1,' MB')
      WRITE (6,FMT=333) (IARRAY(I),I=1,4)
  333 FORMAT ('    YEAR MONTH DAY HOUR :',4I4)

C      IF (IARRAY(5) .EQ. 27) THEN
C       WRITE(6,*)'   NORTHERN HEMISPHERE 4 CORNER''S LON/LAT'
C       WRITE(6,*)'   GRID(1,1)  ',NLNGRD(1,1),NLTGRD(1,1)
C       WRITE(6,*)'   GRID(1,65) ',NLNGRD(1,65),NLTGRD(1,65)
C       WRITE(6,*)'   GRID(65,65)',NLNGRD(65,65),NLTGRD(65,65)
C       WRITE(6,*)'   GRID(65,1) ',NLNGRD(65,1),NLTGRD(65,1)
C      ELSE
C       WRITE(6,*)'   SOUTHERN HEMISPHERE 4 CORNER''S LON/LAT'
C       WRITE(6,*)'   GRID(1,1)  ',SLNGRD(1,1),SLTGRD(1,1)
C       WRITE(6,*)'   GRID(1,65) ',SLNGRD(1,65),SLTGRD(1,65)
C       WRITE(6,*)'   GRID(65,65)',SLNGRD(65,65),SLTGRD(65,65)
C       WRITE(6,*)'   GRID(65,1) ',SLNGRD(65,1),SLTGRD(65,1)
C      ENDIF
      WRITE (6,FMT=*) '   TIME INDICATOR  :  ',TMIDC(1:23)
      WRITE (6,FMT=*) '  '

C-------------------------------------------------------
C  WRITE OUT VALUES FOR THE DATA GRID
C-------------------------------------------------------
      WRITE (6,FMT=*) '              NMC  65 BY 65 DATA GRID '
      IF (IARRAY(5).EQ.27) THEN
          WRITE (6,FMT=*) '             NORTHERN HEMISPHERE  ',DPUNIT
          WRITE (6,FMT=*)
          DO 357 ROW = 1,65
              DO 468 COL = 1,65
                  WRITE (6,FMT=*) ' LAT :',NLTGRD(COL,ROW),' LON :',
     +              NLNGRD(COL,ROW),' DATA :',GRID(COL,ROW)
  468         CONTINUE
  357     CONTINUE
      ELSE
          WRITE (6,FMT=*) '             SOUTHERN HEMISPHERE  ',DPUNIT
          WRITE (6,FMT=*)
          DO 358 ROW = 1,65
              DO 469 COL = 1,65
                  WRITE (6,FMT=*) ' LAT :',SLTGRD(COL,ROW),' LON :',
     +              SLNGRD(COL,ROW),' DATA :',GRID(COL,ROW)
  469         CONTINUE
  358     CONTINUE
      END IF
      IRDATA = IRDATA + 1
      IF ( IRDATA .LT. NUMREC ) THEN
        GO TO 10
      ELSE
        GO TO 999
      END IF 

C-------------------------------------------------------
C  FINISHED READING NMC CORRERLATIVE DATA FILE
C-------------------------------------------------------
  991 CONTINUE
      WRITE (6,FMT=*) ' CAN NOT OPEN META DATA FILE '
      GO TO 999
  992 CONTINUE
      WRITE (6,FMT=*) ' CAN NOT OPEN DATA FILE '
      GO TO 999
  993 CONTINUE
      CLOSE (10)
      WRITE (6,FMT=*) ' '
      WRITE (6,FMT=*) ' NUMBER OF DATA RECORDS IN FILE WAS ',IRDATA
      GO TO 999
  999 CONTINUE
      STOP
      END

      SUBROUTINE W3FB05(XI,XJ,XMESHL,ORIENT,ALAT,ALONG)
C$$$   SUBPROGRAM  DOCUMENTATION  BLOCK
C
C SUBPROGRAM: W3FB05         GRID COORDINATES TO LATITUDE, LONGITUDE
C   AUTHOR: JONES,R.E.       ORG: W345       DATE: 86-07-17
C
C ABSTRACT: CONVERTS THE COORDINATES OF A LOCATION FROM THE GRID(I,J)
C   COORDINATE SYSTEM OVERLAID ON THE POLAR STEREOGRAPHIC MAP PROJEC-
C   TION TRUE AT 60 DEGREES N OR S LATITUDE TO THE NATURAL COORDINATE
C   SYSTEM OF LATITUDE/LONGITUDE ON THE EARTH. W3FB05 IS THE REVERSE
C   OF W3FB04.
C
C PROGRAM HISTORY LOG:
C   86-07-17  R.E.JONES
C   88-06-20  R.E.JONES   CHANGE TO MICROSOFT FORTRAN 4.10
C   89-03-29  R.E.JONES   CHANGE TO VAX-11 FORTRAN
C
C USAGE:  CALL W3FB05 (XI, XJ, XMESHL, ORIENT, ALAT, ALONG)
C
C   INPUT VARIABLES:
C     NAMES  INTERFACE DESCRIPTION OF VARIABLES AND TYPES
C     ------ --------- -----------------------------------------------
C     XI     ARG LIST  I OF THE POINT RELATIVE TO THE NORTH OR S. POLE
C     XJ     ARG LIST  J OF THE POINT RELATIVE TO THE NORTH OR S. POLE
C     XMESHL ARG LIST  MESH LENGTH OF GRID IN KM AT 60 DEGREES(<0 IF SH)
C                   (190.5 LFM GRID, 381.0 NH PE GRID,-381.0 SH PE GRID)
C     ORIENT ARG LIST  ORIENTATION WEST LONGITUDE OF THE GRID
C                    (105.0 LFM GRID, 80.0 NH PE GRID, 260.0 SH PE GRID)
C
C   OUTPUT VARIABLES:
C     NAMES  INTERFACE DESCRIPTION OF VARIABLES AND TYPES
C     ------ --------- -----------------------------------------------
C     ALAT   ARG LIST  LATITUDE IN DEGREES  (<0 IF SH)
C     ALONG  ARG LIST  WEST LONGITUDE IN DEGREES
C
C   SUBPROGRAMS CALLED:
C     NAMES                                                   LIBRARY
C     ------------------------------------------------------- --------
C     ASIN   ATAN2                                            SYSLIB
C
C   REMARKS: ALL PARAMETERS IN THE CALLING STATEMENT MUST BE
C     REAL. THE RANGE OF ALLOWABLE LATITUDES IS FROM A POLE TO
C     30 DEGREES INTO THE OPPOSITE HEMISPHERE.
C     THE GRID USED IN THIS SUBROUTINE HAS ITS ORIGIN (I=0,J=0)
C     AT THE POLE, SO IF THE USER'S GRID HAS ITS ORIGIN AT A POINT
C     OTHER THAN A POLE, A TRANSLATION IS REQUIRED TO GET I AND J FOR
C     INPUT INTO W3FB05. THE SUBROUTINE GRID IS ORIENTED SO THAT
C     GRIDLINES OF I=CONSTANT ARE PARALLEL TO A WEST LONGITUDE SUP-
C     PLIED BY THE USER. THE EARTH'S RADIUS IS TAKEN TO BE 6371.2 KM.
C
C   LANGUAGE: VAX-11 FORTRAN
C   MACHINE:  VAX-11 730, 750, 780, 8600, ETC.
C
C   FOR DETAILS OBTAIN WRITEUP FROM NMC/AD/SAB
C
C$$$
C
C     .. Scalar Arguments ..
      REAL ALAT,ALONG,ORIENT,XI,XJ,XMESHL
C     ..
C     .. Local Scalars ..
      REAL ANGLE,DEGPRD,EARTHR,GI2,R2
C     ..
C     .. Intrinsic Functions ..
      INTRINSIC ASIN,ATAN2
C     ..
C     .. Data statements ..
C
      DATA DEGPRD/57.2957795/
      DATA EARTHR/6371.2/
C     ..
C
      GI2 = ((1.86603*EARTHR)/ (XMESHL))**2
      R2 = XI*XI + XJ*XJ
      IF (R2.EQ.0.0) THEN
          ALONG = 0.0
          ALAT = 90.0
          IF (XMESHL.LT.0.0) ALAT = -ALAT
          RETURN
C
      ELSE
          ALAT = ASIN((GI2-R2)/ (GI2+R2))*DEGPRD
          ANGLE = DEGPRD*ATAN2(XJ,XI)
          IF (ANGLE.LT.0.0) ANGLE = ANGLE + 360.0
      END IF
C
      IF (XMESHL.GE.0.0) THEN
          ALONG = 270.0 + ORIENT - ANGLE
C
      ELSE
C
          ALONG = ANGLE + ORIENT - 270.0
          ALAT = - (ALAT)
      END IF
C
      IF (ALONG.LT.0.0) ALONG = ALONG + 360.0
      IF (ALONG.GE.360.0) ALONG = ALONG - 360.0
C
      RETURN
C
      END
