Home

Context Navigation

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

Last change on this file since 683 was 556, checked in by raasch, 14 years ago
last commit documented
Property svn:keywords set to `Id`
File size: 19.9 KB

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

Note: See TracBrowser for help on using the repository browser.

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |