d c. DO	NL
È c.		Preprocesses FORTRAN program containing NAMELIST
,c.
c.	This is an update of NAMELIST. The differences are that it
ôc. is more careful about the key words, and produces a result file
Xc. with the same name as the input, but of type .NL.
¼c.
 c.	The name list statements are of the following form:
„c.
èc.		NAMELIST /name/ var1, var2, ,,,
Lc.		READ( iunit, name )
°c.		WRITE( iunit, name )
c.
xc.	For full information, see INFO NAMElist, in a while.
Üc.
@c. -end.of.info-
¤c.
c. 02/18/80	Process C=NLDEB=n
lC. 02/18/80	Require delimitors
Ðc. 02/19/80	Produces xxx.nl
4C.
˜C-		== READS INITAL CARDS AND DISPATCHES
üc.	nlcmd	 == Check for command
`	C.	NLDEF	== PROCESSES 'NAMELIST'
Ä	C.	NLREAd	 == PROCESSES 'READ...'
(
C.	NLWRITE	== PROCESSES 'WRITE...'
Œ
C.	 LENS	== DETERMINES LENGTH OF LINE
ð
C.	 LPAR	== PARSES INPUT LINE
TC.	 INLINE	== READS AN INPUT LINE
¸C.	 OUTNBL	== OUTPUTS THE NON BLANK CHARS
C.	 OUTSTR	== OUTPUTS THE COMPLETE STRING
€c.
äc. for001	== Source Input
Hc. for002	== Result output
¬c. for005	== File def Input
c. for006	== Debug output
tc. for$type	== Prompt output
ØC.
<C.NOT DONE .. CONTINUATION LINES
 C.		ERR=, END=
C.
hC.
Ì	program NL
0c.
”	parameter numlis=100, numvar=100
ø	COMMON /NAMECOM/ NLNAME, NLVARR
\	CHARACTER NLNAME(100)*6, NLVARR(1000)*6
À	COMMON /pointcom/ NLDEB, numcard, NLPOINT
$	INTEGER NLPOINT(100)
ˆC.
ì	CHARACTER*72 LINE
PC.
´C-- Request input file
c.
|100	CONTINUE
à	TYPE 110, '$Source(.for)= '
D	READ(5,110,END=9000) LINE
¨110	FORMAT(10A)
c.
p	IF( INDEX( LINE,'.' ) .EQ. 0 ) THEN
Ô	  LL = LENS( LINE )
8	  LINE = LINE(1:LL)//'.FOR'
œ	ENDIF
 C.
d	OPEN( UNIT=1, NAME=LINE, TYPE='OLD', READONLY
È	1	,CARRIAGECONTROL='LIST',ERR=9000)
,C.
	IF( LINE.EQ.'nltest.FOR' ) THEN !! note.. lower case
ô	  LINE = 'TT:'
X	  ipos = 3
¼	else
 	  ipos = index(line,'.')
„	ENDIF
è	line = line(1:ipos)//'nl'
L	TYPE 110, '  Name List => ',line(1:lens(line))
°	OPEN( UNIT=2, NAME=LINE, TYPE='NEW'
	1	,CARRIAGECONTROL='LIST' )
xC.
Ü	CALL INLINE( LINE )
@C.
¤C-- PROCESS NEXT LINE
 C.
l 200	CONTINUE
Ð C.
4!	IF( NLCMD( LINE, IPOS, 'END      ' ) ) THEN
˜!	  CALL NLDEF( LINE, IPOS )
ü!	ELSE IF( NLCMD( LINE, IPOS, 'NAMELIST' ) ) THEN
`"	  CALL NLDEF( LINE, IPOS )
Ä"	ELSE IF( NLCMD( LINE, IPOS, 'READ' ) ) THEN
(#	  CALL NLREAD( LINE, IPOS )
Œ#	ELSE IF( NLCMD( LINE, IPOS, 'WRITE' ) ) THEN
ð#	  CALL NLWRITE( LINE, IPOS )
T$	ELSE IF( LINE.EQ.'!EOF!' ) THEN
¸$	  type 210, numcard, ' cards processed'
%210	  format( i6, a )
€%	  CALL EXIT(1)
ä%	ELSE
H&C.
¬&C--- Process a normal card
'c.
t'250	  CONTINUE
Ø'	  if( line(1:8).eq.'C=NLDEB=' ) then
<(	    nldeb = ichar(line(9:9))-ichar('0')
 (	  endif
)	  CALL OUTNBL( LINE )
h)	  CALL OUTSTR( '!EOL!' )
Ì)	  CALL INLINE( LINE )
0*	ENDIF
”*	GOTO 200
ø*c.
\+9000	continue
À+		END
$,c======
ˆ,	function nlcmd( line, ipos, string )
ì,c.
P-c.		Determine if is a 'delim' string 'delim'
´-c.
.	character*(*) line, string
|.c.
à.	nlcmd = .false.
D/	if( line(1:1).ne.'C' ) then
¨/	  ipos = index( line, string )
0	  if( ipos.gt.1 .and. line(ipos-1:ipos-1).lt.'0'
p0	1	.and. line(ipos+len(string):ipos+len(string)) .lt.'0' )
Ô0	2	nlcmd = .true.
81	endif
œ1c.
 2	return
