source: palm/tags/release-3.8/UTIL/interpret_config.f90 @ 716

Last change on this file since 716 was 556, checked in by raasch, 14 years ago

last commit documented

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