      PROGRAM ASCBIN
*
* Controlling routine which loops through the files in 'filename.dat'
* and calls the main convertion routine for each file.
*
      CHARACTER INFILE*132, OUTFIL*132, ASCREC*2000, BINREC*1024
      LOGICAL   FSTOP, FEXIST
      INTEGER   ASCLUN, BINLUN, BINLEN, WORDSZ, IREC

      PARAMETER (ASCLUN = 9, BINLUN = 10)
****************************************************************************
* Version of word size for DEC machines (VAX/VMS, Alpha/VMS and OSF/1)...
*
***   PARAMETER (WORDSZ = 4)
****************************************************************************
* Version of word size for non-DEC machines...
*
      PARAMETER (WORDSZ = 1)
****************************************************************************

   10 CONTINUE
         CALL GETFIL (INFILE,OUTFIL,FSTOP,FEXIST)
         IF (.NOT. FSTOP) THEN
*
* Open files using record length from ASCII file...
*
            IF (FEXIST) THEN
               OPEN (UNIT=ASCLUN,FILE=INFILE,STATUS='OLD',
D    +               RECL=2000,
     +               ACCESS='SEQUENTIAL',FORM='FORMATTED')

               BINLEN = 372
***            CALL A2BPRE (ASCLUN,BINLEN)

               OPEN (UNIT=BINLUN,FILE=OUTFIL,STATUS='NEW',
     +               ACCESS='DIRECT',RECL=BINLEN/WORDSZ,
     +               FORM='UNFORMATTED')
*
* Loop through the ASCII records, converting to binary...
*
               IREC = 0
   20          CONTINUE
                  READ (UNIT=ASCLUN,FMT='(A)',END=30) ASCREC

                  CALL A2BL3A (ASCREC,BINREC,BINLEN)

                  IREC = IREC + 1
                  WRITE (UNIT=BINLUN,REC=IREC) BINREC(:BINLEN)
                  GOTO 20
*
* When end of file reached, close files...
*
   30          CONTINUE
               CLOSE (UNIT=ASCLUN)
               CLOSE (UNIT=BINLUN)

            ELSE
               PRINT *,'* Error - input file does not exist!'
            ENDIF
*
* ...and get next two filenames from the list...
*
            GOTO 10
         ENDIF

      END


      SUBROUTINE A2BPRE (ASCLUN,BINLEN)
      INTEGER ASCLUN, BINLEN
*
* This subroutine does a quick pre-read of the input Ascii file, searching
* for the record length to be used for the output binary file. This value
* occours in the UARS label record.
*
* Passed variables...
*    ASCLUN - Logical unit number of input file
*    BINLEN - Binary length
*
* Local variables...
*    ASCREC - Record from Ascii file
*    FOUND  - True if UARS label record has been found
*
      CHARACTER*2000 ASCREC
      LOGICAL        FOUND

      FOUND = .FALSE.

   10 CONTINUE
         READ (UNIT=ASCLUN,FMT='(A)',END=30) ASCREC
*
* Discard any record key...
*
         IF (ASCREC(1:1) .EQ. '1') ASCREC = ASCREC(21:)
*
* ...and look for the label record...
*
         IF (ASCREC(1:6) .EQ. 'UARS 1') THEN
            READ (UNIT=ASCREC(121:125),FMT='(I5)') BINLEN
            FOUND = .TRUE.
         ENDIF

      IF (.NOT. FOUND) GOTO 10
*
* Information has been found...go back to the beginning of the file...
*
      REWIND (UNIT=ASCLUN)
      RETURN
*
* Error...
*
   30 CONTINUE
      PRINT *,'* Error - UARS label record not found!'
      STOP

      END


      SUBROUTINE A2BL3A (ASCREC,BINREC,BINLEN)
      CHARACTER*(*) ASCREC, BINREC
      INTEGER       BINLEN
*
* Main convertion routine...
*
      INCLUDE 'vars.inc'
      INCLUDE 'badval.inc'

      BINREC = ' '

      IF (ASCREC(1:1) .EQ. '1') THEN
         BINREC(1:20) = ASCREC(1:20)
         BINPOS       = 21
         ASCPOS       = 21
      ELSE
         BINPOS       = 1
         ASCPOS       = 1
      ENDIF
*
* SFDU descriptor record...
*
      IF (ASCREC(ASCPOS:ASCPOS+3) .EQ. 'CCSD') THEN

         BINREC(BINPOS:BINPOS+39) = ASCREC(ASCPOS:ASCPOS+39)
         BINPOS = BINPOS + 40
