Home


About us
PALM
PALM-4U
Installation
Release notes
Documentation
Getting Help
Gallery
Developers area

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

Last change on this file since 1069 was 1047, checked in by maronga, 12 years ago

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