source: palm/trunk/UTIL/interpret_config.f90 @ 785

Last change on this file since 785 was 785, checked in by raasch, 10 years ago

scalar quantities can be excluded from Rayleigh damping; bugfix for long lines in configuration file with more than 300 characters

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