FUNCTION JJNLRD(IUNIT, LIST, NUMD, LOCD )
c.		Do fortran Name List Read
C.
C	JJNLRD	==(1) READ A NAME LIST
C	JJNLWR	==(2) WRITE A NAME LIST
C	JJNLPAR	==(3) PARSE INPUT DATA
C	JJOPRD	==(4) OPEN A FILE
C.
C. ONLY PROCESS REAL*4, INTEGER*4 DATA, NO BOUNDS CHECK
C. FOR ARRAYS
C.
C. ?ON		TURN DIAG ON
C. ?OFF		TURN DIAG OFF
C. ?..		WRITE( .., LIST )
C. @FILENAME	READ INPUT FROM 'FILENAME' (UNIT=99)
C.
C+ JJNLRD	READS 'IUNIT', AND PROCESSES THE NAME LIST
C.
c-end.of.info-
C+++++++++
	INTEGER IUNIT
	CHARACTER*(*) LIST(100)
	INTEGER LOCD(100)
C-
	CHARACTER LINE*80, STRING*80
	CHARACTER NAME*50, PARSTR*80
	REAL*8 TEMP
	INTEGER ID(2)
	BYTE BD(8)
	EQUIVALENCE( ID, BD )
C.
C.........
19	FORMAT( 10A )
C.........
C.
C... INITALIZE
C.
100	CONTINUE
	INUNIT = IUNIT
	NAME = ' '
	JJNLRD=0
	ISLIST = 0
	ID(2) = 0
C.
C... LLL = NUMBER OF CHAR IN '$LISTNAME'
C.
	DO 110 LLL=1,LEN(LIST(1))
	  IF( LIST(1)(LLL:LLL).EQ.' ' ) GOTO 115
110	CONTINUE
115	CONTINUE
C.
C... GET A NEW 'CARD'
C.
300	CONTINUE
C.
	LL = 0
C.
C... PROMPT IF 'READ(5'
C.
	IF( INUNIT.EQ.5 ) WRITE(6,19) '$$', LIST(1),': '
C.
C... READ IN ONE CARD
C.
	READ(INUNIT,19,END=8000) LINE
C.
C... SEARCH FOR ' $LISTNAME'
C.
	IF( INUNIT.NE.5 ) THEN
	  IF( ISLIST.EQ.0 .AND. ( LINE(2:2).NE.'$'
	1	.OR. LINE(3:LLL+3).NE. LIST(1))) THEN
	    WRITE(6,19)'  ', LIST(1), '*SKIP*', LINE(1:60)
	    GOTO 300
	  ENDIF
C.
C... FOUND ' $LISTNAME'
C.
	  IF( ISLIST.EQ.0 ) THEN
	    LL = LLL+2
	    ISLIST = 1
	  ENDIF
C.
	ENDIF
	JJNLRD=1
C.
C... PROCESS A NEW ATOM
C.
400	CONTINUE
	LL = LL+1
	IF( LL.GE.70 ) GOTO 300
C.
C... PARSE THE ATOM
C.
	LL = LL+JJNLPAR(LINE(LL:),LS,STRING)-1
	IF( LS.EQ.0 ) GOTO 400
C.
C... PROCESS THE ATOM
C.
	IF( STRING.EQ.'$END' ) THEN
	  GOTO 9000 !END OF LIST
C.
	ELSE IF( STRING.EQ.'?ON' ) THEN
	  IDEB = 1
	ELSE IF( STRING.EQ.'?OFF' ) THEN
	  IDEB = 0
	ELSE IF( STRING(1:1).EQ.'?' ) THEN
	  DECODE( LS-1, 510, STRING(2:LS) ) IOUNIT
510	  FORMAT( I10 )
	  IF( IOUNIT.EQ.0 ) IOUNIT=6
	  CALL JJNLWR( IOUNIT, LIST, NUMD, LOCD )
	ELSE IF( STRING(1:1).EQ.'@' ) THEN
	  INOPEN = 1
	  INUNIT = 99
	  OPEN( UNIT=99, NAME=STRING(2:), TYPE='OLD' )
	  ISLIST = 1
	  GOTO 300
C.	  .........
C.
	ELSE IF( LINE(LL:LL).EQ.'=' ) THEN
C.
C.... PROCESS 'NAME='
C.
	  NAME = STRING
	  PARSTR = ' '
	  IPAR = INDEX( NAME,'(' )
	  IF( IPAR.NE.0 ) THEN
	    PARSTR = NAME(IPAR+1:)
	    NAME = NAME(1:IPAR-1)
	  ENDIF
