Sources_For_Win/Modran4/DATA/MOLBMP.F

      PROGRAM MOLBMP
C
C     THIS ROUTINE MAKES CONVERSIONS BETWEEN ASCII AND DIRECT-ACCESS
C     BINARY MODTRAN4 MOLECULAR BAND MODEL PARAMETER FILES.
C     THE DATA IS CALCULATED FROM THE HITRAN96 LINE COMPILATION.
C
C     DECLARE VARIABLES, ARRAYS AND FUNCTIONS
      INTEGER MXTEMP
      PARAMETER(MXTEMP=11)
      CHARACTER ANSWER*1,ASCNAM*150,BINNAM*150,ACCESS*12,MESSAG*7
      LOGICAL LEXIST
      INTEGER IBNDWD,NTEMP,IT,J,IASCII,IBNARY,NDIVID,NREC,LENASC,
     1  LENBIN,IRECLN,MXRCLN,IBIN,IALF,IMOL,IF1ST,IFLAST,LSTREC
      REAL DEDGE,DEDGEB,TBAND(MXTEMP),SD(MXTEMP),OD(MXTEMP)
C
C     FOR COMPARING BINARY AND ASCII FILES
      REAL SDASC(MXTEMP,3),ODASC(MXTEMP,3),SDBIN(MXTEMP,3),
     1  ODBIN(MXTEMP,3),TBANDB(MXTEMP)
      INTEGER IWDBIN,NTEMPB,IF1STB,IFLASB,NDIVDB,LSTRCB
      INTEGER IBINB(3),IALFB(3),IMOLB(3),IBINA(3),IALFA(3),IMOLA(3)
      INTEGER MINLEN
C
C     LIST DATA
      DATA IASCII/9/,IBNARY/10/
C
C     SELECT ACTION
      WRITE(*,'(/2A,/(17X,A))')' PROGRAM MOLBMP: ',
     1     ' CONVERTS BETWEEN THE SEQUENTIAL-ACCESS ASCII',
     2     ' (FORMATTED) AND THE DIRECT-ACCESS BINARY (UNFORMATTED)',
     3     ' MODTRAN4 MOLECULAR BAND MODEL PARAMETER FILES',
     4     ' (THE FILE FROM WHICH DATA IS READ IS NOT DELETED).'
   10 WRITE(*,'(/(2A))')' ENTER  1   TO CREATE BINARY (UNFORMATTED)',
     1     ' FILE FROM ASCII (FORMATTED) FILE','        2   TO CREATE',
     2     ' ASCII (FORMATTED) FILE FROM BINARY (UNFORMATTED) FILE'
      READ(*,'(A1)',END=10,ERR=10)ANSWER
      IF(ANSWER.EQ.'1')THEN
C
C         ENTER NAME AND OPEN OLD ASCII FILE
   20     WRITE(*,'(/(A))')
     1      ' ENTER ASCII BAND MODEL FILE NAME (MAX 150 CHARACTERS)',
     2      '      [ENTER 0 FOR NAME = "BMP99_01.ASC"]',
     3      '      [ENTER 1 FOR NAME = "BMP99_15.ASC"]'
          READ(*,'(A)',END=20,ERR=20)ASCNAM
          LENASC=MINLEN(ASCNAM)
          IF(LENASC.EQ.0)GOTO20
          IF(LENASC.EQ.1)THEN
C
C             CHECK FOR DEFAULT NAMES.
              IF(ASCNAM(1:1).EQ.'0')THEN
                  LENASC=12
                  ASCNAM(1:LENASC)='BMP99_01.ASC'
              ELSEIF(ASCNAM(1:1).EQ.'1')THEN
                  LENASC=12
                  ASCNAM(1:LENASC)='BMP99_15.ASC'
              ENDIF
          ENDIF
          INQUIRE(FILE=ASCNAM(1:LENASC),EXIST=LEXIST)
          IF(.NOT.LEXIST)THEN
              WRITE(*,'(/3A)')' FILE "',ASCNAM(1:LENASC),
     1          '" DOES NOT EXIST.  PLEASE RE-ENTER.'
              GOTO20
          ENDIF
          OPEN(IASCII,FILE=ASCNAM(1:LENASC),STATUS='OLD')
