source: palm/tags/release-4.0/UTIL/interpret_config.f90 @ 4239

Last change on this file since 4239 was 1310, checked in by raasch, 11 years ago

update of GPL copyright

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