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

Last change on this file since 2699 was 2696, checked in by kanani, 7 years ago

Merge of branch palm4u into trunk

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