SUBROUTINE IMPOPN (IMPSET,LINENO,FORTCL,ERRCL,MAJCNT) 00059 INTEGER*2 ERRCL !EXT, R, IO class for PUT call 00063 BYTE FILE(14) !LOC, R/W, file name 00064 INTEGER*2 FNUM !LOC, R/W, # to use for .FID file name 00065 INTEGER*2 FORTCL !EXT, R, IO class for PUT call 00066 INTEGER*2 IMPDSC(2,4) !LOC, R/W, filename descriptor table 00067 LOGICAL*2 IMPSET !EXT, R/W, .T. if .FID file is open 00068 INTEGER*2 LINENO !EXT, R, line # for PUT call 00069 INTEGER*2 MAJCNT !EXT, R/W, counter for major errors 00070 INTEGER*2 NUM(4) !LOC, R/W, FNUM in ASCII 00071 INTEGER*2 SALRDY(18) !LOC, R, error text 00072 INTEGER*2 SIMPNO(15) !LOC, R, FORTRAN implict none statement 00073 INTEGER*2 SINCL(18) !LOC, R/W, FORTRAN include statement 00074 DATA FILE /1HS,1HY,1H0,1H:,1H ,1H ,1H ,1H ,1H , 00076 1 1H.,1HF,1HI,1HD,0/ 00077 DATA IMPDSC /4,1,0,0,9,5,13,1/ !850304mao 00078 DATA FNUM /32767/ 00080 DATA SALRDY/34,2H**,2H**,2H**,2H.I,2HMP,2HLI,2HCI,2HT ,2HNO, 00081 1 2HNE,2H A,2HLR,2HEA,2HDY,2H G,2HIV,2HEN/ 00082 DATA SIMPNO/19,2H ,2H ,2H ,2HIM,2HPL,2HIC,2HIT,2H N,2HON,2HE , 00084 1 4*2H / 00085 DATA SINCL/34,2H ,2H ,2H ,2HIN,2HCL,2HUD,2HE ,2H' ,2H ,2H , 00091 1 2H ,2H.F,2HID,2H/N,2HOL,2HIS,2HT'/ 00092 IF(IMPSET)THEN 00100 CALL PUT (0,SALRDY,ERRCL) 00104 MAJCNT=MAJCNT+1 00105 ELSE 00107 FNUM=FNUM-1 00109 CALL PUTNUM (FILE(3),FNUM) !850228mao 00115 FILE(10) = 1H. !PUTNUM wipes out period!850228mao 00116 CALL FIMPOP (FILE,IMPDSC) !850304mao 00118 CALL PUT (LINENO,SIMPNO,FORTCL) 00122 CALL PUTNUM (SINCL(9),FNUM) !850228mao 00126 CALL PUT (LINENO,SINCL,FORTCL) 00127 IMPSET=.TRUE. 00129 ENDIF 00130 RETURN 00131 END 00132 SUBROUTINE IMPWRT (NUM,LINENO,IOCLAS) 00175 INTEGER*2 IOCLAS !EXT, R, I/O class for output 00179 BYTE LINE(22) !LOC, R/W, line to output 00180 INTEGER*2 LINENO !EXT, R, # of line in source file 00181 INTEGER*2 NUM !EXT, R, variable number 00182 DATA LINE /6*' ','I','N','T','E','G','E','R',' ',' ', 00184 1 'I',6*' '/ 00185 CALL PUTNUM (LINE(15),NUM) !850228mao 00186 CALL FIMPWR (LINE,21) !850228mao 00187 RETURN 00189 END 00190 SUBROUTINE IMPCLS 00228 CALL FIMPCL 00230 RETURN 00232 END 00233