source: palm/tags/release-3.7a/UTIL/interpret_config.f90 @ 546

Last change on this file since 546 was 313, checked in by raasch, 16 years ago

bugfix in interpret_config

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