C
C         READ THE NUMBER OF TEMPERATURES (NTEMP) FROM HEADER.
          MESSAG=' HEADER'
          READ(IASCII,'(I3)',END=130,ERR=130)NTEMP
          IF(NTEMP.LE.0 .OR. NTEMP.GT.MXTEMP)THEN
              WRITE(*,'(/2A,I3,A,/8X,2A,I3,A)')
     1          ' ERROR:  INPUT NUMBER OF TEMPERATURES',
     2          ' (NTEMP =',NTEMP,' MUST BE',' POSITIVE AND',
     3          ' CAN NOT EXCEED PARAMETER MXTEMP (=',MXTEMP,').'
              STOP 'NTEMP OUT OF RANGE'
          ENDIF
          REWIND(IASCII)
C
C         SET INITIAL AND MAXIMUM RECORD LENGTH
C         INTEGER AND REAL VARIABLES ON HP ARE OF RECORD LENGTH 4
C         ON IBM VM/CMS, IT IS 4; THERE IS ALSO A 4 BYTE PADDING
C         INTEGER AND REAL VARIABLES ON SGI & DEC ARE OF RECORD LENGTH 1
          IRECLN=2*NTEMP+3
          MXRCLN=4*IRECLN+4
C
C         ENTER NAME AND OPEN NEW BINARY FILE
   30     WRITE(*,'(/(A))')
     1      ' ENTER BINARY BAND MODEL FILE NAME (MAX 150 CHARACTERS)',
     2      '      [ENTER 0 FOR NAME = "BMP99_01.BIN"]',
     3      '      [ENTER 1 FOR NAME = "BMP99_15.BIN"]'
          READ(*,'(A)',END=30,ERR=30)BINNAM
          LENBIN=MINLEN(BINNAM)
          IF(LENBIN.EQ.0)GOTO30
          IF(LENBIN.EQ.1)THEN
              IF(BINNAM(1:1).EQ.'0')THEN
                  LENBIN=12
                  BINNAM(1:LENBIN)='BMP99_01.BIN'
              ELSEIF(BINNAM(1:1).EQ.'1')THEN
                  LENBIN=12
                  BINNAM(1:LENBIN)='BMP99_15.BIN'
              ENDIF
          ENDIF
          INQUIRE(FILE=BINNAM(1:LENBIN),EXIST=LEXIST)
          IF(LEXIST)THEN
              WRITE(*,'(/4A,/11X,A)')' WARNING:  ',
     1          'THE FILE "',BINNAM(1:LENBIN),'" ALREADY EXISTS.',
     2          'DO YOU WISH TO OVERWRITE THE PRE-EXISTING FILE (Y/N)?'
              READ(*,'(A1)')ANSWER
              IF(ANSWER.NE.'Y' .AND. ANSWER.NE.'y')GOTO30
              OPEN(IBNARY,FILE=BINNAM(1:LENBIN),STATUS='OLD')
              CLOSE(IBNARY,STATUS='DELETE')
          ENDIF
   40     CONTINUE
          OPEN(IBNARY,FILE=BINNAM(1:LENBIN),STATUS='NEW',
     1      FORM='UNFORMATTED',ACCESS='DIRECT',RECL=IRECLN)
C
C         READ THE BAND MODEL FILE HEADER:
C           IBNDWD   BIN WIDTH [CM-1].
C           IF1ST    BEGINNING FREQUENCY [CM-1].
C           IFLAST   FINAL FREQUENCY [CM-1].
C           LSTREC   RECORD NUMBER OF FINAL RECORD.
C           DEDGE    DISTANCE FROM BIN EDGE TO LINE CENTER [CM-1].
          MESSAG=' HEADER'
          READ(IASCII,*,END=130,ERR=130)NTEMP,(TBAND(IT),IT=1,NTEMP)
          READ(IASCII,'(5I8,F8.3)',ERR=41)
     1      IBNDWD,IF1ST,IFLAST,LSTREC,NDIVID,DEDGE
          GOTO42
C
C             OLD FORMAT
   41         CONTINUE
              REWIND(IASCII)
              READ(IASCII,*,END=130,ERR=130)NTEMP,(TBAND(IT),IT=1,NTEMP)
              READ(IASCII,'(4I8,F8.3)')IBNDWD,IF1ST,IFLAST,LSTREC,DEDGE
              NDIVID=1
   42     CONTINUE
