CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
C
C  NAME : READUMP_ISAMS_L3LP_DATA.F
C
C  USAGE : THIS PROGRAM READS UARS LEVEL 3LP ISAMS 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_ISAMS_L3LP_DATA 
C                   PLEASE ENTER MATA DATA FILE NAME BELLOW :
C                   ISAMS_L3LP_SAERO12P1_D0071.V0009_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_ISAMS_L3LP_DATA READUMP_ISAMS_L3LP_DATA.F
C       or for SUN machines
C         f77 -DSUNF -o READUMP_ISAMS_L3LP_DATA READUMP_ISAMS_L3LP_DATA.F
C     EXECUTABLE CODE WILL BE NAMED READUMP_ISAMS_L3LP_DATA
C
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC


C     .. Local Scalars ..
      CHARACTER HDR*48,DATAFN*170,METAFN*170,LINE*176,NREC*8
      INTEGER I,IOSTT,IREC,IROW,K,NUMBPR,RECSIZ,RLEN
      INTEGER PHYREC, NUMREC
      INTEGER*2 SSDIR
C     ..
C     .. Local Arrays ..
      CHARACTER BLNK74(74),BUFFER(176),EIGHT(8)
      INTEGER INT5(5)
      INTEGER*2 INT2(2)
      REAL FLOAT4(4)
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     PRINT *,' PLEASE ENTER META DATA FILE NAME BELOW: '
      READ (5,FMT='(A)') METAFN

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

C   SKIP 9 LINES IN META FILE

      DO 111 IROW = 1,9
          READ (20,FMT=50) LINE
  111 CONTINUE

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

      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:19),FMT=113) RECSIZ
  113 FORMAT (I3)

