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

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