CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
C  NAME : READUMP_L3ASBS_DATA.F
C
C  USAGE : THIS PROGRAM READS UARS LEVEL 3 BS 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_L3ASBS_DATA 
C                   PLEASE ENTER MATA DATA FILE NAME BELLOW :
C                   SOLSTICE_L3BS_D0226.V0005_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_L3ASBS_DATA READUMP_L3ASBS_DATA.F
C       or for SUN machines
C         f77 -DSUNF -o READUMP_L3ASBS_DATA READUMP_L3ASBS_DATA.F
C     EXECUTABLE CODE WILL BE NAMED READUMP_L3ASBS_DATA
C
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC


C     .. Parameters ..
      INTEGER MAXLEN
      PARAMETER (MAXLEN=4156)
      INTEGER MAXDAT
      PARAMETER (MAXDAT=622)
C     ..
C     .. Local Scalars ..
      CHARACTER HDR*28,DATAFN*170,METAFN*170,LINE*255,NREC*8
      INTEGER ACTUAL,I,IOSTT,IREC,IROW,K,INSID,NUMBPR,RECSIZ,RLEN,TOTAL
      INTEGER PHYREC, NUMREC
      REAL START
C     ..
C     .. Local Arrays ..
      CHARACTER BLANK(16),BUFFER(MAXLEN),SPARE(580),PRNAME(34)*20
      INTEGER TIME(2)
      REAL SODATA(MAXDAT),SUDATA(592)
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:20),FMT=333) RECSIZ
  333 FORMAT (I4)

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,RECSIZ)
      WRITE (6,FMT=*) '    DESCRIPTOR RECORD '
      WRITE (6,FMT=*) '-------------------------------'
      WRITE (6,FMT=*) ' SFDU T(Z) AND L(Z) '
      WRITE (6,FMT=*) '-------------------------------'
      WRITE (6,FMT=*) ' CONTROL ID : ', (BUFFER(K),K=1,4)
      WRITE (6,FMT=*) ' VERSION ID : ',BUFFER(5)
      WRITE (6,FMT=*) ' CLASS ID   : ',BUFFER(6)
      WRITE (6,FMT=*) ' DATA DESCRIPTIVE RECORD ID : ',
     +  (BUFFER(K),K=9,12)
      WRITE (6,FMT=*) ' LENGTH : ', (BUFFER(K),K=13,20)
      WRITE (6,FMT=*) '-------------------------------'
      WRITE (6,FMT=*) ' SFDU T(I) AND L(I) '
      WRITE (6,FMT=*) '-------------------------------'
      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)
      READ (10,REC=2,IOSTAT=IOSTT,ERR=994) (BUFFER(K),K=1,RECSIZ)
      WRITE (6,FMT=*) '-------------------------------'
      WRITE (6,FMT=*) '     LABEL RECORD'
      WRITE (6,FMT=*) '-------------------------------'
      WRITE (6,FMT=*) ' SATELLITE ID : ', (BUFFER(K),K=1,4)
      WRITE (6,FMT=*) ' RECORD TYPE  : ', (BUFFER(K),K=5,6)
      WRITE (6,FMT=*) ' INSTRUMENT ID : ', (BUFFER(K),K=7,18)
      IF (BUFFER(8) .EQ. 'U') INSID = 2
      WRITE (6,FMT=*) ' SUBTYPE OR SPECIES : ', (BUFFER(K),K=19,30)
      WRITE (6,FMT=*) ' FORMAT VERSION NUMBER : ', (BUFFER(K),K=31,34)
      WRITE (6,FMT=*) ' PHYSICAL RECORD COUNT : ', (BUFFER(K),K=35,42)
      WRITE (6,FMT=*) ' NUMBER OF CONTINUATION RECORD FOR FILE LABEL : '
     +  , (BUFFER(K),K=43,46)
      DO 112 I = 1,8
        NREC(I:I) = BUFFER(I+46)
 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=55,77)
      WRITE (6,FMT=*) ' YEAR FOR 1ST DATA RECORD       : ',
     +  (BUFFER(K),K=78,80)
      WRITE (6,FMT=*) ' DAY OF YEAR OF 1ST DATA RECORD : ',
     +  (BUFFER(K),K=81,83)
      WRITE (6,FMT=*) ' MS OF DAY FOR 1ST DATA RECORD  : ',
     +  (BUFFER(K),K=84,91)
      WRITE (6,FMT=*) ' YEAR FOR LAST DATA RECORD       : ',
     +  (BUFFER(K),K=92,94)
      WRITE (6,FMT=*) ' DAY OF YEAR OF LAST DATA RECORD : ',
     +  (BUFFER(K),K=95,97)
      WRITE (6,FMT=*) ' MS OF DAY FOR LAST DATA RECORD  : ',
     +  (BUFFER(K),K=98,105)
      WRITE (6,FMT=*) ' DATA LEVEL : ', (BUFFER(K),K=106,108)
      WRITE (6,FMT=*) ' UARS DAY NUMBER : ', (BUFFER(K),K=109,112)
      WRITE (6,FMT=*) ' NUMBER OF DATA POINTS PER RECORD    : ',
     +  (BUFFER(K),K=113,116)
      WRITE (6,FMT=*) ' BASE WAVELENGTH OF DATA POINT VALUE : ',
     +  (BUFFER(K),K=117,122),' (NM)'
      WRITE (6,FMT=*) ' RECORD LENGTH IN BYTES : ',
     +  (BUFFER(K),K=123,127)
      WRITE (6,FMT=*) ' CCB VERSION NUMBER     : ',
     +  (BUFFER(K),K=128,136)
      WRITE (6,FMT=*) ' FILE CYCLE NUMBER      : ',
     +  (BUFFER(K),K=137,141)
      WRITE (6,FMT=*) ' VITUAL FILE FLAG       : ',
     +  (BUFFER(K),K=142,142)
      WRITE (6,FMT=*) ' TOTAL NUMBER OF TIME/VERSION ENTRIES IN FILE : '
     +  , (BUFFER(K),K=143,146)
      WRITE (6,FMT=*) ' NUMBER OF TIME/VERSION ENTRIES IN RECORD : ',
     +  (BUFFER(K),K=147,150)

      IREC = 2

      DO 345  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
      IF (INSID .EQ. 2) THEN
       READ (10,REC=IREC+1,IOSTAT=IOSTT,END=900) HDR,TOTAL,ACTUAL,START,
     +  TIME,BLANK,SUDATA,NUMBPR,PRNAME
      ELSE
       READ (10,REC=IREC+1,IOSTAT=IOSTT,END=900) HDR,TOTAL,ACTUAL,START,
     +  TIME,BLANK,SODATA,NUMBPR,PRNAME
      END IF 