C   CLOSE META FILE

      CLOSE (20)

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',ERR=992,FORM='UNFORMATTED',
     +     ACCESS='DIRECT',RECL=RLEN)

      PRINT *,'********************************************'
      PRINT *,' READING   ',DATAFN
      PRINT *,'********************************************'
      READ (10,REC=1,IOSTAT=IOSTT,ERR=993) (BUFFER(K),K=1,176)
      WRITE (6,FMT=*) '      DESCRIPTOR RECORD'
      WRITE (6,FMT=*) '-------------------------------'
      WRITE (6,FMT=*) ' SFDU T(Z) AND L(Z) '
      WRITE (6,FMT=*) '-------------------------------'
      WRITE (6,FMT=*) ' RECORD KEY : ', (BUFFER(K),K=1,20)
      WRITE (6,FMT=*) ' CONTROL ID : ', (BUFFER(K),K=21,24)
      WRITE (6,FMT=*) ' VERSION ID : ',BUFFER(25)
      WRITE (6,FMT=*) ' CLASS ID   : ',BUFFER(26)
      WRITE (6,FMT=*) ' DATA DESCRIPTIVE RECORD ID : ',
     +  (BUFFER(K),K=29,32)
      WRITE (6,FMT=*) ' LENGTH     : ', (BUFFER(K),K=33,40)
      WRITE (6,FMT=*) '-------------------------------'
      WRITE (6,FMT=*) ' SFDU T(I) AND L(I) '
      WRITE (6,FMT=*) '-------------------------------'
      WRITE (6,FMT=*) ' CONTROL ID : ', (BUFFER(K),K=41,44)
      WRITE (6,FMT=*) ' VERSION ID : ',BUFFER(45)
      WRITE (6,FMT=*) ' CLASS ID   : ',BUFFER(46)
      WRITE (6,FMT=*) ' DATA DESCRIPTIVE RECORD ID : ',
     +  (BUFFER(K),K=49,52)
      WRITE (6,FMT=*) ' LENGTH     : ', (BUFFER(K),K=53,60)
      READ (10,REC=2,IOSTAT=IOSTT,ERR=994) (BUFFER(K),K=1,176)
      WRITE (6,FMT=*) '-------------------------------'
      WRITE (6,FMT=*) '       LABEL RECORD'
      WRITE (6,FMT=*) '-------------------------------'
      WRITE (6,FMT=*) ' RECORD KEY    : ', (BUFFER(K),K=1,20)
      WRITE (6,FMT=*) ' SATELLITE ID  : ', (BUFFER(K),K=21,24)
      WRITE (6,FMT=*) ' RECORD TYPE   : ', (BUFFER(K),K=25,26)
      WRITE (6,FMT=*) ' INSTRUMENT ID : ', (BUFFER(K),K=27,38)
      WRITE (6,FMT=*) ' DATA SUBTYPE OR SPECIES : ', (BUFFER(K),K=39,50)
      WRITE (6,FMT=*) ' FORMAT VERSION NUMBER   : ', (BUFFER(K),K=51,54)
      WRITE (6,FMT=*) ' PHYSICAL RECORD COUNT   : ', (BUFFER(K),K=55,62)
      WRITE (6,FMT=*) ' NUMBER OF CONTINUATION RECORD FOR FILE LABEL : '
     +  , (BUFFER(K),K=63,66)
      DO 112 I = 1,8
        NREC(I:I) = BUFFER(I+66)
 112  CONTINUE
      READ(NREC(1:8),FMT=321)NUMREC
 321  FORMAT(I8)
      WRITE (6,FMT=*) ' NUMBER OF PHYSICAL RECORD IN FILE : ',NUMREC
      WRITE (6,FMT=*) ' FILE CREATION TIME : ', (BUFFER(K),K=75,97)
      WRITE (6,FMT=*) ' YEAR FOR 1ST DATA RECORD       : ',
     +  (BUFFER(K),K=98,100)
      WRITE (6,FMT=*) ' DAY OF YEAR OF 1ST DATA RECORD : ',
     +  (BUFFER(K),K=101,103)
      WRITE (6,FMT=*) ' MS OF DAY FOR 1ST DATA RECORD  : ',
     +  (BUFFER(K),K=104,111)
      WRITE (6,FMT=*) ' YEAR FOR LAST DATA RECORD       : ',
     +  (BUFFER(K),K=112,114)
      WRITE (6,FMT=*) ' DAY OF YEAR OF LAST DATA RECORD : ',
     +  (BUFFER(K),K=115,117)
      WRITE (6,FMT=*) ' MS OF DAY FOR LAST DATA RECORD  : ',
     +  (BUFFER(K),K=118,125)
      WRITE (6,FMT=*) ' DATA LEVEL : ', (BUFFER(K),K=126,128)
      WRITE (6,FMT=*) ' UARS DAY NUMBER : ', (BUFFER(K),K=129,132)
      WRITE (6,FMT=*) ' MAX. NUMBER OF 32-BIT WORDS PER RECORD : ',
     +  (BUFFER(K),K=133,136)
      WRITE (6,FMT=*) ' RECORD LENGTH IN BYTES : ',
     +  (BUFFER(K),K=141,145)
      WRITE (6,FMT=*) ' MIN. LATITUDE FOR RECORDS IN FILE : ',
     +  (BUFFER(K),K=146,148)
      WRITE (6,FMT=*) ' MAX. LATITUDE FOR RECORDS IN FILE : ',
     +  (BUFFER(K),K=149,151)
      WRITE (6,FMT=*) ' CCB VERSION NUMBER : ', (BUFFER(K),K=152,160)
      WRITE (6,FMT=*) ' FILE CYCLE NUMBER : ', (BUFFER(K),K=161,165)
      WRITE (6,FMT=*) ' VITUAL FILE FLAG : ',BUFFER(166)
      WRITE (6,FMT=*) ' TOTAL NUMBER OF TIME/VERSION ENTRIES IN FILE : '
     +  , (BUFFER(K),K=167,170)
      WRITE (6,FMT=*) ' NUMBER OF TIME/VERSION ENTRIES IN RECORD : ',
     +  (BUFFER(K),K=171,174)

      IREC = 2
      DO 445  PHYREC = 1, (NUMREC - 1)

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=IREC+1,IOSTAT=IOSTT,END=900) HDR,INT5,FLOAT4,NUMBPR,
     +  SSDIR,EIGHT,INT2,BLNK74
