source: palm/tags/release-3.9/UTIL/interpret_config.f90

Last change on this file was 786, checked in by raasch, 13 years ago

last commit documented

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