C
C         WRITE THE MOLECULAR BAND MODEL PARAMETER HEADER TO BINARY FILE
          NREC=1
          WRITE(IBNARY,REC=NREC,ERR=120)NTEMP,(TBAND(IT),IT=1,NTEMP),
     1      IBNDWD,IF1ST,IFLAST,LSTREC,NDIVID,DEDGE
C
C         ECHO HEADER INFO
          WRITE(*,'(/5X,A,/I3,0P11F7.0)')
     1      'NTEMP,(TBAND(IT),IT=1,NTEMP)',NTEMP,(TBAND(IT),IT=1,NTEMP)
          WRITE(*,'(/2(A,I7,5X),A,I7,/2(A,I7,5X),A,F7.3)')
     1      'IBNDWD=',IBNDWD,' IF1ST=', IF1ST,'IFLAST=',IFLAST,
     2      'LSTREC=',LSTREC,'NDIVID=',NDIVID,' DEDGE=', DEDGE
C
C         READ AND WRITE BAND MODEL DATA - ONE LINE OR ONE RECORD AT
C         A TIME.  A "LINE" OR A "RECORD" CONSISTS OF:  IBIN, IMOL,
C         SD(1), ..., SD(NTEMP), IALF, ..., OD(1), ..., OD(NTEMP).
          MESSAG='  DATA '
   50     READ(IASCII,*,END=70,ERR=130)
     1      IBIN,IMOL,(SD(IT),IT=1,NTEMP),IALF,(OD(IT),IT=1,NTEMP)
          NREC=NREC+1
          WRITE(IBNARY,REC=NREC,ERR=120)
     1      IBIN,IMOL,(SD(IT),IT=1,NTEMP),IALF,(OD(IT),IT=1,NTEMP)
C
C         SAVE THE FIRST 2 AND THE LAST BAND MODEL RECORDS FOR TESTING
          IF(NREC.LE.3)THEN
              IBINA(NREC-1)=IBIN
              IMOLA(NREC-1)=IMOL
              IALFA(NREC-1)=IALF
              DO 60 IT=1,NTEMP
                  SDASC(IT,NREC-1)=SD(IT)
                  ODASC(IT,NREC-1)=OD(IT)
   60         CONTINUE
              IF(NREC.EQ.2)
     1          WRITE(*,'(/A)')' THE FIRST TWO BAND MODEL RECORDS ARE:'
              WRITE(*,'(I6,I5,1P11E11.3)')IBIN,IMOL,(SD(IT),IT=1,NTEMP)
              WRITE(*,'(6X,I5,1P11E11.3)')IALF,(OD(IT),IT=1,NTEMP)
          ENDIF
          IF(8000*(NREC/8000).EQ.NREC)THEN
C
C             WRITE EACH 8000 RECORDS TO KEEP USER AWARE OF PROGRESS.
              WRITE(*,'(/A,I7,A)')' BAND MODEL RECORD',NREC,' IS:'
              WRITE(*,'(I6,I5,1P11E11.3)')IBIN,IMOL,(SD(IT),IT=1,NTEMP)
              WRITE(*,'(6X,I5,1P11E11.3)')IALF,(OD(IT),IT=1,NTEMP)
          ENDIF
          GOTO50
   70     CONTINUE
C
C         SAVE LAST RECORD FOR TESTING.
          IBINA(3)=IBIN
          IMOLA(3)=IMOL
          IALFA(3)=IALF
          DO 80 IT=1,NTEMP
              SDASC(IT,3)=SD(IT)
              ODASC(IT,3)=OD(IT)
   80     CONTINUE
          WRITE(*,'(/A,I7,A)')'THE LAST RECORD, ',NREC,', IS:'
          WRITE(*,'(I6,I5,1P11E11.3)')IBIN,IMOL,(SD(IT),IT=1,NTEMP)
          WRITE(*,'(6X,I5,1P11E11.3)')IALF,(OD(IT),IT=1,NTEMP)
C
C         TEST BINARY FILE
          CLOSE(IBNARY,STATUS='KEEP')
          WRITE(*,'(/A)')' TESTING BINARY TAPE'
          OPEN(IBNARY,FILE=BINNAM(1:LENBIN),STATUS='OLD',
     1      FORM='UNFORMATTED',ACCESS='DIRECT',RECL=IRECLN)
