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

Last change on this file since 1094 was 1094, checked in by raasch, 9 years ago

scp/ssh port can be set explicitly

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