Changeset 72 for palm/trunk/UTIL/interpret_config.f90
- Timestamp:
- Mar 19, 2007 8:20:46 AM (18 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
palm/trunk/UTIL/interpret_config.f90
r69 r72 1 1 PROGRAM interpret_config 2 2 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 4 19 ! 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: 15 22 ! ------------- 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 !------------------------------------------------------------------------------! 19 28 20 29 IMPLICIT NONE 21 30 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) 23 33 CHARACTER (LEN=20) :: do_remote, do_trace, host, localhost 24 34 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, & 27 37 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, & 33 42 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, iva lue_mrun, ivar, izeile43 ios, iout = 0, ioutput_list, is1, is2, is2a, is2b, is2c, & 44 is3, is3cond, is4, is5, is6, ivalue, ivar, izeile 36 45 37 46 LOGICAL :: found 38 47 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 41 51 42 52 … … 53 63 ioutput_list = LEN_TRIM( output_list ) 54 64 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 )65 65 iolist = input_list(1:iinput_list) // output_list(1:ioutput_list) 66 66 … … 89 89 90 90 IF ( LEN_TRIM( zeile ) == 0 ) THEN 91 91 92 CONTINUE 93 92 94 ELSEIF ( zeile(1:1) == '#' ) THEN 95 93 96 icomment = icomment + 1 97 94 98 ELSEIF ( zeile(1:1) == '%' ) THEN 99 95 100 ienvvar = ienvvar + 1 96 101 i = INDEX( zeile, ' ' ) … … 98 103 ivar = i - 2 99 104 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 112 118 113 119 zeile(1:i) = empty(1:i) 114 120 zeile = ADJUSTL( zeile ) 115 121 i = INDEX( zeile, ' ' ) 116 value = zeile(1:i-1)117 ivalue = i - 1118 119 zeile(1:i) = empty(1:i)120 zeile = ADJUSTL( zeile )121 i = INDEX( zeile, ' ' )122 122 123 123 IF ( i /= 1 ) THEN 124 for_ host= zeile(1:i-1)125 ifor_ host= i - 1124 for_cond1 = zeile(1:i-1) 125 ifor_cond1 = i - 1 126 126 127 127 zeile(1:i) = empty(1:i) … … 130 130 131 131 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 146 134 ELSE 147 for_cond1 = ''148 ifor_cond1 = 0149 135 for_cond2 = '' 150 136 ifor_cond2 = 0 151 137 ENDIF 152 138 ELSE 153 for_host = ' '154 ifor_host = 1155 139 for_cond1 = '' 156 140 ifor_cond1 = 0 … … 158 142 ifor_cond2 = 0 159 143 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 160 192 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 236 226 237 227 ENDIF
Note: See TracChangeset
for help on using the changeset viewer.