C
          READ(IBNARY,REC=1,ERR=120)NTEMPB,(TBANDB(IT),IT=1,NTEMP),
     1      IWDBIN,IF1STB,IFLASB,LSTRCB,NDIVDB,DEDGEB
          IF(NTEMPB.NE.NTEMP .OR. IWDBIN.NE.IBNDWD .OR. IF1STB.NE.IF1ST
     1      .OR. IFLASB.NE.IFLAST .OR. NDIVDB.NE.NDIVID
     2      .OR. LSTRCB.NE.LSTREC .OR. DEDGEB.NE.DEDGE)GOTO120
          DO 90 IT=1,NTEMP
              IF(TBANDB(IT).NE.TBAND(IT))GOTO120
   90     CONTINUE
          READ(IBNARY,REC=2,ERR=120)IBINB(1),IMOLB(1),
     1      (SDBIN(IT,1),IT=1,NTEMP),IALFB(1),
     2      (ODBIN(IT,1),IT=1,NTEMP)
          READ(IBNARY,REC=3,ERR=120)IBINB(2),IMOLB(2),
     1      (SDBIN(IT,2),IT=1,NTEMP),IALFB(2),
     2      (ODBIN(IT,2),IT=1,NTEMP)
          READ(IBNARY,REC=NREC,ERR=120)IBINB(3),IMOLB(3),
     1      (SDBIN(IT,3),IT=1,NTEMP),IALFB(3),
     2      (ODBIN(IT,3),IT=1,NTEMP)
          DO 110 J=1,3
              IF(IBINA(J).NE.IBINB(J))GOTO120
              IF(IMOLA(J).NE.IMOLB(J))GOTO120
              IF(IALFA(J).NE.IALFB(J))GOTO120
              DO 100 IT=1,NTEMP
                  IF(SDASC(IT,J).NE.SDBIN(IT,J))GOTO120
                  IF(ODASC(IT,J).NE.ODBIN(IT,J))GOTO120
  100         CONTINUE
  110     CONTINUE
C
C         SUCCESSFUL WRITE
          WRITE(*,'(/A,I7,A,I6,A)')
     1      ' BAND MODEL PARAMETER FILE CONTAINS',NREC,
     2      ' RECORDS (LAST FREQUENCY IS',IFLAST,' CM-1)'
          CLOSE(IASCII,STATUS='KEEP')
          CLOSE(IBNARY,STATUS='KEEP')
          WRITE(*,'(/3A,/5X,A)')' SUCCESSFULLY CREATED',
     1      ' THE DIRECT-ACCESS, BINARY (UNFORMATTED)',
     2      ' BAND MODEL FILE:',BINNAM(1:LENBIN)
          WRITE(*,'(/10X,A,/10X,A,/(10X,A,I6,A))')
     1      ' *************************************************',
     2      ' *  THIS MACHINE REQUIRES THAT OPTION "RECL" BE  *',
     3      ' *  SET EQUAL TO',IRECLN,' IN ROUTINE "openbm.f"     *',
     4      ' *************************************************'
          STOP
C
C         INCREASE RECORD LENGTH AND START OVER
  120     CONTINUE
          CLOSE(IBNARY,STATUS='DELETE')
          IF(IRECLN.GE.MXRCLN)THEN
              WRITE(*,'(/3A,/A,I8)')' ERROR:  UNABLE TO WRITE',
     1          ' DIRECT-ACCESS BINARY FILE:  ',BINNAM(1:LENBIN),
     2          '         LARGEST RECORD LENGTH TRIED WAS',IRECLN
              STOP
          ENDIF
          WRITE(*,FMT='(/(2A,I8,A))')' AN ERROR OCCURRED',
     1      ' WHEN A RECORD LENGTH OF',IRECLN,' WAS USED.'
          IF(IRECLN.EQ.MXRCLN-4)THEN
              IRECLN=MXRCLN
          ELSE
              IRECLN=2*IRECLN
          ENDIF
          WRITE(*,FMT='((A,I8,A))')
     1      ' A RECORD LENGTH OF',IRECLN,' WILL NOW BE TRIED.'
          REWIND(IASCII)
          GOTO40
