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

Last change on this file since 2124 was 2018, checked in by raasch, 8 years ago

last commit documented

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