C.
	  DO 520 IL=1,100
	    IF( LIST(IL).EQ.'$END' ) GOTO 525 !NAME NOT FOUND
	    IF( NAME.EQ.LIST(IL) ) GOTO 550 !NAME FOUND
520	  CONTINUE
525	  CONTINUE
C.
	  ID(2) = 0
	  IF( IDEB.NE.0 )
	1	WRITE( 6,19),'	', LIST(1), '*DOESN''T CONTAIN* ', NAME
	  GOTO 400
C.	.........
C.
C... FOUND NAME
C.
550	  CONTINUE
D		WRITE(6,*)' ', LIST(IL), ,'=', TEMP
	  CALL ML$GET( LOCD(IL-1), 8, ID )
D		WRITE( 6,560 ) ID
560	  FORMAT( ' ', 5Z10 )
C.
	  IELE = 0
	  IF( BD(4).NE.4 ) GOTO 575
C.
C... PROCESS ARRAY
C.
	  IX = 20
	  IITM = 1
570	  CONTINUE
	  IF( PARSTR.EQ.' ' ) GOTO 575
	    ICOM = INDEX( PARSTR, ',' )
	    IF( ICOM.EQ.0 ) ICOM = INDEX( PARSTR, ')' )
	    DECODE( ICOM-1, 610, PARSTR(1:ICOM-1),ERR=572) IMUL
	  GOTO 573
572	  CONTINUE
	  WRITE(6,*)'--Subs. err**',LIST(IL),'_',PARSTR(1:ICOM-1),'_'
	  IMUL = 1
C.
573	  CONTINUE
	    IELE = IELE + IITM * ( IMUL-1 )
	    CALL ML$GET( LOCD(IL-1)+IX, 4, IMAX )
	    IITM = IITM*IMAX
	    IX = IX+4
	    PARSTR = PARSTR( ICOM+1:)
	    GOTO 570
C.	.........
C.
575	  CONTINUE
	  GOTO 400
C.	.........
	ELSE IF( ID(2).NE.0 ) THEN
	  IAST = INDEX( STRING, '*' )
	  IF( IAST.GT. 1 ) THEN
C.
C... PROCESS N*
C.
	    DECODE( IAST-1, 610, STRING(1:IAST-1),ERR=613) NUMVAL
610	    FORMAT( I10 )
	    GOTO 615
613	    CONTINUE
	    WRITE(6,*)'--N*    err**',LIST(IL),'_',STRING(1:IAST-1),'_'
	    NUMVAL = 1
C.
615	    CONTINUE
	    STRING = STRING( IAST+1:)
	    LS = LS-IAST
	  ELSE
C.
	    NUMVAL = 1
	  ENDIF
C.
C.... PROCESS 'VALUE,'
C.
	  IF( STRING.EQ.'.TRUE.' ) THEN
	    TEMP = 1
	  ELSE IF( STRING.EQ.'.FALSE.' ) THEN
	    TEMP = 0
	  ELSE
	    DECODE( LS, 620, STRING(1:LS),ERR=633) TEMP
620	    FORMAT( G20.0 )
	    GOTO 635
633	    CONTINUE
	    WRITE(6,*)'--Value err**',LIST(IL),'_',STRING(1:LS),'_'
	    TEMP = 1.0
C.
635	    CONTINUE
	  ENDIF
C.
	  DO 690 I=1,NUMVAL
C.
C... STORE 'NUMVAL*' COPIES OF THE VALUE
C.
	    IF( BD(3).EQ.8 .OR. BD(3).EQ.4 ) THEN
	      ITEM = TEMP
	      CALL ML$PUT( ITEM, 4, ID(2)+4*IELE)
	    ELSE
	      CALL ML$PUT( TEMP, 4, ID(2)+4*IELE)
	    ENDIF
	    IF( BD(4).EQ.4 )   IELE = IELE+1
690	  CONTINUE
C.
	ENDIF
	GOTO 400
C.	.........
C.
8000	CONTINUE
	WRITE(     6, 19 ) ' **EOF** $',LIST(1)
	IF( INOPEN.NE.0 ) THEN
	  INOPEN = 0
	  CLOSE( UNIT=99 )
	  INUNIT = IUNIT
	  GOTO 300
C.	  .........
	ENDIF
	STOP
C.	.........
C.
9000	CONTINUE
	IF( INOPEN.NE.0 ) THEN
	  INOPEN = 0
	  CLOSE( UNIT=99 )
	ENDIF
	RETURN
		END