C
C         UNABLE TO READ ASCII FILE
  130     CONTINUE
          IF(LENASC.GT.0)WRITE(*,'(/(5A))')' ERROR:  UNABLE',
     1      ' TO READ',MESSAG,' FROM ASCII FILE:  ',ASCNAM(1:LENASC),
     2      '         NO BINARY FILE WAS CREATED.'
          CLOSE(IASCII,STATUS='KEEP')
          CLOSE(IBNARY,STATUS='DELETE')
          STOP
      ELSEIF(ANSWER.EQ.'2')THEN
C
C         ENTER NAME OF OLD BINARY FILE
  140     WRITE(*,'(/2A,/(A))')' ENTER NAME OF BINARY',
     1      ' BAND MODEL FILE (MAX 150 CHARACTERS)',
     2      '      [ENTER 0 FOR NAME = "BMP99_01.BIN"]',
     3      '      [ENTER 1 FOR NAME = "BMP99_15.BIN"]'
          READ(*,'(A)',END=140,ERR=140)BINNAM
          LENBIN=MINLEN(BINNAM)
          IF(LENBIN.EQ.0)GOTO140
          IF(LENBIN.EQ.1)THEN
              IF(BINNAM(1:1).EQ.'0')THEN
                  LENBIN=12
                  BINNAM(1:LENBIN)='BMP99_01.BIN'
              ELSEIF(BINNAM(1:1).EQ.'1')THEN
                  LENBIN=12
                  BINNAM(1:LENBIN)='BMP99_15.BIN'
              ENDIF
          ENDIF
C         INQUIRE(FILE=BINNAM(1:LENBIN),EXIST=LEXIST,DIRECT=ACCESS)
          INQUIRE(FILE=BINNAM(1:LENBIN),EXIST=LEXIST)
          IF(.NOT.LEXIST)THEN
             WRITE(*,'(/3A)')' FILE "',BINNAM(1:LENBIN),
     1         '" DOES NOT EXIST.  PLEASE RE-ENTER.'
             GOTO140
          ENDIF
C         IF(ACCESS(1:1).EQ.CHAR(78).OR.ACCESS(1:1).EQ.CHAR(110))THEN
C             WRITE(*,'(/(3A))')' FILE "',BINNAM(1:LENBIN),
C    1          '" CAN NOT BE CONNECTED FOR DIRECT-ACCESS.',
C    2          ' IS IT THE WRONG FILE?'
C             GOTO140
C         ENDIF
C
C         READ THE NUMBER OF TEMPERATURES (NTEMP) FROM HEADER.
          IRECLN=8
          OPEN(IBNARY,FILE=BINNAM(1:LENBIN),STATUS='OLD',
     1      FORM='UNFORMATTED',ACCESS='DIRECT',RECL=IRECLN,ERR=200)
          NREC=1
          MESSAG=' HEADER'
          READ(IBNARY,REC=NREC,ERR=200)NTEMP
          CLOSE(IBNARY,STATUS='KEEP')
          IF(NTEMP.LE.0 .OR. NTEMP.GT.MXTEMP)THEN
              WRITE(*,'(/2A,I3,A,/8X,2A,I3,A)')
     1          ' ERROR:  INPUT NUMBER OF TEMPERATURES',
     2          ' (NTEMP =',NTEMP,' MUST BE',' POSITIVE AND',
     3          ' CAN NOT EXCEED PARAMETER MXTEMP (=',MXTEMP,').'
              STOP 'NTEMP OUT OF RANGE'
          ENDIF
C
C         SET INITIAL AND MAXIMUM RECORD LENGTH
C         INTEGER AND REAL VARIABLES ON HP ARE OF RECORD LENGTH 4
C         ON IBM VM/CMS, IT IS 4; THERE IS ALSO A 4 BYTE PADDING
C         INTEGER AND REAL VARIABLES ON SG & DEC ARE OF RECORD LENGTH 1
          IRECLN=2*NTEMP+3
          MXRCLN=4*IRECLN+4
