source: palm/tags/release-3.4a/UTIL/interpret_config.f90 @ 818

Last change on this file since 818 was 72, checked in by raasch, 18 years ago

preliminary changes for precipitation output

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