*
* UARS label record...
* All label records are entirely ASCII, so output is same as input...
*
      ELSEIF (ASCREC(ASCPOS:ASCPOS+5) .EQ. 'UARS 1') THEN

         BINREC = ASCREC
         BINPOS = LEN(BINREC)

         LEVEL  = ASCREC(ASCPOS+105:ASCPOS+107)
*
* UARS continuation label record...
*
      ELSEIF (ASCREC(ASCPOS:ASCPOS+5) .EQ. 'UARS 2') THEN

         BINREC = ASCREC
         BINPOS = LEN(BINREC)

      ELSEIF (ASCREC(ASCPOS:ASCPOS+5) .EQ. 'UARS 3') THEN
*
* UARS data record...
*
* ...first convert the metadata part of the record...
*
         READ (UNIT=ASCREC(ASCPOS:),FMT=1010)
     +      SATID,RECTYP,INSTID,PHYREC,SPARE,TNP,NP,SI,
     +      UDTF(1),UDTF(2),LAT,LONG,LST,SZA

 1010    FORMAT (A4,A2,A12,A8,A2,3I6,2I9,4E17.10)

         ASCPOS = INDEX(ASCREC,'*DATA*') + 6

         WRITE (UNIT=BINREC(BINPOS:BINPOS+63),FMT=1020)
     +      SATID,RECTYP,INSTID,PHYREC,SPARE,TNP,NP,SI,
     +      UDTF(1),UDTF(2),LAT,LONG,LST,SZA

 1020    FORMAT (A4,A2,A12,A8,A2,36A)
*
* There are two types of UARS data record, depending on which type of
* UARS/ISAMS file is being read. The 'data' files (levels 3AL and 3AT)
* contain the actual data and quality values, whereas the 'parameter'
* files (levels 3LP and 3TP) contain extra information specific to the
* ISAMS instrument.
*
         IF (LEVEL .EQ. '3AL' .OR. LEVEL .EQ. '3AT') THEN
*
* 'data' part of record for 'data' files...
* First read the data values...
*
            IF (BINREC(1:1) .EQ. '1') THEN
               BINPOS       = 85
            ELSE
               BINPOS       = 65
            ENDIF

            DO 20, I = 1, TNP
               IF (ASCREC(ASCPOS:ASCPOS+RWIDTH-1) .NE. NULL) THEN
                  READ (UNIT=ASCREC(ASCPOS:ASCPOS+RWIDTH-1),
     +                  FMT='(E17.10)') RDATA
               ELSE
***               RDATA = NULREA  *** using integer null for testing ***
                  IDATA = INVREA
               ENDIF
               ASCPOS = ASCPOS + RWIDTH

               WRITE (UNIT=BINREC(BINPOS:BINPOS+3),FMT='(A4)') IDATA
               BINPOS = BINPOS + 4

   20       CONTINUE
*
* ...and then the Quality values...
*
            DO 30, I = 1, TNP
               IF (ASCREC(ASCPOS:ASCPOS+RWIDTH-1) .NE. NULL) THEN
                  READ (UNIT=ASCREC(ASCPOS:ASCPOS+RWIDTH-1),
     +                  FMT='(E17.10)') RQUAL
               ELSE
***               RQUAL = NULREA  *** using integer null for testing ***
                  IQUAL = INVREA
               ENDIF
               ASCPOS = ASCPOS + RWIDTH

               WRITE (UNIT=BINREC(BINPOS:BINPOS+3),FMT='(A4)') IQUAL
               BINPOS = BINPOS + 4
   30       CONTINUE

         ELSEIF (LEVEL .EQ. '3LP' .OR. LEVEL .EQ. '3TP') THEN
*
* 'data' part of record for 'parameter' files...
*
            READ (UNIT=ASCREC(ASCPOS:),FMT=1110)
     +         NUM32W,SDIREC,SUNVIE,(PMCPID(I),I=1,8),PRCIDM,LOS,LAST2

 1110       FORMAT (I2,10I4,2I6,A2)

            WRITE (UNIT=BINREC(BINPOS+64:BINPOS+64+19),FMT=1120)
     +         NUM32W,SDIREC,SUNVIE,(PMCPID(I),I=1,8),PRCIDM,LOS,LAST2

 1120       FORMAT (A4,10A1,2A2,A2)

            BINPOS = BINPOS + 64 + 20
         ENDIF
*
* Error if none of the conditions are met...
*
      ELSE
         PRINT *,' '
         PRINT *,'* Unknown record type = ',ASCREC(ASCPOS:ASCPOS+5)
      ENDIF
*
* Null space the binary record...
*
      DO 100, I=BINPOS,BINLEN
         BINREC(I:I) = CHAR(0)
  100 CONTINUE

      RETURN
      END
