1 program CDEMOM 2c . Copyright (C) 1989, California Institute of Technology. 3c . All rights reserved. U. S. Government sponsorship under 4c . NASA contract NAS7-918 is acknowledged. 5c>> 1996-06-13 CDEMOM Krogh Added "C Only" option. 6c>> 1995-10-23 CDEMOM Krogh Initial Code 7c Makes up "batch", "script", "add", etc. files for various machines. 8c These are run on various machines, and the output resutling from these 9c runs is used for input into the program CDEMO. 10c Files are constructed using the a template file and the configuration 11c file CDCFG. The template file starts with lines (if any) which are to 12c be output once at the beginning, then lines that are to be output once 13c for each of the demonstration drivers, and finally lines (if any) 14c which are to be output once at the very end. Special meaning is 15c attached to the following character sequences. 16c #1 This is to be replaced by the name of the demonstration driver. 17c #2 This is to be replaced by the name of the demonstration driver in 18c upper case. (#1 is lower case) If a #2 is used anyplace, the 19c name will be upper case wherever it is substituted. 20c #3 This is the end of the last line for output to occur one time at 21c the very beginning. (#1/#2 has no special meaning in this text.) 22c #4 This is the end of the last line that is to be output for each of 23c the demonstration drivers. 24c #5 Text following this is treated as a comment. 25c As an example of a templace file, we list here PCLF77L.T a template 26c file to use the Lahey Fortran F77l compliler on the PC under DOS. 27c del pc.res /n#3 28c echo =#1 PC - Lahey F77L >>pc.res 29c f77l k:\math77\demo\#1, #1.obj /NS 30c d:\progs\link #1,,,k:\math77\fortran\obj\math77; 31c #1 >>pc.res 32c del #1.* /n#4 33c Note that even if you were on a PC using the Lahey Fortran F77L 34c compiler under DOS, you will still have to modify this template file 35c to use the directories appropriate for your machine, i.e. the 36c directories for the demonstration driver source, the directory where 37c the Lahey linker resides, and the directory where the library file for 38c the MATH77 library resides. 39c 40c ******************** Variable Definitions **************************** 41c 42c cdcfg the name of the configuration file. 43c C Temporary storage for a single character. 44c I Temporary index. 45c J Temporary index. 46c K Temporary index. 47c CCODE Logical variable set .true. if processing template for 48c generating output. 49c KACLIN Defines where the name of the demo driver is to be output. 50c Text from characters KACLIN(J-1, K) to KACLIN(J, K) -3 are taken 51c from line K, then if not at the end, the text for the demo driver 52c name is inserted, J incremented and the process repeated. 53c L Temporary index. 54c LBEGMA Index for the first line that is output for every demo. driver. 55c LENDMA Index for the last line that is output for every demo. driver. 56c LENLIN LENLIN(K) gives the index of the last nonblank character in 57c LINE(K). (If the line ends with #3, #4, or #5, it gives the index 58c of the character just precding the "#". 59c LETDIF The differece ichar('A') - ichar('a'). 60c LINE() Place where lines from the template file are stored. 61c LNAM Index of last nonblank in NAME. 62c LONAM The number of character in ONAME with trailing blanks removed. 63c LSPEC Initially -1. If this gets set > 0, then in addition to 64c looking for '=' in column 1, code looks for '.for' at end. 65c LTNAM The number of chacters in TNAME with trailing blanks removed. 66c MAXLIN The most lines that can appear in a template file. (Not 67c counting full line comment lines. 68c MLCA = ichar('a') 69c MLCZ = ichar('z') 70c MUCA = ichar('A') 71c MUCZ = ichar('U') 72c N Temporary index. 73c NL Indexes the lines of the template file begin read in. At the 74c end contains one more than the index of the last line to output. 75c NAME Holds name of the current demonstration driver. (The first 76c character is '=' and is not part of the name.) 77c TNAME The name of the template file. 78c ONAME The name of the output file. 79c UPCASE = .TRUE. if names are to be converted to upper case. 80c 81c 82c ********************** Specifications ******************************** 83c 84 integer MAXLIN 85 parameter (MAXLIN = 30) 86 integer I, J, K, KACLIN(0:10, MAXLIN), L, LBEGMA, LENDMA, 87 1 LENLIN(MAXLIN), LETDIF, LNAM, LONAM, LSPEC, LTNAM, MLCA, MLCZ, 88 2 MUCA, MUCZ, N, NL 89 logical CCODE, UPCASE 90 character C 91 character*128 BUF, LINE(MAXLIN), NAME, ONAME, TNAME 92 data LSPEC / -1 / 93c 94c ******************** Formats ***************************************** 95c 96 1000 format(/, ' Input name of template file: ') 97 1010 format(' Output file is: ', A) 98c 99c ****************** Start of Executable Code ************************** 100c 101 MUCA = ichar('A') 102 MLCA = ichar('a') 103 MUCZ = ichar('Z') 104 MLCZ = ichar('z') 105 LETDIF = MUCA - MLCA 106 UPCASE = .FALSE. 107 open(7, FILE='cdcfg', STATUS='OLD') 108 30 print 1000 109 read(*, '(A)') TNAME 110 do 40 I = 1, 128 111 if (TNAME(I:I) .eq. ' ') go to 60 112 40 continue 113 go to 30 114 60 LTNAM = I - 1 115 open(8, FILE=TNAME(1:LTNAM), STATUS='OLD') 116c Get the output file name 117 ONAME = TNAME 118 CCODE = .false. 119 K = index('FfCc', ONAME(LTNAM:LTNAM)) 120 if (K .ne. 0) then 121 if (K .gt. 2) CCODE = .true. 122 LONAM = LTNAM - 1 123 if ((ONAME(LONAM:LONAM) .eq. 'T') .or. 124 1 (ONAME(LONAM:LONAM) .eq. 't')) then 125 LONAM = LONAM - 1 126 if (ONAME(LONAM:LONAM) .eq. '.') LONAM = LONAM - 1 127 end if 128 else 129 LONAM = LTNAM+1 130 ONAME(LONAM:LONAM) = 'M' 131 end if 132 if (ONAME(1:2) .eq. 'PC') then 133 ONAME(LONAM+1:LONAM+4) = '.BAT' 134 LONAM = LONAM + 4 135 else if (ONAME(1:2) .eq. 'pc') then 136 ONAME(LONAM+1:LONAM+4) = '.bat' 137 LONAM = LONAM + 4 138 end if 139 open(9, FILE=ONAME(1:LONAM), STATUS='UNKNOWN') 140c Got the ouput file set up 141 LBEGMA = 1 142 LENDMA = 0 143c Process the template file 144 do 180 NL = 1, MAXLIN 145 J = 0 146 KACLIN(0, NL) = 1 147 80 read (8, '(A)', END=200) LINE(NL) 148 do 100 I = 128, 1, -1 149 if (LINE(NL)(I:I) .ne. ' ') go to 120 150 100 continue 151 120 LENLIN(NL) = I 152 L = 0 153 140 I = L + index(LINE(NL)(L+1:), '#') 154 if (I .eq. L) then 155 J = J + 1 156 KACLIN(J, NL) = LENLIN(NL) + 3 157 else 158 C = LINE(NL)(I+1:I+1) 159 if (C .le. '2') then 160 if (C .eq. '2') UPCASE = .TRUE. 161 J = J + 1 162 L = I + 1 163 KACLIN(J, NL) = L + 1 164 go to 140 165 else if (C .eq. '3') then 166c Flags the end of a prefix 167 LBEGMA = NL + 1 168 else if (C .eq. '4') then 169c Flags the end of the main loop. 170 LENDMA = NL 171 else if (C .eq. '5') then 172c Take care of an end of line comment 173 if (I .eq. 1) go to 80 174 else 175 L = I + 1 176 go to 140 177 end if 178c Back off from the "#..." ending the line 179 J = J + 1 180 KACLIN(J, NL) = I + 2 181 LENLIN(NL) = I - 1 182 end if 183 KACLIN(J+1, NL) = 0 184 180 continue 185 stop 'Capacity exceeded -- increase value of parameter MAXLIN' 186 200 NL = NL - 1 187 if (LENDMA .eq. 0) LENDMA = NL 188c 189c Take care of the prefix lines 190 do 250 K = 1, LBEGMA-1 191 write (9, '(A)') LINE(K)(1:LENLIN(K)) 192 250 continue 193c 194c Take care of the main loop. 195 300 continue 196 read (7, '(A)', END = 500) NAME 197 LSPEC = LSPEC + 1 198 if (NAME(1:1) .ne. '=') then 199 if (LSPEC .lt. 0) go to 300 200 if (LSPEC .eq. 0) then 201 K = index(NAME, '.FOR') 202 if (K .eq. 0) K = index(NAME, '.for') 203 if (K .eq. 0) then 204 LSPEC = -100000 205 go to 300 206 end if 207 else 208 K = index(NAME, '.FOR') 209 if (K .eq. 0) K = index(NAME, '.for') 210 if (K .eq. 0) go to 300 211 end if 212 LNAM = K 213 NAME(LNAM:) = ' ' 214 do 315 K = LNAM, 2, -1 215 NAME(K:K) = NAME(K-1:K-1) 216 315 continue 217 NAME(1:1) = '=' 218 end if 219 do 320 LNAM = 2, 32 220 if (NAME(LNAM:LNAM) .eq. ' ') go to 330 221 320 continue 222 330 LNAM = LNAM - 1 223 K = LNAM 224 if (UPCASE) then 225 do 340 J = 2, K 226 L = ichar(NAME(J:J)) 227 if ((L .ge. MLCA) .and. (L .le. MLCZ)) NAME(J:J) = 228 1 char(L + LETDIF) 229 340 continue 230 if (CCODE) then 231 if (index(NAME(LNAM:), 'Fortran only') .ne. 0) go to 300 232 else 233 if (index(NAME(LNAM:), 'C only') .ne. 0) go to 300 234 end if 235 else 236 do 350 J = 2, K 237 L = ichar(NAME(J:J)) 238 if ((L .ge. MUCA) .and. (L .le. MUCZ)) NAME(J:J) = 239 1 char(L - LETDIF) 240 350 continue 241 if (CCODE) then 242 if (index(NAME(LNAM:), 'Fortran only') .ne. 0) go to 300 243 else 244 if (index(NAME(LNAM:), 'C only') .ne. 0) go to 300 245 end if 246 end if 247 do 400 K = LBEGMA, LENDMA 248 L = 1 249 do 370 J = 1, 9 250 N = KACLIN(J, K) - KACLIN(J-1, K) - 2 251 if (N .gt. 0) then 252 BUF(L:L+N-1) = LINE(K)(KACLIN(J-1, K):KACLIN(J, K)-3) 253 L = L + N 254 end if 255 if (KACLIN(J+1, K) .eq. 0) go to 380 256 BUF(L:L+LNAM-2) = NAME(2:LNAM) 257 L = L + LNAM - 1 258 370 continue 259 380 write (9, '(A)') BUF(1:L-1) 260 400 continue 261c On to the next program 262 go to 300 263c 264c Take care of the postfix lines 265 500 do 550 K = LENDMA+1, NL 266 write (9, '(A)') LINE(K)(1:LENLIN(K)) 267 550 continue 268 print 1010, ONAME(1:LONAM) 269 stop 270 end 271 272 273