Home


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

Changeset 72 for palm/trunk/UTIL


Ignore:
Timestamp:
Mar 19, 2007 8:20:46 AM (18 years ago)
Author:
raasch
Message:

preliminary changes for precipitation output

File:
1 edited

Legend:

Unmodified
Added
Removed

  • palm/trunk/UTIL/interpret_config.f90

    r69 r72  
    11 PROGRAM interpret_config
    22
    3 !-------------------------------------------------------------------------------!
     3!------------------------------------------------------------------------------!
     4! Actual revisions:
     5! -----------------
     6! mrun environment variables are read from NAMELIST instead of using GETENV.
     7! Variables are allways assigned a value, also if they already got one. These
     8! values are re-assigned later in mrun.
     9!
     10! Former revisions:
     11! -----------------
     12! $Id$
     13!
     14! 28/02/07 - Siggi - empty lines in configuration file are accepted
     15! 01/11/05 - Siggi - s2b-Feld erlaubt den Wert locopt
     16! 29/06/05 - Siggi - Fehlermeldung ins englische uebertragen und ergaenzt
     17! 29/04/05 - Siggi - extin wird auch fuer Input-Dateien ausgegeben
     18! 18/11/97 - Siggi - Komma in 2010-FORMAT hinzugefuegt
    419! 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 ! 28/02/07 - Siggi - empty lines in configuration file are accepted
    10 !
    11 ! Letzte Aenderungen:
    12 ! -------------------
    13 !
    14 ! Beschreibung:
     20!
     21! Description:
    1522! -------------
    16 ! Interpretation der MRUN-Konfigurationsdatei. Ausgegeben werden ksh-Kommandos,
    17 ! die anschliessend von MRUN ausgefuehrt werden muessen.
    18 !-------------------------------------------------------------------------------!
     23! This program reads the mrun-configuration file .mrun.config and outputs
     24! its content in form of ksh-commands, which can then be executed by mrun.
     25! mrun is also able to directly read from the configuration file by using
     26! the option "-S" (but with much slower speed).
     27!------------------------------------------------------------------------------!
    1928
    2029    IMPLICIT NONE
    2130
    22     CHARACTER (LEN=1)   ::  bs = ACHAR( 92 )   ! backslash (auf vpp sonst n. druckbar)
     31    CHARACTER (LEN=1)   ::  bs = ACHAR( 92 )   ! backslash (auf vpp sonst n.
     32                                               ! druckbar)
    2333    CHARACTER (LEN=20)  ::  do_remote, do_trace, host, localhost
    2434    CHARACTER (LEN=100) ::  config_file, icf
    25     CHARACTER (LEN=300) ::  cond1, cond2, empty = REPEAT( ' ', 240 ), &
    26                             for_cond1, for_cond2, for_host, input_list, &
     35    CHARACTER (LEN=300) ::  cond1, cond2, empty = REPEAT( ' ', 240 ),       &
     36                            for_cond1, for_cond2, for_host, input_list,     &
    2737                            iolist, output_list, s1, s2, s2a, s2b, s2c, s3, &
    28                             s3cond, s4, s5, s6, value, value_mrun,&
    29                             var, zeile
    30 
    31     INTEGER ::  dummy, i, icomment = 0, icond1, icond2, idatver = 0, iec = 0, &
    32                 ienvvar = 0, ifor_cond1, ifor_cond2, ifor_host, ihost, &
     38                            s3cond, s4, s5, s6, value, value_mrun, var, zeile
     39
     40    INTEGER ::  dummy, i, icomment = 0, icond1, icond2, idatver = 0, iec = 0,  &
     41                ienvvar = 0, ifor_cond1, ifor_cond2, ifor_host, ihost,         &
    3342                iic = 0, iicf, iin = 0, iinput_list, il, ilocalhost,  ioc = 0, &
    34                 ios, iout = 0, ioutput_list, is1, is2, is2a, is2b, is2c, &
    35                 is3, is3cond, is4, is5, is6, ivalue, ivalue_mrun, ivar, izeile
     43                ios, iout = 0, ioutput_list, is1, is2, is2a, is2b, is2c,       &
     44                is3, is3cond, is4, is5, is6, ivalue, ivar, izeile
    3645
    3746    LOGICAL ::  found
    3847
    39     NAMELIST /mrun_environment/  cond1, cond2, config_file, do_remote, do_trace, &
    40                                  host, input_list, icf, localhost, output_list
     48    NAMELIST /mrun_environment/  cond1, cond2, config_file, do_remote,       &
     49                                 do_trace, host, input_list, icf, localhost, &
     50                                 output_list
    4151
    4252
    … …  
    5363    ioutput_list = LEN_TRIM( output_list )
    5464
    55 !    CALL local_getenv( 'cond1', 5, cond1, icond1 )
    56 !    CALL local_getenv( 'cond2', 5, cond2, icond2 )
    57 !    CALL local_getenv( 'config_file', 11, config_file, il )
    58 !    CALL local_getenv( 'do_remote', 9, do_remote, dummy )
    59 !    CALL local_getenv( 'do_trace', 8, do_trace, dummy )
    60 !    CALL local_getenv( 'host', 4, host, ihost )
    61 !    CALL local_getenv( 'input_list', 10, input_list, iinput_list )
    62 !    CALL local_getenv( 'interpreted_config_file', 23, icf, iicf )
    63 !    CALL local_getenv( 'localhost', 9, localhost, ilocalhost )
    64 !    CALL local_getenv( 'output_list', 11, output_list, ioutput_list )
    6565    iolist = input_list(1:iinput_list) // output_list(1:ioutput_list)
    6666
    … …  
    8989
    9090       IF ( LEN_TRIM( zeile ) == 0 )  THEN
     91
    9192          CONTINUE
     93
    9294       ELSEIF ( zeile(1:1) == '#' )  THEN
     95
    9396          icomment = icomment + 1
     97
    9498       ELSEIF ( zeile(1:1) == '%' )  THEN
     99
    95100          ienvvar = ienvvar + 1
    96101          i = INDEX( zeile, ' ' )
    … …  
    98103          ivar = i - 2
    99104
    100 !
    101 !--       Achtung: Auf hpmuk und vpp sind nur die Variablen bekannt, die
    102 !--       von MRUN exportiert wurden!
    103 !          CALL local_getenv( var, ivar, value_mrun, ivalue_mrun )
    104           value_mrun = ''
    105           ivalue_mrun = 1
    106 
    107 !
    108 !--       Variable bekommt nur dann neuen Wert, wenn ihr per Shellscript-
    109 !--       Option noch keiner zugewiesen wurde
    110           IF ( value_mrun(1:ivalue_mrun) == ''  .OR. &
    111                value_mrun(1:ivalue_mrun) == '0' )  THEN
     105          zeile(1:i) = empty(1:i)
     106          zeile = ADJUSTL( zeile )
     107          i = INDEX( zeile, ' ' )
     108          value = zeile(1:i-1)
     109          ivalue = i - 1
     110
     111          zeile(1:i) = empty(1:i)
     112          zeile = ADJUSTL( zeile )
     113          i = INDEX( zeile, ' ' )
     114
     115          IF ( i /= 1 )  THEN
     116             for_host = zeile(1:i-1)
     117             ifor_host = i - 1
    112118
    113119             zeile(1:i) = empty(1:i)
    114120             zeile = ADJUSTL( zeile )
    115121             i = INDEX( zeile, ' ' )
    116              value = zeile(1:i-1)
    117              ivalue = i - 1
    118 
    119              zeile(1:i) = empty(1:i)
    120              zeile = ADJUSTL( zeile )
    121              i = INDEX( zeile, ' ' )
    122122
    123123             IF ( i /= 1 )  THEN
    124                 for_host = zeile(1:i-1)
    125                 ifor_host = i - 1
     124                for_cond1 = zeile(1:i-1)
     125                ifor_cond1 = i - 1
    126126
    127127                zeile(1:i) = empty(1:i)
    … …  
    130130
    131131                IF ( i /= 1 )  THEN
    132                    for_cond1 = zeile(1:i-1)
    133                    ifor_cond1 = i - 1
    134 
    135                    zeile(1:i) = empty(1:i)
    136                    zeile = ADJUSTL( zeile )
    137                    i = INDEX( zeile, ' ' )
    138 
    139                    IF ( i /= 1 )  THEN
    140                       for_cond2 = zeile(1:i-1)
    141                       ifor_cond2 = i - 1
    142                    ELSE
    143                       for_cond2 = ''
    144                       ifor_cond2 = 0
    145                    ENDIF
     132                   for_cond2 = zeile(1:i-1)
     133                   ifor_cond2 = i - 1
    146134                ELSE
    147                    for_cond1 = ''
    148                    ifor_cond1 = 0
    149135                   for_cond2 = ''
    150136                   ifor_cond2 = 0
    151137                ENDIF
    152138             ELSE
    153                 for_host = ' '
    154                 ifor_host = 1
    155139                for_cond1 = ''
    156140                ifor_cond1 = 0
    … …  
    158142                ifor_cond2 = 0
    159143             ENDIF
     144          ELSE
     145             for_host = ' '
     146             ifor_host = 1
     147             for_cond1 = ''
     148             ifor_cond1 = 0
     149             for_cond2 = ''
     150             ifor_cond2 = 0
     151          ENDIF
     152          IF ( do_trace(1:4) == 'true' )  THEN
     153             PRINT*,'var="',var(1:ivar),'"'
     154             PRINT*,'value="',value(1:ivalue),'"'
     155             PRINT*,'for_host="',for_host(1:ifor_host),'"'
     156             PRINT*,'for_cond1="',for_cond1(1:ifor_cond1),'"'
     157             PRINT*,'for_cond2="',for_cond2(1:ifor_cond2),'"'
     158          ENDIF
     159!
     160!--       Geltungsbereich pruefen und evtl. Variable ausgeben
     161          IF ( for_host == ' '  .OR.  ( &
     162               for_host(1:ifor_host) == host(1:ihost)  .AND. &
     163               for_cond1(1:ifor_cond1) == cond1(1:icond1)  .AND. &
     164               for_cond2(1:ifor_cond2) == cond2(1:icond2) &
     165                                      )  .OR. ( &
     166               INDEX( iolist, for_host(1:ifor_host) ) /= 0 &
     167                                              ) )  THEN
     168
     169!
     170!--          Zuerst Doppelpunkte durch Blanks ersetzen (aber doppelt
     171!--          auftretende Doppelpunkte durch einen Doppelpunkt)
     172             i = 0
     173             DO
     174                i = i + 1
     175                IF ( i > ivalue )  EXIT
     176                IF ( value(i:i) == ':' )  THEN
     177                   IF ( value(i+1:i+1) == ':' )  THEN
     178                      value = value(1:i) // value(i+2:ivalue)
     179                      ivalue = ivalue - 1
     180                   ELSE
     181                      value(i:i) = ' '
     182                   ENDIF
     183                ENDIF
     184             ENDDO
     185
     186!
     187!--          Variable ausgeben
     188             WRITE (2,2200)  var(1:ivar), bs, value(1:ivalue), bs, &
     189                             var(1:ivar)
     190 2200        FORMAT ('eval ',A,'=',A,'"',A,A,'"'/'export ',A)
     191
    160192             IF ( do_trace(1:4) == 'true' )  THEN
    161                 PRINT*,'var="',var(1:ivar),'"'
    162                 PRINT*,'value="',value(1:ivalue),'"'
    163                 PRINT*,'for_host="',for_host(1:ifor_host),'"'
    164                 PRINT*,'for_cond1="',for_cond1(1:ifor_cond1),'"'
    165                 PRINT*,'for_cond2="',for_cond2(1:ifor_cond2),'"'
    166              ENDIF
    167 !
    168 !--          Geltungsbereich pruefen und evtl. Variable ausgeben
    169              IF ( for_host == ' '  .OR.  ( &
    170                   for_host(1:ifor_host) == host(1:ihost)  .AND. &
    171                   for_cond1(1:ifor_cond1) == cond1(1:icond1)  .AND. &
    172                   for_cond2(1:ifor_cond2) == cond2(1:icond2) &
    173                                          )  .OR. ( &
    174                   INDEX( iolist, for_host(1:ifor_host) ) /= 0 &
    175                                                  ) )  THEN
    176 
    177 !
    178 !--             Zuerst Doppelpunkte durch Blanks ersetzen (aber doppelt
    179 !--             auftretende Doppelpunkte durch einen Doppelpunkt)
    180                 i = 0
    181                 DO
    182                    i = i + 1
    183                    IF ( i > ivalue )  EXIT
    184                    IF ( value(i:i) == ':' )  THEN
    185                       IF ( value(i+1:i+1) == ':' )  THEN
    186                          value = value(1:i) // value(i+2:ivalue)
    187                          ivalue = ivalue - 1
    188                       ELSE
    189                          value(i:i) = ' '
    190                       ENDIF
    191                    ENDIF
    192                 ENDDO
    193 
    194 !
    195 !--             Variable ausgeben
    196                 WRITE (2,2200)  var(1:ivar), bs, value(1:ivalue), bs, &
    197                                 var(1:ivar)
    198  2200           FORMAT ('eval ',A,'=',A,'"',A,A,'"'/'export ',A)
    199 
    200                 IF ( do_trace(1:4) == 'true' )  THEN
    201                    WRITE (2,2201)  bs, var(1:ivar), value(1:ivalue)
    202  2201              FORMAT ('printf "',A,'n*** ENVIRONMENT-VARIABLE ',A,' = ',A)
    203                 ENDIF
    204 
    205              ENDIF
    206 
    207 !
    208 !--          Variable "host" muss gleich ausgewertet werden, da mit ihr ein
    209 !--          neuer Geltungsbereich festgelegt wird
    210              IF ( var(1:ivar) == 'host' )  THEN
    211 
    212                 host  = value(1:ivalue)
    213                 ihost = ivalue
    214 
    215 !                IF ( host(1:ihost) /= localhost(1:ilocalhost) )  THEN
    216 !
    217 !                   SELECT CASE ( value(1:ivalue) )
    218 !
    219 !                      CASE ( 'cray','hpcs','t3d','t3eb','t3eh','unics','vpp' )
    220 !
    221 !                         dummy = 1
    222 !
    223 !                      CASE DEFAULT
    224 !
    225 !                         WRITE (2,2202)  bs, bs, value(1:ivalue), bs, bs
    226 ! 2202                    FORMAT ('printf "',A,'n +++ Auf Zielrechner ',A,'"',A,A,'" ist kein NQS-System vorhanden"'/ &
    227 !                                 'printf "',A,'n     Programmlauf kann deshalb nicht gestartet werden"'/ &
    228 !                                 'locat=nqs; exit')
    229 !                         STOP
    230 !
    231 !                   END SELECT
    232 !
    233 !                ENDIF
    234 
    235              ENDIF
     193                WRITE (2,2201)  bs, var(1:ivar), value(1:ivalue)
     194 2201           FORMAT ('printf "',A,'n*** ENVIRONMENT-VARIABLE ',A,' = ',A)
     195             ENDIF
     196
     197          ENDIF
     198
     199!
     200!--       Variable "host" muss gleich ausgewertet werden, da mit ihr ein
     201!--       neuer Geltungsbereich festgelegt wird
     202          IF ( var(1:ivar) == 'host' )  THEN
     203
     204             host  = value(1:ivalue)
     205             ihost = ivalue
     206
     207!             IF ( host(1:ihost) /= localhost(1:ilocalhost) )  THEN
     208!
     209!                SELECT CASE ( value(1:ivalue) )
     210!
     211!                   CASE ( 'cray','hpcs','t3d','t3eb','t3eh','unics','vpp' )
     212!
     213!                      dummy = 1
     214!
     215!                   CASE DEFAULT
     216!
     217!                      WRITE (2,2202)  bs, bs, value(1:ivalue), bs, bs
     218! 2202                 FORMAT ('printf "',A,'n +++ Auf Zielrechner ',A,'"',A,A,'" ist kein NQS-System vorhanden"'/ &
     219!                              'printf "',A,'n     Programmlauf kann deshalb nicht gestartet werden"'/ &
     220!                              'locat=nqs; exit')
     221!                      STOP
     222!
     223!                END SELECT
     224!
     225!             ENDIF
    236226
    237227          ENDIF
Note: See TracChangeset for help on using the changeset viewer.
                                                                                                                                                                                                                                                                                                                                                                               
  | Impressum | ©Leibniz Universität Hannover |