source: palm/tags/release-3.1c/UTIL/interpret_config.f90 @ 99

Last change on this file since 99 was 21, checked in by raasch, 18 years ago

empty lines in configuration file are allowed

File size: 20.0 KB
Line 
1 PROGRAM interpret_config
2
3!-------------------------------------------------------------------------------!
4! 21/07/97 - Siggi - Erste Fassung
5! 18/11/97 - Siggi - Komma in 2010-FORMAT hinzugefuegt
6! 29/04/05 - Siggi - extin wird auch fuer Input-Dateien ausgegeben
7! 29/06/05 - Siggi - Fehlermeldung ins englische uebertragen und ergaenzt
8! 01/11/05 - Siggi - s2b-Feld erlaubt den Wert locopt
9! 28/02/07 - Siggi - empty lines in configuration file are accepted
10!
11! Letzte Aenderungen:
12! -------------------
13!
14! Beschreibung:
15! -------------
16! Interpretation der MRUN-Konfigurationsdatei. Ausgegeben werden ksh-Kommandos,
17! die anschliessend von MRUN ausgefuehrt werden muessen.
18!-------------------------------------------------------------------------------!
19
20    IMPLICIT NONE
21
22    CHARACTER (LEN=1)   ::  bs = ACHAR( 92 )   ! backslash (auf vpp sonst n. druckbar)
23    CHARACTER (LEN=20)  ::  do_remote, do_trace, host, localhost
24    CHARACTER (LEN=100) ::  config_file, icf
25    CHARACTER (LEN=300) ::  cond1, cond2, empty = REPEAT( ' ', 240 ), &
26                            for_cond1, for_cond2, for_host, input_list, &
27                            iolist, output_list, s1, s2, s2a, s2b, s2c, s3, &
28                            s3cond, s4, s5, s6, value, value_mrun,&
29                            var, zeile
30
31    INTEGER ::  dummy, i, icomment = 0, icond1, icond2, idatver = 0, iec = 0, &
32                ienvvar = 0, ifor_cond1, ifor_cond2, ifor_host, ihost, &
33                iic = 0, iicf, iin = 0, iinput_list, il, ilocalhost,  ioc = 0, &
34                ios, iout = 0, ioutput_list, is1, is2, is2a, is2b, is2c, &
35                is3, is3cond, is4, is5, is6, ivalue, ivalue_mrun, ivar, izeile
36
37    LOGICAL ::  found
38
39    CALL local_getenv( 'cond1', 5, cond1, icond1 )
40    CALL local_getenv( 'cond2', 5, cond2, icond2 )
41    CALL local_getenv( 'config_file', 11, config_file, il )
42    CALL local_getenv( 'do_remote', 9, do_remote, dummy )
43    CALL local_getenv( 'do_trace', 8, do_trace, dummy )
44    CALL local_getenv( 'host', 4, host, ihost )
45    CALL local_getenv( 'input_list', 10, input_list, iinput_list )
46    CALL local_getenv( 'interpreted_config_file', 23, icf, iicf )
47    CALL local_getenv( 'localhost', 9, localhost, ilocalhost )
48    CALL local_getenv( 'output_list', 11, output_list, ioutput_list )
49    iolist = input_list(1:iinput_list) // output_list(1:ioutput_list)
50
51    IF ( do_trace(1:4) == 'true' )  THEN
52       PRINT*,'*** cond1="',cond1(1:icond1),'"'
53       PRINT*,'*** cond2="',cond2(1:icond2),'"'
54       PRINT*,'*** config_file="',config_file(1:il),'"'
55       PRINT*,'*** do_remote="',do_remote,'"'
56       PRINT*,'*** do_trace="',do_trace,'"'
57       PRINT*,'*** host="',host(1:ihost),'"'
58       PRINT*,'*** input_list="',input_list(1:iinput_list),'"'
59       PRINT*,'*** interpreted_config_file="',icf(1:iicf),'"'
60       PRINT*,'*** localhost="',localhost(1:ilocalhost),'"'
61       PRINT*,'*** output_list="',output_list(1:ioutput_list),'"'
62    ENDIF
63
64    OPEN ( 1, FILE=config_file(1:il), FORM='formatted' )
65    OPEN ( 2, FILE=icf(1:iicf), FORM='formatted' )
66
67    READ ( 1, '(A)', IOSTAT=ios )  zeile
68
69
70    DO WHILE ( ios == 0 )
71
72       izeile = LEN_TRIM( zeile )
73
74       IF ( LEN_TRIM( zeile ) == 0 )  THEN
75          CONTINUE
76       ELSEIF ( zeile(1:1) == '#' )  THEN
77          icomment = icomment + 1
78       ELSEIF ( zeile(1:1) == '%' )  THEN
79          ienvvar = ienvvar + 1
80          i = INDEX( zeile, ' ' )
81          var = zeile(2:i-1)
82          ivar = i - 2
83
84!
85!--       Achtung: Auf hpmuk und vpp sind nur die Variablen bekannt, die
86!--       von MRUN exportiert wurden!
87          CALL local_getenv( var, ivar, value_mrun, ivalue_mrun )
88
89!
90!--       Variable bekommt nur dann neuen Wert, wenn ihr per Shellscript-
91!--       Option noch keiner zugewiesen wurde
92          IF ( value_mrun(1:ivalue_mrun) == ''  .OR. &
93               value_mrun(1:ivalue_mrun) == '0' )  THEN
94
95             zeile(1:i) = empty(1:i)
96             zeile = ADJUSTL( zeile )
97             i = INDEX( zeile, ' ' )
98             value = zeile(1:i-1)
99             ivalue = i - 1
100
101             zeile(1:i) = empty(1:i)
102             zeile = ADJUSTL( zeile )
103             i = INDEX( zeile, ' ' )
104
105             IF ( i /= 1 )  THEN
106                for_host = zeile(1:i-1)
107                ifor_host = i - 1
108
109                zeile(1:i) = empty(1:i)
110                zeile = ADJUSTL( zeile )
111                i = INDEX( zeile, ' ' )
112
113                IF ( i /= 1 )  THEN
114                   for_cond1 = zeile(1:i-1)
115                   ifor_cond1 = i - 1
116
117                   zeile(1:i) = empty(1:i)
118                   zeile = ADJUSTL( zeile )
119                   i = INDEX( zeile, ' ' )
120
121                   IF ( i /= 1 )  THEN
122                      for_cond2 = zeile(1:i-1)
123                      ifor_cond2 = i - 1
124                   ELSE
125                      for_cond2 = ''
126                      ifor_cond2 = 0
127                   ENDIF
128                ELSE
129                   for_cond1 = ''
130                   ifor_cond1 = 0
131                   for_cond2 = ''
132                   ifor_cond2 = 0
133                ENDIF
134             ELSE
135                for_host = ' '
136                ifor_host = 1
137                for_cond1 = ''
138                ifor_cond1 = 0
139                for_cond2 = ''
140                ifor_cond2 = 0
141             ENDIF
142             IF ( do_trace(1:4) == 'true' )  THEN
143                PRINT*,'var="',var(1:ivar),'"'
144                PRINT*,'value="',value(1:ivalue),'"'
145                PRINT*,'for_host="',for_host(1:ifor_host),'"'
146                PRINT*,'for_cond1="',for_cond1(1:ifor_cond1),'"'
147                PRINT*,'for_cond2="',for_cond2(1:ifor_cond2),'"'
148             ENDIF
149!
150!--          Geltungsbereich pruefen und evtl. Variable ausgeben
151             IF ( for_host == ' '  .OR.  ( &
152                  for_host(1:ifor_host) == host(1:ihost)  .AND. &
153                  for_cond1(1:ifor_cond1) == cond1(1:icond1)  .AND. &
154                  for_cond2(1:ifor_cond2) == cond2(1:icond2) &
155                                         )  .OR. ( &
156                  INDEX( iolist, for_host(1:ifor_host) ) /= 0 &
157                                                 ) )  THEN
158
159!
160!--             Zuerst Doppelpunkte durch Blanks ersetzen (aber doppelt
161!--             auftretende Doppelpunkte durch einen Doppelpunkt)
162                i = 0
163                DO
164                   i = i + 1
165                   IF ( i > ivalue )  EXIT
166                   IF ( value(i:i) == ':' )  THEN
167                      IF ( value(i+1:i+1) == ':' )  THEN
168                         value = value(1:i) // value(i+2:ivalue)
169                         ivalue = ivalue - 1
170                      ELSE
171                         value(i:i) = ' '
172                      ENDIF
173                   ENDIF
174                ENDDO
175
176!
177!--             Variable ausgeben
178                WRITE (2,2200)  var(1:ivar), bs, value(1:ivalue), bs, &
179                                var(1:ivar)
180 2200           FORMAT ('eval ',A,'=',A,'"',A,A,'"'/'export ',A)
181
182                IF ( do_trace(1:4) == 'true' )  THEN
183                   WRITE (2,2201)  bs, var(1:ivar), value(1:ivalue)
184 2201              FORMAT ('printf "',A,'n*** ENVIRONMENT-VARIABLE ',A,' = ',A)
185                ENDIF
186
187             ENDIF
188
189!
190!--          Variable "host" muss gleich ausgewertet werden, da mit ihr ein
191!--          neuer Geltungsbereich festgelegt wird
192             IF ( var(1:ivar) == 'host' )  THEN
193
194                host  = value(1:ivalue)
195                ihost = ivalue
196
197!                IF ( host(1:ihost) /= localhost(1:ilocalhost) )  THEN
198!
199!                   SELECT CASE ( value(1:ivalue) )
200!
201!                      CASE ( 'cray','hpcs','t3d','t3eb','t3eh','unics','vpp' )
202!
203!                         dummy = 1
204!
205!                      CASE DEFAULT
206!
207!                         WRITE (2,2202)  bs, bs, value(1:ivalue), bs, bs
208! 2202                    FORMAT ('printf "',A,'n +++ Auf Zielrechner ',A,'"',A,A,'" ist kein NQS-System vorhanden"'/ &
209!                                 'printf "',A,'n     Programmlauf kann deshalb nicht gestartet werden"'/ &
210!                                 'locat=nqs; exit')
211!                         STOP
212!
213!                   END SELECT
214!
215!                ENDIF
216
217             ENDIF
218
219          ENDIF
220
221       ELSEIF ( zeile(1:3) == 'EC:' )  THEN
222!
223!--       Error-Kommandos
224          iec = iec + 1
225          IF ( iec < 10 )  THEN
226             WRITE (2,'(''err_command['',I1,'']="'',A,''"'')')  iec, &
227                                                                zeile(4:izeile)
228          ELSEIF ( iec < 100 )  THEN
229             WRITE (2,'(''err_command['',I2,'']="'',A,''"'')')  iec, &
230                                                                zeile(4:izeile)
231          ELSE
232             WRITE (2,'(''err_command['',I3,'']="'',A,''"'')')  iec, &
233                                                                zeile(4:izeile)
234          ENDIF
235
236       ELSEIF ( zeile(1:3) == 'IC:' )  THEN
237!
238!--       Input-Kommandos
239          iic = iic + 1
240          IF ( iic < 10 )  THEN
241             WRITE (2,'(''in_command['',I1,'']="'',A,''"'')')  iic, &
242                                                               zeile(4:izeile)
243          ELSEIF ( iic < 100 )  THEN
244             WRITE (2,'(''in_command['',I2,'']="'',A,''"'')')  iic, &
245                                                               zeile(4:izeile)
246          ELSE
247             WRITE (2,'(''in_command['',I3,'']="'',A,''"'')')  iic, &
248                                                               zeile(4:izeile)
249          ENDIF
250
251       ELSEIF ( zeile(1:3) == 'OC:' )  THEN
252!
253!--       Output-Kommandos
254          ioc = ioc + 1
255          IF ( ioc < 10 )  THEN
256             WRITE (2,'(''out_command['',I1,'']="'',A,''"'')')  ioc, &
257                                                                zeile(4:izeile)
258          ELSEIF ( ioc < 100 )  THEN
259             WRITE (2,'(''out_command['',I2,'']="'',A,''"'')')  ioc, &
260                                                                zeile(4:izeile)
261          ELSE
262             WRITE (2,'(''out_command['',I3,'']="'',A,''"'')')  ioc, &
263                                                                zeile(4:izeile)
264          ENDIF
265
266       ELSE
267!
268!--       Dateiverbindungen
269          idatver = idatver + 1
270!
271!--       Lokaler Name
272          i   = INDEX( zeile , ' ' )
273          s1  = zeile(1:i-1)
274          is1 = i-1
275!
276!--       Dateieigenschaften
277          zeile = ADJUSTL( zeile(i:izeile) )
278          i   = INDEX( zeile , ' ' )
279          s2  = zeile(1:i-1)
280          is2 = i-1
281!
282!--       Geltungsbereich
283          zeile = ADJUSTL( zeile(i:izeile) )
284          i   = INDEX( zeile , ' ' )
285          s3  = zeile(1:i-1)
286          is3 = i-1
287!
288!--       Pfadname
289          zeile = ADJUSTL( zeile(i:izeile) )
290          i   = INDEX( zeile , ' ' )
291          s4  = zeile(1:i-1)
292          is4 = i-1
293!
294!--       evtl. Extension
295          zeile = ADJUSTL( zeile(i:izeile) )
296          i = INDEX( zeile , ' ' )
297          IF ( i == 1 )  THEN
298             s5  = ' '
299             is5 = 1
300             s6  = ' '
301             is6 = 1
302          ELSE
303             s5  = zeile(1:i-1)
304             is5 = i-1
305!
306!--          evtl. 2. Extension
307             zeile = ADJUSTL( zeile(i:izeile) )
308             i = INDEX( zeile , ' ' )
309             IF ( i == 1 )  THEN
310                s6  = ' '
311                is6 = 1
312             ELSE
313                s6  = zeile(1:i-1)
314                is6 = i-1
315             ENDIF
316          ENDIF
317
318!
319!--       Dateieigenschaften aufspalten
320          i = INDEX( s2 , ':' )
321          IF ( i == 0 )  THEN
322             s2a  = s2
323             is2a = is2
324             s2b  = ''
325             is2b = 0
326             s2c  = ''
327             is2c = 0
328          ELSE
329             s2a  = s2(1:i-1)
330             is2a = i-1
331             s2   = s2(i+1:is2)
332
333             i = INDEX( s2 , ':' )
334             IF ( i == 0 )  THEN
335                s2b  = s2
336                is2b = LEN_TRIM( s2 )
337                s2c  = ''
338                is2c = 0
339             ELSE
340                s2b  = s2(1:i-1)
341                is2b = i-1
342                s2c  = s2(i+1:)
343                is2c = LEN_TRIM( s2c )
344             ENDIF
345          ENDIF
346!
347!--       Pruefung, ob Eingabedateiverbindung abgespeichert werden soll
348          IF ( s2a(1:is2a) == 'in'  .AND.  .NOT. (                     &
349               do_remote(1:4) == 'true'  .AND.                         &
350               ( s2b(1:is2b) == 'loc'  .OR.  s2b(1:is2b) == 'locopt' ) &
351                                                 ) )  THEN
352             found = .FALSE.
353             i = INDEX( s3 , ':' )
354             IF ( i == 0 )  THEN
355                s3cond  = s3
356                is3cond = LEN_TRIM( s3cond )
357             ELSE
358                s3cond  = s3(1:i-1)
359                is3cond = i-1
360                s3      = s3(i+1:)
361             ENDIF
362
363             DO WHILE ( s3cond(1:1) /= ' ' )
364
365                IF ( INDEX( input_list(1:iinput_list) , s3cond(1:is3cond) ) /= 0 &
366                     .OR.  s3cond(1:is3cond) == '-' )  THEN
367                   found = .TRUE.
368                ENDIF
369
370                IF ( s3(1:1) == ' ' )  THEN
371                   s3cond = ' '
372                ELSE
373                   i = INDEX( s3 , ':' )
374                   IF ( i == 0 )  THEN
375                      s3cond  = s3
376                      is3cond = LEN_TRIM( s3cond )
377                      s3      = ' '
378                   ELSE
379                      s3cond  = s3(1:i-1)
380                      is3cond = i-1
381                      s3      = s3(i+1:)
382                   ENDIF
383                ENDIF
384
385             ENDDO
386
387!
388!--          Wenn Geltungsbereich erfuellt, dann Dateiverbindung abspeichern
389             IF ( found )  THEN
390
391                iin = iin + 1
392                IF ( iin < 10 )  THEN
393                   WRITE (2,2000)  iin, s1(1:is1), iin, s2b(1:is2b), &
394                                   iin, s2c(1:is2c), &
395                                   iin, s3(1:is3), iin, s4(1:is4), &
396                                   iin, s5(1:is5), iin, s6(1:is6)
3972000               FORMAT ('localin[',I1,']="',A,'"; transin[',I1,']="',A, &
398                           '"; actionin[',I1,']="',A, &
399                           '"; typein[',I1,']="',A,'"'/'pathin[',I1,']="',A, &
400                           '"; endin[',I1,']="',A,'"; extin[',I1,']="',A,'"')
401                ELSEIF ( iin < 100 )  THEN
402                   WRITE (2,2001)  iin, s1(1:is1), iin, s2b(1:is2b), &
403                                   iin, s2c(1:is2c), &
404                                   iin, s3(1:is3), iin, s4(1:is4), &
405                                   iin, s5(1:is5), iin, s6(1:is6)
4062001               FORMAT ('localin[',I2,']="',A,'"; transin[',I2,']="',A, &
407                           '"; actionin[',I2,']="',A, &
408                           '"; typein[',I2,']="',A,'"'/'pathin[',I2,']="',A, &
409                           '"; endin[',I2,']="',A,'"; extin[',I2,']="',A,'"')
410                ELSE
411                   WRITE (2,2002)  iin, s1(1:is1), iin, s2b(1:is2b), &
412                                   iin, s2c(1:is2c), &
413                                   iin, s3(1:is3), iin, s4(1:is4), &
414                                   iin, s5(1:is5), iin, s6(1:is6)
4152002               FORMAT ('localin[',I3,']="',A,'"; transin[',I3,']="',A, &
416                           '"; actionin[',I3,']="',A, &
417                           '"; typein[',I3,']="',A,'"'/'pathin[',I3,']="',A, &
418                           '"; endin[',I3,']="',A,'"; extin[',I3,']="',A,'"')
419                ENDIF
420             ENDIF
421
422          ELSEIF ( s2a(1:is2a) == 'out'  .AND.  .NOT. ( &
423                   do_remote(1:4) == 'true'  .AND.  s2b(1:is2b) == 'loc' &
424                                                      ) )  THEN
425!
426!--          Pruefung, ob Ausgabedateiverbindung abgespeichert werden soll
427             found = .FALSE.
428             i = INDEX( s3 , ':' )
429             IF ( i == 0 )  THEN
430                s3cond  = s3
431                is3cond = LEN_TRIM( s3cond )
432             ELSE
433                s3cond  = s3(1:i-1)
434                is3cond = i-1
435                s3      = s3(i+1:)
436             ENDIF
437
438             DO WHILE ( s3cond(1:1) /= ' ' )
439
440                IF ( INDEX( output_list(1:ioutput_list) , s3cond(1:is3cond) ) /= 0 &
441                     .OR.  s3cond(1:is3cond) == '-' )  THEN
442                   found = .TRUE.
443                ENDIF
444
445                IF ( s3(1:1) == ' ' )  THEN
446                   s3cond = ' '
447                ELSE
448                   i = INDEX( s3 , ':' )
449                   IF ( i == 0 )  THEN
450                      s3cond  = s3
451                      is3cond = LEN_TRIM( s3cond )
452                      s3      = ' '
453                   ELSE
454                      s3cond  = s3(1:i-1)
455                      is3cond = i-1
456                      s3      = s3(i+1:)
457                   ENDIF
458                ENDIF
459
460             ENDDO
461!
462!--          Wenn Geltungsbereich erfuellt, dann Dateiverbindung abspeichern
463             IF ( found )  THEN
464
465                iout = iout + 1
466                IF ( iout < 10 )  THEN
467                   WRITE (2,2003)  iout, s1(1:is1), iout, s2c(1:is2c), &
468                                   iout, s3(1:is3), iout, s4(1:is4), &
469                                   iout, s5(1:is5), iout, s6(1:is6)
470 2003              FORMAT ('localout[',I1,']="',A,'"; actionout[',I1,']="',A, &
471                           '"; typeout[',I1,']="',A,'"'/'pathout[',I1,']="',A, &
472                           '"; endout[',I1,']="',A,'"; extout[',I1,']="',A,'"')
473                ELSEIF ( iin < 100 )  THEN
474                      WRITE (2,2004)  iout, s1(1:is1), iout, s2c(1:is2c), &
475                                      iout, s3(1:is3), iout, s4(1:is4), &
476                                      iout, s5(1:is5), iout, s6(1:is6)
477 2004              FORMAT ('localout[',I2,']="',A,'"; actionout[',I2,']="',A, &
478                           '"; typeout[',I2,']="',A,'"'/'pathout[',I2,']="',A, &
479                           '"; endout[',I2,']="',A,'"; extout[',I2,']="',A,'"')
480                ELSE
481                      WRITE (2,2005)  iout, s1(1:is1), iout, s2c(1:is2c), &
482                                      iout, s3(1:is3), iout, s4(1:is4), &
483                                      iout, s5(1:is5), iout, s6(1:is6)
484 2005              FORMAT ('localout[',I3,']="',A,'"; actionout[',I3,']="',A, &
485                           '"; typeout[',I3,']="',A,'"'/'pathout[',I3,']="',A, &
486                           '"; endout[',I3,']="',A,'"; extout[',I3,']="',A,'"')
487                ENDIF
488             ENDIF
489
490          ELSEIF ( s2a(1:is2a) /= 'in'  .AND.  s2a(1:is2a) /= 'out' )  THEN
491!
492!--          Kein gueltiger Wert fuer I/O-Feld
493             WRITE (2,2010)  bs, bs, config_file(1:il), bs, bs, s2a(1:is2a), &
494                             bs, bs, bs, bs, bs, bs, bs
495 2010        FORMAT ('printf "',A,'n',A,'n +++ I/O-field in configuration ', &
496                     'file ',A, ' has the illegal"'/                         &
497                     'printf "',A,'n     value ',A,'"',A,A,'". Only ',       &
498                     A,'"in',A,'" or ',A,'"out',A,'" are allowed!"'          &
499                    )
500             WRITE (2,'(''locat=connect; exit'')')
501             STOP
502          ENDIF
503         
504       ENDIF
505
506       READ( 1, '(A)', IOSTAT=ios )  zeile
507
508    ENDDO
509
510!
511!-- Ausgabe der Anzahl von gefundenen Zeilen
512    IF ( iec > 0 )  WRITE (2,'(''(( iec = '',I3,'' ))'')')  iec
513    IF ( iic > 0 )  WRITE (2,'(''(( iic = '',I3,'' ))'')')  iic
514    IF ( ioc > 0 )  WRITE (2,'(''(( ioc = '',I3,'' ))'')')  ioc
515    IF ( iin > 0 )  WRITE (2,'(''(( iin = '',I3,'' ))'')')  iin
516    IF ( iout > 0 )  WRITE (2,'(''(( iout = '',I3,'' ))'')')  iout
517
518    IF ( do_trace(1:4) == 'true' )  THEN
519       PRINT*,' '
520       PRINT*,'*** Inhalt von: ',config_file(1:il)
521       PRINT*,icomment,' Kommentarzeilen'
522       PRINT*,ienvvar,' Environment-Variablen-Vereinbarungen'
523       PRINT*,iec,' Error-Kommandos'
524       PRINT*,iic,' Input-Kommandos'
525       PRINT*,ioc,' Output-Kommandos'
526       PRINT*,idatver,' Dateiverbindungs-Anweisungen'
527       PRINT*,'Davon interpretiert:'
528       PRINT*,iin,' Eingabedateien'
529       PRINT*,iout,' Ausgabedateien'
530    ENDIF
531
532 END PROGRAM interpret_config
533
534
535
536 SUBROUTINE local_getenv( var, ivar, value, ivalue )
537
538    CHARACTER (LEN=*) ::  var, value
539    INTEGER           ::  ivalue, ivar
540
541    CALL GETENV( var(1:ivar), value )
542    ivalue = LEN_TRIM( value )
543
544 END SUBROUTINE local_getenv   
Note: See TracBrowser for help on using the repository browser.