d2		end
È2C.
,3c======
3	SUBROUTINE NLDEF( LINE, IPOS )
ô3C.
X4c-		Process NAMELIST /name/ item1, item2,,,
¼4C-
 5C-	Turn into: Character*6 name(n)
„5C-		Data name /'name','item1','item2',,,'$END'/
è5C-		and store in table NLNAME, NLVAR
L6C.
°6	INTEGER IPOS
7	CHARACTER*(*) LINE
x7C.
Ü7	COMMON /NAMECOM/ NLNAME, NLVARR
@8	CHARACTER NLNAME(100)*6, NLVARR(1000)*6
¤8	COMMON /pointcom/ NLDEB, numcard, NLPOINT
9	INTEGER NLPOINT(100)
l9C.
Ð9	CHARACTER STRING*80, CHEND*1
4:	DATA IPT, JPT/0,0/
˜:C.
ü:	
`;	if( nldeb.ge.2 ) WRITE(6,*) ' NAMELIST', IPOS
Ä;C.
(<	IF( LINE(IPOS:).EQ.'END' ) THEN
Œ<	  IPT = 0
ð<	  JPT = 0
T=	  NLNAME(1) = '$END'
¸=	  CALL OUTNBL( LINE )
>	  CALL OUTSTR('!EOL!')
€>	  CALL INLINE( LINE )
ä>	  GOTO 9000
H?	ENDIF
¬?C.
@C-- 'NAMELIST'
t@C.
Ø@	INX = IPOS
<A	JNX = 1
 A	INX = LPAR( LINE(INX:), STRING)+INX
BC.
hB200	CONTINUE
ÌB	INX = LPAR( LINE(INX:), STRING )+ INX
0CC.
”C210	CONTINUE
øC	IPT = IPT+1
\D	NLNAME(IPT) = STRING
ÀD	NLNAME(IPT+1) = '$END'
$E	JPT = JPT+1
ˆE	NLVARR(JPT) = STRING
ìE	NLPOINT(IPT) = JPT
PFC.
´FC-- READ VARIABLES
GC.
|G	DO 290 I=1,100
àG	  IF( INX.GT.LEN(LINE) ) THEN
DH	    JNX = INLINE( LINE )
¨H	    INX = JNX
I	    IF( JNX.LE.1 ) GOTO 295 ! BREAK
pI	  ENDIF
ÔI	  INX = LPAR( LINE(INX:), STRING ) + INX
8J	  CHEND = LINE(INX-1:INX-1)
œJ	  IF( STRING.NE. ' ' ) THEN
 K	   JPT = JPT+1
dK	   NLVARR(JPT) = STRING
ÈK	  ENDIF
,L	  IF( LINE(INX-1:INX-1).EQ.'/' ) GOTO 295 !BREAK
L290	CONTINUE
ôL295	CONTINUE
XM	JPT = JPT+1
¼M	NLVARR(JPT) = '$END'
 NC.
„NC-- OUTPUT CHARACTER*6..., DATA ...
èNC.
LO	CALL OUTSTR('      CHARACTER*6 ' )
°O	CALL OUTNBL(NLNAME(IPT))
P	CALL OUTSTR('(')
xP	ENCODE( 3, 310, STRING) JPT-NLPOINT(IPT)+1
ÜP310	FORMAT( I3 )
@Q	CALL OUTSTR( STRING(1:3) )
¤Q	CALL OUTSTR(')')
R	CALL OUTSTR('!EOL!')
lRC.
ÐR	CALL OUTSTR('      DATA ')
4S	CALL OUTNBL( NLNAME(IPT) )
˜S	CALL OUTSTR( '/' )
üS	DO 390 I=NLPOINT(IPT),JPT
`T	  IF( I.NE.NLPOINT(IPT) ) CALL OUTSTR(',')
ÄT	  CALL OUTSTR('''')
(U	  CALL OUTNBL(NLVARR(I))
ŒU	  CALL OUTSTR('''')
ðU390	CONTINUE
TVC.
¸V	CALL OUTSTR('/')
W	CALL OUTSTR('!EOL!')
€W	IF( JNX.GT.1 ) GOTO 200
äWC.
HX9000	CONTINUE
¬X	RETURN
Y		END
tYC.
ØYc======
<Z	SUBROUTINE NLREAD( LINE, IPOS )
 Zc.
[c-		Process READ, turn into:
h[c-
Ì[c--	call JJ$NLRD( unit, namelist, %discr(),,, )
0\c-
”\c.
ø\	INTEGER IPOS
\]	CHARACTER*(*) LINE
À]C.
$^	COMMON /NAMECOM/ NLNAME, NLVARR
ˆ^	CHARACTER NLNAME(100)*6, NLVARR(1000)*6
ì^	COMMON /pointcom/ NLDEB, numcard, NLPOINT
P_	INTEGER NLPOINT(100)
´_C.
`	CHARACTER*6 UNISTR, STRING
|`C.
à`	if( nldeb.ge.2 ) WRITE(6,* ) '    READ', IPOS
DaC.
¨a	IFS = LPAR( LINE(IPOS:), STRING) + IPOS
b	ISS = LPAR( LINE(IFS:), UNISTR) + IFS
pb	ISS = LPAR( LINE(ISS:), STRING) + ISS
Ôb	DO 190 IPT=1,100
8c	  IF( NLNAME(IPT).EQ.'$END' ) GOTO 195
œc	  IF( NLNAME(IPT).EQ.STRING ) GOTO 200
 d190	CONTINUE
dd195	CONTINUE
Èd	CALL OUTNBL( LINE )
,e	GOTO 9000
eC.
ôeC-- Output a JJ$NLRD(
Xfc.
¼f200	CONTINUE
 g	CALL OUTSTR( LINE(1:IPOS-1) )
„g	CALL OUTSTR('CALL JJ$NLRD(' )
èg	CALL OUTNBL( UNISTR )
Lh	CALL OUTSTR(',' )
°h	CALL OUTNBL( STRING )
i	IFS = NLPOINT(IPT)+1
xic.
Üic-- Output %DISCR(...)
@jc.
¤j	DO 290 I=IFS,IFS+100
k	  IF( NLVARR(I).EQ.'$END') GOTO 295
lk	  CALL OUTSTR( ',%DESCR(' )
Ðk	  CALL OUTNBL( NLVARR(I) )
4l	  CALL OUTSTR( ')' )
˜l290	CONTINUE
ül295	CONTINUE
`m	CALL OUTSTR( ')' )
ÄmC.
(n9000	CONTINUE
Œn	CALL OUTSTR( '!EOL!' )
ðn	CALL INLINE( LINE )
To	RETURN
¸o		END
pc======
€p	SUBROUTINE NLWRITE( LINE, IPOS )
äpc.
Hqc-		Process WRITE, turn into:
¬qc-
rc-	CALL JJ$NLWR( unit, namelist, $DISCR(),,, )
trc.
Ør	INTEGER IPOS
<s	CHARACTER*(*) LINE
 sC.
t	COMMON /NAMECOM/ NLNAME, NLVARR
ht	CHARACTER NLNAME(100)*6, NLVARR(1000)*6
Ìt	COMMON /pointcom/ NLDEB, numcard, NLPOINT
0u	INTEGER NLPOINT(100)
”uC.
øu	CHARACTER*80 UNISTR, STRING
\vC.
Àv	if( nldeb.ge.2 ) WRITE(6,* ) '    WRITE', IPOS
$wC.
ˆw	IFS = LPAR( LINE(IPOS:), STRING) + IPOS
ìw	ISS = LPAR( LINE(IFS:), UNISTR) + IFS
Px	ISS = LPAR( LINE(ISS:), STRING) + ISS
´x	DO 190 IPT=1,100
y	  IF( NLNAME(IPT).EQ.'$END' ) GOTO 195
|y	  IF( NLNAME(IPT).EQ.STRING ) GOTO 200
ày190	CONTINUE
Dz195	CONTINUE
¨z	CALL OUTNBL( LINE )
{	GOTO 9000
p{C.
Ô{C-- Output JJ$NLWR( unit , name
8|c.
œ|200	CONTINUE
 }	CALL OUTSTR( LINE(1:IPOS-1) )
d}	CALL OUTSTR('CALL JJ$NLWR(' )
È}	CALL OUTNBL( UNISTR )
,~	CALL OUTSTR(',' )
~	CALL OUTNBL( STRING )
ô~	IFS = NLPOINT(IPT)+1
XC.
¼C-- Output the %DISCR(...)
 €C.
„€	DO 290 I=IFS,IFS+100
è€	  IF( NLVARR(I).EQ.'$END') GOTO 295
L	  CALL OUTSTR( ',%DESCR(' )
°	  CALL OUTNBL( NLVARR(I) )
‚	  CALL OUTSTR( ')' )
x‚290	CONTINUE
Ü‚295	CONTINUE
@ƒ	CALL OUTSTR( ')' )
¤ƒC.
„9000	CONTINUE
l„	CALL OUTSTR( '!EOL!' )
Ð„	CALL INLINE( LINE )
4…	RETURN
˜…		END
ü…c======
`†	FUNCTION LENS( LINE )
Ä†c.
(‡c-		Find the length of a string
Œ‡c.
ð‡	CHARACTER*(*) LINE
TˆC.
¸ˆ	LENS = 0
‰	DO 190 I=1,LEN(LINE)
€‰	  IF( LINE(I:I).NE.' ' ) LENS = I
ä‰190	CONTINUE
HŠ	RETURN
¬Š	END
‹c======
t‹	FUNCTION LPAR( LINE, STRING )
Ø‹c.
<Œc-		Parse a line
 Œc.
	CHARACTER*(*) LINE, STRING
hC.
Ì	STRING = ' '
0Ž	LS = 0
”Ž	DO 190 LPAR=1,LEN(LINE)
øŽ	  IF( LINE(LPAR:LPAR).GT.' ' .AND. LINE(LPAR:LPAR).LT.'0')
\	1	GOTO 200
À	  IF( LINE(LPAR:LPAR).NE.' ' .AND. LINE(LPAR:LPAR).NE.'	' ) THEN
$	    LS = LS+1
ˆ	    STRING(LS:LS) = LINE(LPAR:LPAR)
ì	  ENDIF
P‘190	CONTINUE
´‘200	CONTINUE
’C.
|’	RETURN
à’		END
D“c======
¨“	FUNCTION INLINE( LINE )
”c.
p”c-		Input a source line.
Ô”c.
8•	CHARACTER*(*) LINE
œ•	common /pointcom/ NLDEB, numcard
 –C.
d–	LINE = '!EOF!'
È–C.
,—	READ( 1, 110, END=9000 ) LINE
—	numcard = numcard+1
ô—110	FORMAT(A)
X˜c.
¼˜	do 210 ii=1,len(line)
 ™	  if( line(ii:ii).ge.'a' .and. line(ii:ii).le.'z' )
„™	1  line(ii:ii)=char(ichar('A')+ichar(line(ii:ii))-ichar('a'))
è™210	continue
Lšc.
°š	if( nldeb.ge.1 ) write( 6,110 ) ' ',line(1:72)
›C.
x›	IF( LINE(1:5).EQ.' ' .AND.
Ü›	1 ( LINE(6:6).NE.' ' )) THEN
@œ		INLINE = 7
¤œ	ELSE IF( LINE(1:1).EQ.'	' .AND.
	1 ( LINE(2:2).GE.'0' .AND. LINE(2:2).LE.'9' ) ) THEN
l		INLINE = 3
Ð	ELSE
4ž		INLINE = 1
˜ž	ENDIF
üžC.
`Ÿ9000	RETURN
ÄŸ		END
( c======
Œ 	SUBROUTINE OUTNBL( STRING )
ð c-
T¡c-		Output a NL line, to the last non blank
¸¡c.
¢	CHARACTER*(*) STRING
€¢C-
ä¢	ILEN = LENS( STRING )
H£	CALL OUTSTR( STRING(1:ILEN))
¬£	RETURN
¤		END
t¤c======
Ø¤	SUBROUTINE OUTSTR( STRING )
<¥c.
 ¥c-		Prepair a string for output
¦c.
h¦	CHARACTER STRING*(*)
Ì¦C.
0§	CHARACTER LINE*132
”§	DATA LINE/' '/
ø§C.
\¨	CHARACTER*3 TSTRING
À¨	DATA IPOS/1/
$©C.
ˆ©	if( nldeb.ge.2 ) WRITE( 6,110 ) '__',STRING, '__'
ì©	IF( STRING.EQ.'!EOL!' ) THEN
Pª	IF( IPOS.GT.1 )
´ª	1  WRITE( 2, 110 ) LINE(1:IPOS-1)
«110	  FORMAT( 10A )
|«	  IPOS = 1
à«	  GOTO 9000
D¬	ENDIF
¨¬C.
­	LINE(IPOS:) = STRING
p­	IPOS = IPOS+LEN(STRING)
Ô­	IF( IPOS.GT.72 ) THEN
8®	  WRITE( 2,110 ) LINE(1:72)
œ®	  LINE = '     1'//LINE(73:)
 ¯	  IPOS = IPOS-73+7
d¯	ENDIF
È¯C.
,°9000	CONTINUE
°	RETURN
ô°		END