#endif
#ifndef SUNF
      IF (INSID .EQ. 2) THEN
       READ (10,REC=IREC+1,IOSTAT=IOSTT,ERR=900) HDR,TOTAL,ACTUAL,START,
     +  TIME,BLANK,SUDATA,NUMBPR,PRNAME
      ELSE
       READ (10,REC=IREC+1,IOSTAT=IOSTT,ERR=900) HDR,TOTAL,ACTUAL,START,
     +  TIME,BLANK,SODATA,NUMBPR,PRNAME
      END IF 
#endif

      WRITE (6,FMT=*) '---------------------------------------------'
      WRITE (6,FMT=*) ' RECORD NUMBER ',IREC,'   DATA RECORD'
      WRITE (6,FMT=*) '---------------------------------------------'
      WRITE (6,FMT=*) ' SATELLITE ID : ',HDR(1:4)
      WRITE (6,FMT=*) ' RECOORD TYPE : ',HDR(5:6)
      WRITE (6,FMT=*) ' INSTRUMENT ID : ',HDR(7:18)
      WRITE (6,FMT=*) ' PHYSICAL RECORD COUNT : ',HDR(19:26)
      WRITE (6,FMT=*) ' TOTAL NUMBER POINTS IN THE RECORD : ',TOTAL
      WRITE (6,FMT=*) ' NUMBER OF ACTUAL POINTS : ',ACTUAL
      WRITE (6,FMT=*) ' STARTING WAVELENGTH OF 1ST ACTUAL POINT : ',
     +  START,' (NM)'
      WRITE (6,FMT=221) TIME(1),TIME(2)
  221 FORMAT ('  RECORD TIME IN UDTF FORMAT: ',I10,I10,
     +       '    (YEAR DAY, MILLISECONDS)')

      WRITE (6,FMT=*)
      WRITE (6,FMT=*) '         DATA (WATT/M^3)     QUALITY (WATT/M^3)'

      DO 124 I = 1,TOTAL
        IF (INSID .EQ. 2) THEN
          IF ((SUDATA(I).GT. (-3.402823*10.0**38.0)) .AND.
     +        (SUDATA(I).LT. (3.402823*10.0**38.0))) THEN
              WRITE (6,FMT=444) I - 1,SUDATA(I),SUDATA(I+TOTAL)
          ELSE
              WRITE (6,FMT=555) I - 1
          END IF
        ELSE
          IF ((SODATA(I).GT. (-3.402823*10.0**38.0)) .AND.
     +        (SODATA(I).LT. (3.402823*10.0**38.0))) THEN
              WRITE (6,FMT=444) I - 1,SODATA(I),SODATA(I+TOTAL)
  444         FORMAT (I4,')   ',E,'    ',F)
          ELSE
              WRITE (6,FMT=555) I - 1
  555         FORMAT (I4,')             ***  FILL VALUE  ***')
          END IF
        END IF

  124 CONTINUE
      WRITE (6,FMT=*)
      WRITE (6,FMT=*) ' NUMBER OF PARAMETER PAIRS : ',NUMBPR
      K = 1
      DO 222 I = 1,NUMBPR
          IF (I.EQ.1) THEN
              WRITE (6,FMT=357) I,PRNAME(K),PRNAME(K+1)
  357         FORMAT (' PARAMETER/VALUE',I4,'   ',A20,' ',A12,' (A.U.)')
          ELSE IF ((I.GE.2) .AND. (I.LE.11)) THEN
              WRITE (6,FMT=358) I,PRNAME(K),PRNAME(K+1)
  358         FORMAT (' PARAMETER/VALUE',I4,'   ',A20,' ',A12,
     +               ' (WATT/M^3)(NM)')
          ELSE IF ((I.GE.12) .AND. (I.LE.15)) THEN
              WRITE (6,FMT=359) I,PRNAME(K),PRNAME(K+1)
  359         FORMAT (' PARAMETER/VALUE',I4,'   ',A20,' ',A12,' (NM)')
          ELSE IF ((I.GE.16) .AND. (I.LE.17)) THEN
              WRITE (6,FMT=360) I,PRNAME(K),PRNAME(K+1)
  360         FORMAT (' PARAMETER/VALUE',I4,'   ',A20,' ',A12,
     +               ' (DEGREES)')
          END IF
          K = K + 2
  222 CONTINUE

      IREC = IREC + 1
  345 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
