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