source: palm/tags/release-3.1b/UTIL/interpret_config.f90 @ 4109

Last change on this file since 4109 was 1, checked in by raasch, 17 years ago

Initial repository layout and content

File size: 20.0 KB
Line 
1 PROGRAM interpret_config
2
3!-------------------------------------------------------------------------------!
4! 21/07/97 - Siggi - Erste Fassung
5! 18/11/97 - Siggi - Komma in 2010-FORMAT hinzugefuegt
6! 29/04/05 - Siggi - extin wird auch fuer Input-Dateien ausgegeben
7! 29/06/05 - Siggi - Fehlermeldung ins englische uebertragen und ergaenzt
8! 01/11/05 - Siggi - s2b-Feld erlaubt den Wert locopt
9!
10! Letzte Aenderungen:
11! -------------------
12!
13! Beschreibung:
14! -------------
15! Interpretation der MRUN-Konfigurationsdatei. Ausgegeben werden ksh-Kommandos,
16! die anschliessend von MRUN ausgefuehrt werden muessen.
17!-------------------------------------------------------------------------------!
18
19    IMPLICIT NONE
20
21    CHARACTER (LEN=1)   ::  bs = ACHAR( 92 )   ! backslash (auf vpp sonst n. druckbar)
22    CHARACTER (LEN=20)  ::  do_remote, do_trace, host, localhost
23    CHARACTER (LEN=100) ::  config_file, icf
24    CHARACTER (LEN=300) ::  cond1, cond2, empty = REPEAT( ' ', 240 ), &
25                            for_cond1, for_cond2, for_host, input_list, &
26                            iolist, output_list, s1, s2, s2a, s2b, s2c, s3, &
27                            s3cond, s4, s5, s6, value, value_mrun,&
28                            var, zeile
29
30    INTEGER ::  dummy, i, icomment = 0, icond1, icond2, idatver = 0, iec = 0, &
31                ienvvar = 0, ifor_cond1, ifor_cond2, ifor_host, ihost, &
32                iic = 0, iicf, iin = 0, iinput_list, il, ilocalhost,  ioc = 0, &
33                ios, iout = 0, ioutput_list, is1, is2, is2a, is2b, is2c, &
34                is3, is3cond, is4, is5, is6, ivalue, ivalue_mrun, ivar, izeile
35
36    LOGICAL ::  found
37
38    CALL local_getenv( 'cond1', 5, cond1, icond1 )
39    CALL local_getenv( 'cond2', 5, cond2, icond2 )
40    CALL local_getenv( 'config_file', 11, config_file, il )
41    CALL local_getenv( 'do_remote', 9, do_remote, dummy )
42    CALL local_getenv( 'do_trace', 8, do_trace, dummy )
43    CALL local_getenv( 'host', 4, host, ihost )
44    CALL local_getenv( 'input_list', 10, input_list, iinput_list )
45    CALL local_getenv( 'interpreted_config_file', 23, icf, iicf )
46    CALL local_getenv( 'localhost', 9, localhost, ilocalhost )
47    CALL local_getenv( 'output_list', 11, output_list, ioutput_list )
48    iolist = input_list(1:iinput_list) // output_list(1:ioutput_list)
49
50    IF ( do_trace(1:4) == 'true' )  THEN
51       PRINT*,'*** cond1="',cond1(1:icond1),'"'
52       PRINT*,'*** cond2="',cond2(1:icond2),'"'
53       PRINT*,'*** config_file="',config_file(1:il),'"'
54       PRINT*,'*** do_remote="',do_remote,'"'
55       PRINT*,'*** do_trace="',do_trace,'"'
56       PRINT*,'*** host="',host(1:ihost),'"'
57       PRINT*,'*** input_list="',input_list(1:iinput_list),'"'
58       PRINT*,'*** interpreted_config_file="',icf(1:iicf),'"'
59       PRINT*,'*** localhost="',localhost(1:ilocalhost),'"'
60       PRINT*,'*** output_list="',output_list(1:ioutput_list),'"'
61    ENDIF
62
63    OPEN ( 1, FILE=config_file(1:il), FORM='formatted' )
64    OPEN ( 2, FILE=icf(1:iicf), FORM='formatted' )
65
66    READ ( 1, '(A)', IOSTAT=ios )  zeile
67
68
69    DO WHILE ( ios == 0 )
70
71       izeile = LEN_TRIM( zeile )
72
73       IF ( zeile(1:1) == '#' )  THEN
74          icomment = icomment + 1
75       ELSEIF ( zeile(1:1) == '%' )  THEN
76          ienvvar = ienvvar + 1
77          i = INDEX( zeile, ' ' )
78          var = zeile(2:i-1)
79          ivar = i - 2
80
81!
82!--       Achtung: Auf hpmuk und vpp sind nur die Variablen bekannt, die
83!--       von MRUN exportiert wurden!
84          CALL local_getenv( var, ivar, value_mrun, ivalue_mrun )
85
86!
87!--       Variable bekommt nur dann neuen Wert, wenn ihr per Shellscript-
88!--       Option noch keiner zugewiesen wurde
89          IF ( value_mrun(1:ivalue_mrun) == ''  .OR. &
90               value_mrun(1:ivalue_mrun) == '0' )  THEN
91
92             zeile(1:i) = empty(1:i)
93             zeile = ADJUSTL( zeile )
94             i = INDEX( zeile, ' ' )
95             value = zeile(1:i-1)
96             ivalue = i - 1
97
98             zeile(1:i) = empty(1:i)
99             zeile = ADJUSTL( zeile )
100             i = INDEX( zeile, ' ' )
101
102             IF ( i /= 1 )  THEN
103                for_host = zeile(1:i-1)
104                ifor_host = i - 1
105
106                zeile(1:i) = empty(1:i)
107                zeile = ADJUSTL( zeile )
108                i = INDEX( zeile, ' ' )
109
110                IF ( i /= 1 )  THEN
111                   for_cond1 = zeile(1:i-1)
112                   ifor_cond1 = i - 1
113
114                   zeile(1:i) = empty(1:i)
115                   zeile = ADJUSTL( zeile )
116                   i = INDEX( zeile, ' ' )
117
118                   IF ( i /= 1 )  THEN
119                      for_cond2 = zeile(1:i-1)
120                      ifor_cond2 = i - 1
121                   ELSE
122                      for_cond2 = ''
123                      ifor_cond2 = 0
124                   ENDIF
125                ELSE
126                   for_cond1 = ''
127                   ifor_cond1 = 0
128                   for_cond2 = ''
129                   ifor_cond2 = 0
130                ENDIF
131             ELSE
132                for_host = ' '
133                ifor_host = 1
134                for_cond1 = ''
135                ifor_cond1 = 0
136                for_cond2 = ''
137                ifor_cond2 = 0
138             ENDIF
139             IF ( do_trace(1:4) == 'true' )  THEN
140                PRINT*,'var="',var(1:ivar),'"'
141                PRINT*,'value="',value(1:ivalue),'"'
142                PRINT*,'for_host="',for_host(1:ifor_host),'"'
143                PRINT*,'for_cond1="',for_cond1(1:ifor_cond1),'"'
144                PRINT*,'for_cond2="',for_cond2(1:ifor_cond2),'"'
145             ENDIF
146!
147!--          Geltungsbereich pruefen und evtl. Variable ausgeben
148             IF ( for_host == ' '  .OR.  ( &
149                  for_host(1:ifor_host) == host(1:ihost)  .AND. &
150                  for_cond1(1:ifor_cond1) == cond1(1:icond1)  .AND. &
151                  for_cond2(1:ifor_cond2) == cond2(1:icond2) &
152                                         )  .OR. ( &
153                  INDEX( iolist, for_host(1:ifor_host) ) /= 0 &
154                                                 ) )  THEN
155
156!
157!--             Zuerst Doppelpunkte durch Blanks ersetzen (aber doppelt
158!--             auftretende Doppelpunkte durch einen Doppelpunkt)
159                i = 0
160                DO
161                   i = i + 1
162                   IF ( i > ivalue )  EXIT
163                   IF ( value(i:i) == ':' )  THEN
164                      IF ( value(i+1:i+1) == ':' )  THEN
165                         value = value(1:i) // value(i+2:ivalue)
166                         ivalue = ivalue - 1
167                      ELSE
168                         value(i:i) = ' '
169                      ENDIF
170                   ENDIF
171                ENDDO
172
173!
174!--             Variable ausgeben
175                WRITE (2,2200)  var(1:ivar), bs, value(1:ivalue), bs, &
176                                var(1:ivar)
177 2200           FORMAT ('eval ',A,'=',A,'"',A,A,'"'/'export ',A)
178
179                IF ( do_trace(1:4) == 'true' )  THEN
180                   WRITE (2,2201)  bs, var(1:ivar), value(1:ivalue)
181 2201              FORMAT ('printf "',A,'n*** ENVIRONMENT-VARIABLE ',A,' = ',A)
182                ENDIF
183
184             ENDIF
185
186!
187!--          Variable "host" muss gleich ausgewertet werden, da mit ihr ein
188!--          neuer Geltungsbereich festgelegt wird
189             IF ( var(1:ivar) == 'host' )  THEN
190
191                host  = value(1:ivalue)
192                ihost = ivalue
193
194!                IF ( host(1:ihost) /= localhost(1:ilocalhost) )  THEN
195!
196!                   SELECT CASE ( value(1:ivalue) )
197!
198!                      CASE ( 'cray','hpcs','t3d','t3eb','t3eh','unics','vpp' )
199!
200!                         dummy = 1
201!
202!                      CASE DEFAULT
203!
204!                         WRITE (2,2202)  bs, bs, value(1:ivalue), bs, bs
205! 2202                    FORMAT ('printf "',A,'n +++ Auf Zielrechner ',A,'"',A,A,'" ist kein NQS-System vorhanden"'/ &
206!                                 'printf "',A,'n     Programmlauf kann deshalb nicht gestartet werden"'/ &
207!                                 'locat=nqs; exit')
208!                         STOP
209!
210!                   END SELECT
211!
212!                ENDIF
213
214             ENDIF
215
216          ENDIF
217
218       ELSEIF ( zeile(1:3) == 'EC:' )  THEN
219!
220!--       Error-Kommandos
221          iec = iec + 1
222          IF ( iec < 10 )  THEN
223             WRITE (2,'(''err_command['',I1,'']="'',A,''"'')')  iec, &
224                                                                zeile(4:izeile)
225          ELSEIF ( iec < 100 )  THEN
226             WRITE (2,'(''err_command['',I2,'']="'',A,''"'')')  iec, &
227                                                                zeile(4:izeile)
228          ELSE
229             WRITE (2,'(''err_command['',I3,'']="'',A,''"'')')  iec, &
230                                                                zeile(4:izeile)
231          ENDIF
232
233       ELSEIF ( zeile(1:3) == 'IC:' )  THEN
234!
235!--       Input-Kommandos
236          iic = iic + 1
237          IF ( iic < 10 )  THEN
238             WRITE (2,'(''in_command['',I1,'']="'',A,''"'')')  iic, &
239                                                               zeile(4:izeile)
240          ELSEIF ( iic < 100 )  THEN
241             WRITE (2,'(''in_command['',I2,'']="'',A,''"'')')  iic, &
242                                                               zeile(4:izeile)
243          ELSE
244             WRITE (2,'(''in_command['',I3,'']="'',A,''"'')')  iic, &
245                                                               zeile(4:izeile)
246          ENDIF
247
248       ELSEIF ( zeile(1:3) == 'OC:' )  THEN
249!
250!--       Output-Kommandos
251          ioc = ioc + 1
252          IF ( ioc < 10 )  THEN
253             WRITE (2,'(''out_command['',I1,'']="'',A,''"'')')  ioc, &
254                                                                zeile(4:izeile)
255          ELSEIF ( ioc < 100 )  THEN
256             WRITE (2,'(''out_command['',I2,'']="'',A,''"'')')  ioc, &
257                                                                zeile(4:izeile)
258          ELSE
259             WRITE (2,'(''out_command['',I3,'']="'',A,''"'')')  ioc, &
260                                                                zeile(4:izeile)
261          ENDIF
262
263       ELSE
264!
265!--       Dateiverbindungen
266          idatver = idatver + 1
267!
268!--       Lokaler Name
269          i   = INDEX( zeile , ' ' )
270          s1  = zeile(1:i-1)
271          is1 = i-1
272!
273!--       Dateieigenschaften
274          zeile = ADJUSTL( zeile(i:izeile) )
275          i   = INDEX( zeile , ' ' )
276          s2  = zeile(1:i-1)
277          is2 = i-1
278!
279!--       Geltungsbereich
280          zeile = ADJUSTL( zeile(i:izeile) )
281          i   = INDEX( zeile , ' ' )
282          s3  = zeile(1:i-1)
283          is3 = i-1
284!
285!--       Pfadname
286          zeile = ADJUSTL( zeile(i:izeile) )
287          i   = INDEX( zeile , ' ' )
288          s4  = zeile(1:i-1)
289          is4 = i-1
290!
291!--       evtl. Extension
292          zeile = ADJUSTL( zeile(i:izeile) )
293          i = INDEX( zeile , ' ' )
294          IF ( i == 1 )  THEN
295             s5  = ' '
296             is5 = 1
297             s6  = ' '
298             is6 = 1
299          ELSE
300             s5  = zeile(1:i-1)
301             is5 = i-1
302!
303!--          evtl. 2. Extension
304             zeile = ADJUSTL( zeile(i:izeile) )
305             i = INDEX( zeile , ' ' )
306             IF ( i == 1 )  THEN
307                s6  = ' '
308                is6 = 1
309             ELSE
310                s6  = zeile(1:i-1)
311                is6 = i-1
312             ENDIF
313          ENDIF
314
315!
316!--       Dateieigenschaften aufspalten
317          i = INDEX( s2 , ':' )
318          IF ( i == 0 )  THEN
319             s2a  = s2
320             is2a = is2
321             s2b  = ''
322             is2b = 0
323             s2c  = ''
324             is2c = 0
325          ELSE
326             s2a  = s2(1:i-1)
327             is2a = i-1
328             s2   = s2(i+1:is2)
329
330             i = INDEX( s2 , ':' )
331             IF ( i == 0 )  THEN
332                s2b  = s2
333                is2b = LEN_TRIM( s2 )
334                s2c  = ''
335                is2c = 0
336             ELSE
337                s2b  = s2(1:i-1)
338                is2b = i-1
339                s2c  = s2(i+1:)
340                is2c = LEN_TRIM( s2c )
341             ENDIF
342          ENDIF
343!
344!--       Pruefung, ob Eingabedateiverbindung abgespeichert werden soll
345          IF ( s2a(1:is2a) == 'in'  .AND.  .NOT. (                     &
346               do_remote(1:4) == 'true'  .AND.                         &
347               ( s2b(1:is2b) == 'loc'  .OR.  s2b(1:is2b) == 'locopt' ) &
348                                                 ) )  THEN
349             found = .FALSE.
350             i = INDEX( s3 , ':' )
351             IF ( i == 0 )  THEN
352                s3cond  = s3
353                is3cond = LEN_TRIM( s3cond )
354             ELSE
355                s3cond  = s3(1:i-1)
356                is3cond = i-1
357                s3      = s3(i+1:)
358             ENDIF
359
360             DO WHILE ( s3cond(1:1) /= ' ' )
361
362                IF ( INDEX( input_list(1:iinput_list) , s3cond(1:is3cond) ) /= 0 &
363                     .OR.  s3cond(1:is3cond) == '-' )  THEN
364                   found = .TRUE.
365                ENDIF
366
367                IF ( s3(1:1) == ' ' )  THEN
368                   s3cond = ' '
369                ELSE
370                   i = INDEX( s3 , ':' )
371                   IF ( i == 0 )  THEN
372                      s3cond  = s3
373                      is3cond = LEN_TRIM( s3cond )
374                      s3      = ' '
375                   ELSE
376                      s3cond  = s3(1:i-1)
377                      is3cond = i-1
378                      s3      = s3(i+1:)
379                   ENDIF
380                ENDIF
381
382             ENDDO
383
384!
385!--          Wenn Geltungsbereich erfuellt, dann Dateiverbindung abspeichern
386             IF ( found )  THEN
387
388                iin = iin + 1
389                IF ( iin < 10 )  THEN
390                   WRITE (2,2000)  iin, s1(1:is1), iin, s2b(1:is2b), &
391                                   iin, s2c(1:is2c), &
392                                   iin, s3(1:is3), iin, s4(1:is4), &
393                                   iin, s5(1:is5), iin, s6(1:is6)
3942000               FORMAT ('localin[',I1,']="',A,'"; transin[',I1,']="',A, &
395                           '"; actionin[',I1,']="',A, &
396                           '"; typein[',I1,']="',A,'"'/'pathin[',I1,']="',A, &
397                           '"; endin[',I1,']="',A,'"; extin[',I1,']="',A,'"')
398                ELSEIF ( iin < 100 )  THEN
399                   WRITE (2,2001)  iin, s1(1:is1), iin, s2b(1:is2b), &
400                                   iin, s2c(1:is2c), &
401                                   iin, s3(1:is3), iin, s4(1:is4), &
402                                   iin, s5(1:is5), iin, s6(1:is6)
4032001               FORMAT ('localin[',I2,']="',A,'"; transin[',I2,']="',A, &
404                           '"; actionin[',I2,']="',A, &
405                           '"; typein[',I2,']="',A,'"'/'pathin[',I2,']="',A, &
406                           '"; endin[',I2,']="',A,'"; extin[',I2,']="',A,'"')
407                ELSE
408                   WRITE (2,2002)  iin, s1(1:is1), iin, s2b(1:is2b), &
409                                   iin, s2c(1:is2c), &
410                                   iin, s3(1:is3), iin, s4(1:is4), &
411                                   iin, s5(1:is5), iin, s6(1:is6)
4122002               FORMAT ('localin[',I3,']="',A,'"; transin[',I3,']="',A, &
413                           '"; actionin[',I3,']="',A, &
414                           '"; typein[',I3,']="',A,'"'/'pathin[',I3,']="',A, &
415                           '"; endin[',I3,']="',A,'"; extin[',I3,']="',A,'"')
416                ENDIF
417             ENDIF
418
419          ELSEIF ( s2a(1:is2a) == 'out'  .AND.  .NOT. ( &
420                   do_remote(1:4) == 'true'  .AND.  s2b(1:is2b) == 'loc' &
421                                                      ) )  THEN
422!
423!--          Pruefung, ob Ausgabedateiverbindung abgespeichert werden soll
424             found = .FALSE.
425             i = INDEX( s3 , ':' )
426             IF ( i == 0 )  THEN
427                s3cond  = s3
428                is3cond = LEN_TRIM( s3cond )
429             ELSE
430                s3cond  = s3(1:i-1)
431                is3cond = i-1
432                s3      = s3(i+1:)
433             ENDIF
434
435             DO WHILE ( s3cond(1:1) /= ' ' )
436
437                IF ( INDEX( output_list(1:ioutput_list) , s3cond(1:is3cond) ) /= 0 &
438                     .OR.  s3cond(1:is3cond) == '-' )  THEN
439                   found = .TRUE.
440                ENDIF
441
442                IF ( s3(1:1) == ' ' )  THEN
443                   s3cond = ' '
444                ELSE
445                   i = INDEX( s3 , ':' )
446                   IF ( i == 0 )  THEN
447                      s3cond  = s3
448                      is3cond = LEN_TRIM( s3cond )
449                      s3      = ' '
450                   ELSE
451                      s3cond  = s3(1:i-1)
452                      is3cond = i-1
453                      s3      = s3(i+1:)
454                   ENDIF
455                ENDIF
456
457             ENDDO
458!
459!--          Wenn Geltungsbereich erfuellt, dann Dateiverbindung abspeichern
460             IF ( found )  THEN
461
462                iout = iout + 1
463                IF ( iout < 10 )  THEN
464                   WRITE (2,2003)  iout, s1(1:is1), iout, s2c(1:is2c), &
465                                   iout, s3(1:is3), iout, s4(1:is4), &
466                                   iout, s5(1:is5), iout, s6(1:is6)
467 2003              FORMAT ('localout[',I1,']="',A,'"; actionout[',I1,']="',A, &
468                           '"; typeout[',I1,']="',A,'"'/'pathout[',I1,']="',A, &
469                           '"; endout[',I1,']="',A,'"; extout[',I1,']="',A,'"')
470                ELSEIF ( iin < 100 )  THEN
471                      WRITE (2,2004)  iout, s1(1:is1), iout, s2c(1:is2c), &
472                                      iout, s3(1:is3), iout, s4(1:is4), &
473                                      iout, s5(1:is5), iout, s6(1:is6)
474 2004              FORMAT ('localout[',I2,']="',A,'"; actionout[',I2,']="',A, &
475                           '"; typeout[',I2,']="',A,'"'/'pathout[',I2,']="',A, &
476                           '"; endout[',I2,']="',A,'"; extout[',I2,']="',A,'"')
477                ELSE
478                      WRITE (2,2005)  iout, s1(1:is1), iout, s2c(1:is2c), &
479                                      iout, s3(1:is3), iout, s4(1:is4), &
480                                      iout, s5(1:is5), iout, s6(1:is6)
481 2005              FORMAT ('localout[',I3,']="',A,'"; actionout[',I3,']="',A, &
482                           '"; typeout[',I3,']="',A,'"'/'pathout[',I3,']="',A, &
483                           '"; endout[',I3,']="',A,'"; extout[',I3,']="',A,'"')
484                ENDIF
485             ENDIF
486
487          ELSEIF ( s2a(1:is2a) /= 'in'  .AND.  s2a(1:is2a) /= 'out' )  THEN
488!
489!--          Kein gueltiger Wert fuer I/O-Feld
490             WRITE (2,2010)  bs, bs, config_file(1:il), bs, bs, s2a(1:is2a), &
491                             bs, bs, bs, bs, bs, bs, bs
492 2010        FORMAT ('printf "',A,'n',A,'n +++ I/O-field in configuration ', &
493                     'file ',A, ' has the illegal"'/ &
494                     'printf "',A,'n     value ',A,'"',A,A,'". Only ', &
495                     A,'"in',A,'" or ',A,'"out',A,'" are allowed!"'/ &
496                     'printf "',A,'n     The error may be caused by an', &
497                     ' empty line at the end of the "'/ &
498                     'printf "',A,'n     configuration file."' &
499                    )
500             WRITE (2,'(''locat=connect; exit'')')
501             STOP
502          ENDIF
503         
504       ENDIF
505
506       READ( 1, '(A)', IOSTAT=ios )  zeile
507
508    ENDDO
509
510!
511!-- Ausgabe der Anzahl von gefundenen Zeilen
512    IF ( iec > 0 )  WRITE (2,'(''(( iec = '',I3,'' ))'')')  iec
513    IF ( iic > 0 )  WRITE (2,'(''(( iic = '',I3,'' ))'')')  iic
514    IF ( ioc > 0 )  WRITE (2,'(''(( ioc = '',I3,'' ))'')')  ioc
515    IF ( iin > 0 )  WRITE (2,'(''(( iin = '',I3,'' ))'')')  iin
516    IF ( iout > 0 )  WRITE (2,'(''(( iout = '',I3,'' ))'')')  iout
517
518    IF ( do_trace(1:4) == 'true' )  THEN
519       PRINT*,' '
520       PRINT*,'*** Inhalt von: ',config_file(1:il)
521       PRINT*,icomment,' Kommentarzeilen'
522       PRINT*,ienvvar,' Environment-Variablen-Vereinbarungen'
523       PRINT*,iec,' Error-Kommandos'
524       PRINT*,iic,' Input-Kommandos'
525       PRINT*,ioc,' Output-Kommandos'
526       PRINT*,idatver,' Dateiverbindungs-Anweisungen'
527       PRINT*,'Davon interpretiert:'
528       PRINT*,iin,' Eingabedateien'
529       PRINT*,iout,' Ausgabedateien'
530    ENDIF
531
532 END PROGRAM interpret_config
533
534
535
536 SUBROUTINE local_getenv( var, ivar, value, ivalue )
537
538    CHARACTER (LEN=*) ::  var, value
539    INTEGER           ::  ivalue, ivar
540
541    CALL GETENV( var(1:ivar), value )
542    ivalue = LEN_TRIM( value )
543
544 END SUBROUTINE local_getenv   
Note: See TracBrowser for help on using the repository browser.