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