C
C         ENTER NAME OF NEW ASCII FILE
  150     WRITE(*,'(/(A))')
     1      ' ENTER ASCII BAND MODEL FILE NAME (MAX 150 CHARACTERS)',
     2      '      [ENTER 0 FOR NAME = "BMP99_01.ASC"]',
     3      '      [ENTER 1 FOR NAME = "BMP99_15.ASC"]'
          READ(*,'(A)',END=150,ERR=150)ASCNAM
          LENASC=MINLEN(ASCNAM)
          IF(LENASC.EQ.0)GOTO150
          IF(LENASC.EQ.1)THEN
              IF(ASCNAM(1:1).EQ.'0')THEN
                  LENASC=12
                  ASCNAM(1:LENASC)='BMP99_01.ASC'
              ELSEIF(ASCNAM(1:1).EQ.'1')THEN
                  LENASC=12
                  ASCNAM(1:LENASC)='BMP99_15.ASC'
              ENDIF
          ENDIF
          INQUIRE(FILE=ASCNAM(1:LENASC),EXIST=LEXIST)
          IF(LEXIST)THEN
              WRITE(*,'(/4A,/11X,A)')' WARNING:  ',
     1          'THE FILE "',ASCNAM(1:LENASC),'" ALREADY EXISTS.',
     2          'DO YOU WISH TO OVERWRITE THE PRE-EXISTING FILE (Y/N)?'
              READ(*,'(A1)')ANSWER
              IF(ANSWER.NE.CHAR(89).AND.ANSWER.NE.CHAR(121))GOTO150
              OPEN(IASCII,FILE=ASCNAM(1:LENASC),STATUS='OLD')
              CLOSE(IASCII,STATUS='DELETE')
          ENDIF
  160     CONTINUE
          OPEN(IASCII,FILE=ASCNAM(1:LENASC),STATUS='NEW')
          OPEN(IBNARY,FILE=BINNAM(1:LENBIN),STATUS='OLD',
     1      FORM='UNFORMATTED',ACCESS='DIRECT',RECL=IRECLN,ERR=190)
C
C         READ THE BAND MODEL FILE HEADER.  IBNDWD IS THE WIDTH (CM-1)
          NREC=1
          MESSAG=' HEADER'
          READ(IBNARY,REC=NREC,ERR=161)NTEMP,(TBAND(IT),IT=1,NTEMP),
     1      IBNDWD,IF1ST,IFLAST,LSTREC,NDIVID,DEDGE
          IF(DEDGE.EQ.0.)GOTO161
          GOTO162
C
C             OLD FORMAT
  161         CONTINUE
              
              READ(IBNARY,REC=NREC,ERR=190)NTEMP,(TBAND(IT),IT=1,NTEMP),
     1          IBNDWD,IF1ST,IFLAST,LSTREC,DEDGE
              NDIVID=1
  162     CONTINUE
          WRITE(IASCII,'(I3,0P11F7.0:,/(3X,0P11F7.0))')
     1      NTEMP,(TBAND(IT),IT=1,NTEMP)
          WRITE(IASCII,'(5I8,F8.3)')
     1      IBNDWD,IF1ST,IFLAST,LSTREC,NDIVID,DEDGE
C
C         ECHO HEADER INFO
          WRITE(*,'(/5X,A,/I3,0P11F7.0)')
     1      'NTEMP,(TBAND(IT),IT=1,NTEMP)',
     2      NTEMP,(TBAND(IT),IT=1,NTEMP)
          WRITE(*,'(/2(A,I7,5X),A,I7,/2(A,I7,5X),A,F7.3)')
     1      'IBNDWD=',IBNDWD,' IF1ST=', IF1ST,'IFLAST=',IFLAST,
     2      'LSTREC=',LSTREC,'NDIVID=',NDIVID,' DEDGE=', DEDGE
C
C         READ DATA
          MESSAG='  DATA '
          NREC=NREC+1
          READ(IBNARY,REC=NREC,ERR=190)
     1      IBIN,IMOL,(SD(IT),IT=1,NTEMP),IALF,(OD(IT),IT=1,NTEMP)
          WRITE(IASCII,'(I6,I5,1P11E11.3)')IBIN,IMOL,(SD(IT),IT=1,NTEMP)
          WRITE(IASCII,'(6X,I5,1P11E11.3)')IALF,(OD(IT),IT=1,NTEMP)
  170     NREC=NREC+1
          READ(IBNARY,REC=NREC,ERR=180)
     1      IBIN,IMOL,(SD(IT),IT=1,NTEMP),IALF,(OD(IT),IT=1,NTEMP)
          WRITE(IASCII,'(I6,I5,1P11E11.3)')IBIN,IMOL,(SD(IT),IT=1,NTEMP)
          WRITE(IASCII,'(6X,I5,1P11E11.3)')IALF,(OD(IT),IT=1,NTEMP)
          IF(8000*(NREC/8000).EQ.NREC)THEN