#endif
#ifndef SUNF
      READ (10,REC=IREC+1,IOSTAT=IOSTT,ERR=900) HDR,INT5,FLOAT4,NUMBPR,
     +  SSDIR,EIGHT,INT2,BLNK74
#endif

      WRITE (6,FMT=*) '---------------------------------------------'
      WRITE (6,FMT=*) ' RECORD NUMBER ',IREC,'   DATA RECORD'
      WRITE (6,FMT=*) '---------------------------------------------'
      WRITE (6,FMT=*) ' RECORD KEY    : ',HDR(1:20)
      WRITE (6,FMT=*) ' SATELLITE ID  : ',HDR(21:24)
      WRITE (6,FMT=*) ' RECOORD TYPE  : ',HDR(25:26)
      WRITE (6,FMT=*) ' INSTRUMENT ID : ',HDR(27:38)
      WRITE (6,FMT=*) ' PHYSICAL RECORD COUNT : ',HDR(39:46)
      WRITE (6,FMT=*) ' TOTAL NUMBER OF POINTS IN RECORD : ',INT5(1)
      WRITE (6,FMT=*) ' STARTING INDEX OF 1ST ACTUAL POINT : ',INT5(3)
      WRITE (6,FMT=222) INT5(4),INT5(5)
  222 FORMAT ('  RECORD TIME IN UDTF FORMAT: ',I10,I10,/,30X,
     +       '(YEAR DAY, MILLISECONDS)')

      WRITE (6,FMT=*) ' LATITUDE : ',FLOAT4(1),' (DEGREES)'
      WRITE (6,FMT=*) ' LONGITUDE: ',FLOAT4(2),' (DEGREES)'
      WRITE (6,FMT=*) ' NUMBER OF 32-BIT PARAMETER WORDS : ',NUMBPR

      K = SSDIR/2**8

      IF (K.EQ.0) WRITE (6,FMT=*) ' SATELLITE DIRECTION : 0',
     +    ' (UNDETERMINED)'
      IF (K.EQ.1) WRITE (6,FMT=*) ' SATELLITE DIRECTION : 1',
     +    ' (NORTHBOUND)'
      IF (K.EQ.2) WRITE (6,FMT=*) ' SATELLITE DIRECTION : 2',
     +    ' (SOUTHBOUND)'

      K = SSDIR*2**24
      K = K/2**24

      IF (K.EQ.0) WRITE (6,FMT=*) ' SUN VIEW DIRECTION  : 0',
     +    ' (UNDETERMINED)'
      IF (K.EQ.1) WRITE (6,FMT=*) ' SUN VIEW DIRECTION  : 1',
     +    ' (+Y ANTISUN)'
      IF (K.EQ.2) WRITE (6,FMT=*) ' SUN VIEW DIRECTION  : 2',' (-Y SUN)'


      WRITE (6,FMT=444) (EIGHT(K),K=1,8)
  444 FORMAT ('  PMC PRESSURE CODES : ',8 (' ',I1),
     +       ' (SEE ISAMS L3A SFDU SECTION 4.16, L3LP)')

      WRITE (6,FMT=*) ' SCAN PROGRAM ID    : ',INT2(1),
     +  ' (SEE ISAMS L3A SFDU SECTION 4.17, L3LP)'
      WRITE (6,FMT=*) ' LINE OF SIGHT DIRECTION : ',INT2(2),
     +  ' (0.01 DEGREES)'

      IREC = IREC + 1

  445 CONTINUE

  900 WRITE (6,FMT=*) ' END OF DATA'
      GO TO 999
  991 WRITE (6,FMT=*) ' CAN NOT OPEN META DATA FILE. '
      GO TO 999
  992 WRITE (6,FMT=*) ' CAN NOT OPEN DATA PRODUCT FILE. '
      GO TO 999
  993 WRITE (6,FMT=*) ' ERROR IN READING 1ST RECORD. ERROR CODE : ',
     +  IOSTT
      GO TO 999
  994 WRITE (6,FMT=*) ' ERROR IN READING 2ND RECORD. ERROR CODE : ',
     +  IOSTT
      GO TO 999

  999 CLOSE (10)
      CONTINUE
      STOP
      END
