FLECS VERSION 860214 27-MAR-87 11:27:14 PAGE 00001 ISUB,ISUB/-SP=[MP1Q.FLEALECOM]ISUB/CO:VAX 00001 00000 C;+ 00002 00000 C - I M P O P N 00003 00000 C****NAME: SUBROUTINE IMPOPN 00004 00000 C IDENT: /850304/ 00005 00000 C FILE: ISUB.FLX 00006 00000 C 00007 00000 C****PURPOSE: Process the FLECS .IMPLICIT NONE statement. See note 1. 00008 00000 C 00009 00000 C****RESTRICTIONS: 00010 00000 C 00011 00000 C SYSTEM: RSX11M V4.1, VMS V4.0 00012 00000 C LANGUAGE: FLECS/FORTRAN 00013 00000 C AUTHOR: M. OOTHOUDT 00014 00000 C DATE: 07-MAR-84 00015 00000 C REVISIONS: 00016 00000 C 850228mao Use FINPOP instead of FORT OPEN; Use PUTNUM instead of ENCOD 00017 00000 C 850304mao New call to FIMPOP to be RSX-11M/VMS compatible. 00018 00000 C 00019 00000 C****CALLING SEQUENCE: CALL IMPOPN (IMPSET,LINENO,FORTCL,ERRCL,MAJCNT) 00020 00000 C 00021 00000 C INPUT: 00022 00000 C 00023 00000 C IMPSET= (L*2) .T. if file already open; .F. otherwise. 00024 00000 C LINENO= (I*2) number of source line input came from. 00025 00000 C FORTCL= (I*2) IO class for fortran file. 00026 00000 C ERRCL = (I*2) IO class for error messages. 00027 00000 C 00028 00000 C OUTPUT: 00029 00000 C 00030 00000 C IMPSET= (L*2) set .T. if .FID file openned. 00031 00000 C MAJCNT= (I*2) incremented if .FID already open (major error counter). 00032 00000 C 00033 00000 C CMN BLOCK I/O: NONE 00034 00000 C 00035 00000 C RESOURCES: 00036 00000 C LIBRARIES: NONE 00037 00000 C OTHER SUBR: FIMPOP,PUT,PUTNUM 00038 00000 C DISK FILES: n.FID 00039 00000 C DEVICES: None 00040 00000 C SGAS: NONE 00041 00000 C EVENT FLAGS: NONE 00042 00000 C SYSTEM DIR: NONE 00043 00000 C 00044 00000 C****NOTES: 00045 00000 C 1. FLECS generates variables with names like I32767 00046 00000 C for procedure invocations. If the FORTRAN "IMPLICIT NONE" statement 00047 00000 C is used, such variables are illegal. This subroutine processes 00048 00000 C the FLECS directive ".IMPLICT NONE" statement to put 00049 00000 C "IMPLICT NONE" 00050 00000 C INCLUDE 'n.FID/-LI' 00051 00000 C in the FORTRAN file. Then it opens a file named n.FID. Later calls 00052 00000 C to IMPWRT will put lines like "INTEGER*2 I32767" into the file. 00053 00000 C 00054 00000 C 2. F4P and F77 do not have an IMPLICT NONE statement. For 00055 00000 C these compiliers we use "IMPLICIT COMPLEX (A-Z)", which is almost FLECS VERSION 860214 27-MAR-87 11:27:14 PAGE 00002 ISUB,ISUB/-SP=[MP1Q.FLEALECOM]ISUB/CO:VAX 00056 00000 C as good. 00057 00000 C;- FLECS VERSION 860214 27-MAR-87 11:27:14 PAGE 00003 ISUB,ISUB/-SP=[MP1Q.FLEALECOM]ISUB/CO:VAX 00058 00000 .PAGE 00059 00001 SUBROUTINE IMPOPN (IMPSET,LINENO,FORTCL,ERRCL,MAJCNT) 00060 00001 00061 00001 C Declarations 00062 00001 00063 00002 INTEGER*2 ERRCL !EXT, R, IO class for PUT call 00064 00003 BYTE FILE(14) !LOC, R/W, file name 00065 00004 INTEGER*2 FNUM !LOC, R/W, # to use for .FID file name 00066 00005 INTEGER*2 FORTCL !EXT, R, IO class for PUT call 00067 00006 INTEGER*2 IMPDSC(2,4) !LOC, R/W, filename descriptor table 00068 00007 LOGICAL*2 IMPSET !EXT, R/W, .T. if .FID file is open 00069 00008 INTEGER*2 LINENO !EXT, R, line # for PUT call 00070 00009 INTEGER*2 MAJCNT !EXT, R/W, counter for major errors 00071 00010 INTEGER*2 NUM(4) !LOC, R/W, FNUM in ASCII 00072 00011 INTEGER*2 SALRDY(18) !LOC, R, error text 00073 00012 INTEGER*2 SIMPNO(15) !LOC, R, FORTRAN implict none statement 00074 00013 INTEGER*2 SINCL(18) !LOC, R/W, FORTRAN include statement 00075 00013 00076 00014 DATA FILE /1HS,1HY,1H0,1H:,1H ,1H ,1H ,1H ,1H , 00077 00015 1 1H.,1HF,1HI,1HD,0/ 00078 00016 DATA IMPDSC /4,1,0,0,9,5,13,1/ !850304mao 00079 00016 00080 00017 DATA FNUM /32767/ 00081 00018 DATA SALRDY/34,2H**,2H**,2H**,2H.I,2HMP,2HLI,2HCI,2HT ,2HNO, 00082 00019 1 2HNE,2H A,2HLR,2HEA,2HDY,2H G,2HIV,2HEN/ 00083 00019 .PASSIF VAX 00084 00020 DATA SIMPNO/19,2H ,2H ,2H ,2HIM,2HPL,2HIC,2HIT,2H N,2HON,2HE , 00085 00021 1 4*2H / 00086 00021 .PASSEND 00087 00021 .PASSIF PDP 00090 00021 .PASSEND 00091 00022 DATA SINCL/34,2H ,2H ,2H ,2HIN,2HCL,2HUD,2HE ,2H' ,2H ,2H , 00092 00023 1 2H ,2H.F,2HID,2H/N,2HOL,2HIS,2HT'/ 00093 00023 00094 00023 .PASSUNLESS VAX 00095 00023 .PASSUNLESS PDP 00097 00023 .PASSEND 00098 00023 .PASSEND 00099 00023 00100 00024 WHEN (IMPSET) 00101 00024 . 00102 00024 C . This program module has already done a .IMPLICIT NONE 00103 00024 . 00104 00025 . CALL PUT (0,SALRDY,ERRCL) 00105 00026 . MAJCNT=MAJCNT+1 00106 00026 ...FIN!when 00107 00027 ELSE 00108 00027 . 00109 00028 . FNUM=FNUM-1 00110 00028 . 00111 00028 C . Following funny use of FILE due to PUTNUM expecting a 00112 00028 C . FLECS string--we fake it this way. (Cannot use FLECS string 00113 00028 C . or OPEN will have trouble.) 00114 00028 . 00115 00029 . CALL PUTNUM (FILE(3),FNUM) !850228mao FLECS VERSION 860214 27-MAR-87 11:27:14 PAGE 00004 ISUB,ISUB/-SP=[MP1Q.FLEALECOM]ISUB/CO:VAX 00116 00030 . FILE(10) = 1H. !PUTNUM wipes out period!850228mao 00117 00030 . 00118 00031 . CALL FIMPOP (FILE,IMPDSC) !850304mao 00119 00031 . 00120 00031 C . Put out the FORTRAN IMPLICIT line. 00121 00031 . 00122 00032 . CALL PUT (LINENO,SIMPNO,FORTCL) 00123 00032 . 00124 00032 C . Put out the FORTRAN INCLUDE line. 00125 00032 . 00126 00033 . CALL PUTNUM (SINCL(9),FNUM) !850228mao 00127 00034 . CALL PUT (LINENO,SINCL,FORTCL) 00128 00034 . 00129 00035 . IMPSET=.TRUE. 00130 00035 ...FIN!when 00131 00037 RETURN 00132 00038 END (FLECS VERSION 22.38) FLECS VERSION 860214 27-MAR-87 11:27:14 PAGE 00005 ISUB,ISUB/-SP=[MP1Q.FLEALECOM]ISUB/CO:VAX 00133 00000 .PAGE 00134 00000 C;+ 00135 00000 C - I M P W R T 00136 00000 C****NAME: SUBROUTINE IMPWRT 00137 00000 C IDENT: /850228/ 00138 00000 C FILE: ISUB.FLX 00139 00000 C 00140 00000 C****PURPOSE: Write a line to the .FID file. 00141 00000 C 00142 00000 C****RESTRICTIONS: 00143 00000 C 00144 00000 C SYSTEM: RSX11M V4.1, VMS V4.0 00145 00000 C LANGUAGE: FLECS/FORTRAN 00146 00000 C AUTHOR: M. OOTHOUDT 00147 00000 C DATE: 07-MAR-84 00148 00000 C REVISIONS: 00149 00000 C 850228mao Use PUTNUM & FIMPWR instead of FORT WRITE. 00150 00000 C 00151 00000 C****CALLING SEQUENCE: CALL IMPWRT (NUM,LINENO,IOCLAS) 00152 00000 C 00153 00000 C INPUT: 00154 00000 C 00155 00000 C NUM =(I*2) Number for variable to go into .FID file. 00156 00000 C LINENO=(I*2) Number of source line input came from. 00157 00000 C IOCLAS=(I*2) I/O class for output stream. 00158 00000 C 00159 00000 C OUTPUT: NONE 00160 00000 C 00161 00000 C CMN BLOCK I/O: NONE 00162 00000 C 00163 00000 C RESOURCES: 00164 00000 C LIBRARIES: NONE 00165 00000 C OTHER SUBR: PUTNUM, FIMPWR 00166 00000 C DISK FILES: NONE 00167 00000 C DEVICES: NONE 00168 00000 C SGAS: NONE 00169 00000 C EVENT FLAGS: NONE 00170 00000 C SYSTEM DIR: NONE 00171 00000 C 00172 00000 C****NOTES: 00173 00000 C;- FLECS VERSION 860214 27-MAR-87 11:27:14 PAGE 00006 ISUB,ISUB/-SP=[MP1Q.FLEALECOM]ISUB/CO:VAX 00174 00000 .PAGE 00175 00001 SUBROUTINE IMPWRT (NUM,LINENO,IOCLAS) 00176 00001 00177 00001 C DECLARATIONS 00178 00001 00179 00002 INTEGER*2 IOCLAS !EXT, R, I/O class for output 00180 00003 BYTE LINE(22) !LOC, R/W, line to output 00181 00004 INTEGER*2 LINENO !EXT, R, # of line in source file 00182 00005 INTEGER*2 NUM !EXT, R, variable number 00183 00005 00184 00006 DATA LINE /6*' ','I','N','T','E','G','E','R',' ',' ', 00185 00007 1 'I',6*' '/ 00186 00008 CALL PUTNUM (LINE(15),NUM) !850228mao 00187 00009 CALL FIMPWR (LINE,21) !850228mao 00188 00009 00189 00010 RETURN 00190 00011 END (FLECS VERSION 22.38) FLECS VERSION 860214 27-MAR-87 11:27:14 PAGE 00007 ISUB,ISUB/-SP=[MP1Q.FLEALECOM]ISUB/CO:VAX 00191 00000 .PAGE 00192 00000 C;+ 00193 00000 C - I M P C L S 00194 00000 C****NAME: SUBROUTINE IMPCLS 00195 00000 C IDENT: /850228/ 00196 00000 C FILE: ISUB.FLX 00197 00000 C 00198 00000 C****PURPOSE: Close .FID file. 00199 00000 C 00200 00000 C****RESTRICTIONS: 00201 00000 C 00202 00000 C SYSTEM: RSX11M V4.1, VMS V4.0 00203 00000 C LANGUAGE: FLECS/FORTRAN 00204 00000 C AUTHOR: M. OOTHOUDT 00205 00000 C DATE: 07-MAR-84 00206 00000 C REVISIONS: 00207 00000 C 850228mao Use FIMPCL instead of FORT close. 00208 00000 C 00209 00000 C****CALLING SEQUENCE: CALL IMPCLS 00210 00000 C 00211 00000 C INPUT: NONE 00212 00000 C 00213 00000 C OUTPUT: NONE 00214 00000 C 00215 00000 C CMN BLOCK I/O: NONE 00216 00000 C 00217 00000 C RESOURCES: 00218 00000 C LIBRARIES: NONE 00219 00000 C OTHER SUBR: FIMPCL 00220 00000 C DISK FILES: .FID FILE 00221 00000 C DEVICES: NONE 00222 00000 C SGAS: NONE 00223 00000 C EVENT FLAGS: NONE 00224 00000 C SYSTEM DIR: NONE 00225 00000 C 00226 00000 C****NOTES: 00227 00000 C;- 00228 00001 SUBROUTINE IMPCLS 00229 00001 C 00230 00002 CALL FIMPCL 00231 00002 00232 00003 RETURN 00233 00004 END (FLECS VERSION 22.38)