C
C             WRITE EACH 8000 RECORDS TO KEEP USER AWARE OF PROGRESS.
              WRITE(*,'(/A,I7,A)')' BAND MODEL RECORD',NREC,' IS:'
              WRITE(*,'(I6,I5,1P11E11.3)')IBIN,IMOL,(SD(IT),IT=1,NTEMP)
              WRITE(*,'(6X,I5,1P11E11.3)')IALF,(OD(IT),IT=1,NTEMP)
          ENDIF
          GOTO170
  180     CONTINUE
          NREC=NREC-1
          WRITE(*,'(/3(A,I7))')
     1      ' BAND MODEL PARAMETER FILE CONTAINS',NREC,
     2      ' RECORDS (LAST FREQUENCY IS',IFLAST,' CM-1)'
          CLOSE(IASCII,STATUS='KEEP')
          CLOSE(IBNARY,STATUS='KEEP')
          WRITE(*,'(/2A,/5X,A)')' SUCCESSFULLY CREATED THE ASCII',
     1      ' (FORMATTED) BAND MODEL FILE:',ASCNAM(1:LENASC)
          STOP
C
C         UNABLE TO READ BINARY FILE
 190      CONTINUE
          CLOSE(IASCII,STATUS='DELETE')
          CLOSE(IBNARY,STATUS='KEEP')
          IF(IRECLN.LT.MXRCLN)THEN
              WRITE(*,FMT='(/(2A,I8,A))')' AN ERROR OCCURRED',
     1          ' WHEN A RECORD LENGTH OF',IRECLN,' WAS USED.'
              IF(IRECLN.EQ.MXRCLN-4)THEN
                  IRECLN=MXRCLN
              ELSE
                  IRECLN=2*IRECLN
              ENDIF
              WRITE(*,FMT='((A,I8,A))')
     1          ' A RECORD LENGTH OF',IRECLN,' WILL NOW BE TRIED.'
              GOTO160
          ENDIF
  200     CONTINUE
          IF(LENBIN.GT.0)WRITE(*,'(/(5A))')' ERROR:  UNABLE',
     1      ' TO READ',MESSAG,' FROM BINARY FILE:  ',BINNAM(1:LENBIN),
     2      '         NO ASCII FILE WAS CREATED.'
          WRITE(*,'(/A,I8)')
     1      ' LAST (AND LARGEST) RECORD LENGTH TRIED WAS',IRECLN
          STOP
      ELSE
          GOTO10
      ENDIF
      END
      INTEGER FUNCTION MINLEN(STRING)
C
C     THIS ROUTINE ELIMINATES LEADING BLANKS FROM STRING, AND
C     DETERMINES LENGTH OF FIRST CHARACTER STRING.
C
C     DECLARE VARIABLES
      CHARACTER*(*) STRING
      INTEGER LENGTH,ISTART,I
C
C     POSITION OF FIRST NON-BLANK CHARACTER
      LENGTH=LEN(STRING)
      DO 10 ISTART=1,LENGTH
          IF(STRING(ISTART:ISTART).NE.' ')GOTO20
   10 CONTINUE
C
C     BLANK STRING
      MINLEN=0
      RETURN
C
C     ELIMINATE LEADING BLANKS
   20 CONTINUE
      STRING(1:LENGTH-ISTART+1)=STRING(ISTART:LENGTH)
C
C     ADD TRAILING BLANKS
      DO 30 I=LENGTH-ISTART+2,LENGTH
          STRING(I:I)=' '
   30 CONTINUE
C
C     DETERMINE LENGTH OF FIRST CHARACTER STRING BY FINDING FIRST BLANK
      MINLEN=INDEX(STRING,' ')-1
      IF(MINLEN.LT.0)MINLEN=LENGTH
      RETURN
      END