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

Last change on this file since 2731 was 2718, checked in by maronga, 7 years ago

deleting of deprecated files; headers updated where needed

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