C 
C====================================================================
C 
C	MPREAD.PGM
C 
C====================================================================
C 
C 
	LOGICAL*1 IPRMPT,IEMCRB,LEXTEN,IDFLT(4),PERIOD,LCOMM
	LOGICAL*1 NULSTR,QHELP(12)
	INTEGER*2 ICHAR(2)
	REAL*4 MPHELP(3)
	REAL*8 ERRMSG(2,12)
C 
	EQUIVALENCE (IEMCRW,IEMCRB),(QHELP,MPHELP)
C 
	DATA ERRMSG(1, 1),ERRMSG(2, 1)/8HOpening ,8HPDL file/
	DATA ERRMSG(1, 2),ERRMSG(2, 2)/8HReading ,8HP-Ph cmd/
	DATA ERRMSG(1, 3),ERRMSG(2, 3)/8HIllg P-P,8Hh tag 1 /
	DATA ERRMSG(1, 4),ERRMSG(2, 4)/8HIllg P-P,8Hh tag 2 /
	DATA ERRMSG(1, 5),ERRMSG(2, 5)/8HDecoding,8H param  /
	DATA ERRMSG(1, 6),ERRMSG(2, 6)/8HIllg F-P,8Hh cmd   /
	DATA ERRMSG(1, 7),ERRMSG(2, 7)/8HNeed a d,8Hata file/
	DATA ERRMSG(1, 8),ERRMSG(2, 8)/8HToo many,8H dat fil/
	DATA ERRMSG(1, 9),ERRMSG(2, 9)/8HNon-exis,8H dat fil/
	DATA ERRMSG(1,10),ERRMSG(2,10)/8HIllg PDL,8H nesting/
	DATA ERRMSG(1,11),ERRMSG(2,11)/8HIn spawn,8Hing     /
	DATA ERRMSG(1,12),ERRMSG(2,12)/8HReading ,8HPDL file/
C 
	DATA IDFLT/'.','P','D','L'/,PERIOD/'.'/
	DATA LLABEL/70/
	DATA MPHELP/'HELP',' MUL','PLT '/
C 
C--------------------------------------------------------------------
C 
C	ENTRY
C 
C--------------------------------------------------------------------
C 
	LABORT = .FALSE.
	LISTXY = .FALSE.
	NLSTXY = .TRUE.
	DUMPXY = .FALSE.
	CALL KBCKON (5,ICHART,ICHARF,LFLAG)
	IPRMPT = BELL
	IF (NEWRUN) GO TO 100
	IF (PPHASE) GO TO 1010
	GO TO 2070
C 
C--------------------------------------------------------------------
C 
C	BEGIN FIRST PLOT
C 
C--------------------------------------------------------------------
C 
 100	WRITE (LUNTI,8500) MPVERS
	NEWRUN = .FALSE.
	LUNPDL = LUNTI
	IPRMPT = BELL
	PROMPT = .TRUE.
C 
C	CHECK FOR MCR LINE DEFINITION OF PDL FILE
C 
	CALL GETMCR(STRNG0,ICHAR)
	LSTRN0 = MIN0(ICHAR(1),NSTRN0)
C	look for the first space ...
	IFIRST = LSTRN0 + 1		! fool us into thinking of no file
	DO 105 I=1,LSTRN0
	IF (STRNG0(I) .NE. "40) GOTO 105
	IFIRST = I + 1			! we've found a file name
	GOTO 110
105	CONTINUE
C
C--------------------------------------------------------------------
C 
C	NP:  BEGIN A NEW PLOT
C 
C--------------------------------------------------------------------
C 
 110	NFILE = 1
	LNEWPL = .TRUE.
C 
C--------------------------------------------------------------------
C 
C	AP: APPEND PDL FILE TO CURRENT SET
C 
C--------------------------------------------------------------------
C 
 120	NULSTR = (LSTRN0 - IFIRST + 1) .LT. 1
C 
C	ADD ".PDL" TO FILE SPEC. IF NO EXTENSION IS PRESENT
C 
	IF (NULSTR) GO TO 150
	LEXTEN = .FALSE.
	DO 130 I=IFIRST,LSTRN0
	LEXTEN = (STRNG0(I) .EQ. PERIOD) .OR. LEXTEN
 130	CONTINUE
	IF (LEXTEN) GO TO 150
	K = LSTRN0 + 1
	LSTRN0 = LSTRN0 + 4
	J = 1
	DO 140 I=K,LSTRN0
	STRNG0(I) = IDFLT(J)
	J = J + 1
 140	CONTINUE
 150	STRNG0(LSTRN0+1) = 0
C 
C	OPEN LEVEL 1 PDL FILE (IF REQUIRED)
C 
	IF (PFILE1) GO TO 160
	IF (NULSTR) GO TO 180
	OPEN (UNIT=LUNPD1,NAME=STRNG0(IFIRST),TYPE='OLD',READONLY,
	1ERR=9110)
	LUNPDL = LUNPD1
	PFILE1 = .TRUE.
	PROMPT = .FALSE.
	GO TO 190
C 
C	OPEN LEVEL 2 PDL FILE (IF REQUIRED)
C 
 160	IF (PFILE2) GO TO 9020
C 
C	RETURN TO TI: IF NULL FILE SPEC. IN PDL LEVEL 1
C 
	IF (.NOT.NULSTR) GO TO 170
	CLOSE (UNIT=LUNPD1)
	PFILE1 = .FALSE.
	GO TO 180
C 
 170	OPEN (UNIT=LUNPD2,NAME=STRNG0(IFIRST),TYPE='OLD',READONLY,
	1ERR=9110)
	LUNPDL = LUNPD2
	PFILE2 = .TRUE.
	GO TO 190
C 
C	TI: IS THE SOURCE OF THE PDL
C 
 180	LUNPDL = LUNTI
	PFILE1 = .FALSE.
	PROMPT = .TRUE.
	IPRMPT = BELL
C 
C	GO TO INITIALIZATION IF DESIRED
C 
 190	IF (LNEWPL) GO TO 1230
C 
C====================================================================
C 
C	P-PHASE
C	INPUT GENERAL PLOT PARAMETERS
C 
C====================================================================
C 
 1010	PPHASE = .TRUE.
	IF (.NOT.PROMPT) GO TO 1020
	WRITE(LUNTI,8510)IPRMPT
	IPRMPT = 0
C 
C	INPUT NEXT RECORD FROM PDL
C 
 1020	READ(LUNPDL,8000,END=2431,ERR=9000)LSTRN0,STRNG0
	IF (LABORT) GO TO 2431
	LSTRN0 = MIN0(LSTRN0,NSTRN0)
	IF (LSTRN0 .EQ. 0) GOTO 1010
C 
C	SUPPORT TWO FILE FORMATS; 1) STANDARD PDL FILES WITH CARRIAGE CONTROL,
C	 AND 2) INDIRECT COMMAND FILES WITHOUT CARRIAGE CONTROL.  ASSUME THAT
C	 ANY LINE BEGINNING WITH A SPACE SHOULD BE INTERPRETTED AS A CARRIAGE
C	 CONTROL FORMATTED RECORD.
C 
	IFIRST = 1
	IF(STRNG0(1).NE."40)GO TO 1030
	IFIRST = 2
	LSTRN0 = LSTRN0-1
 1030	DECODE(LSTRN0,8010,STRNG0(IFIRST),ERR=9100)ICMD,LSTRN0,STRNG0
	LCOMM = ICMD .EQ. '; '
	IF (LCOMM .OR. LISTPD) WRITE (LUNTI,8550) ICMD,
	1(STRNG0(I),I=1,LSTRN0)
	IF (LCOMM) GO TO 1010
C 
 1040	LSTRN1 = LSTRN0 - 2
	LSTRN2 = LSTRN1 - 2
	IFIRST = 1
C 
C	IDENTIFY PRIMARY TAG
C 
	CALL GETCMD (ICMD,IPTAG1,NPTAG1,NCMD1)
	IF (NCMD1.LE.0) GO TO 9090
C 
C	IDENTIFY SECONDARY TAG
C 
	CALL GETCMD (ICMD1,IPTAG2,NPTAG2,NCMD2)
	CALL GETCMD (ICMD1,IPTAG3,NPTAG3,NCMD3)
	CALL GETCMD (ICMD1,IPTAG4,NPTAG4,NCMD4)
	CALL GETCMD (ICMD1,IPTAG5,NPTAG5,NCMD5)
C 
C--------------------------------------------------------------------
C 
C	FINISH THE INPUT OF THE CURRENT LINE
C 
C--------------------------------------------------------------------
C 
	GO TO (1050,1070,1080,1100,1110,1120,1210,1140,1300,1230,
	1      1010,2270,2480,2480,2470,2510,2110,2490, 110,1170,
	2      1190,1220,2433,2433,1200,1150,1160,2040,2050,2000,
	3      2020,2030,1130,2431,2320,1180,1310,2060, 120,2440,
	4      2450,2510,1225,1226,2520,1227,1228) NCMD1
C 
C--------------------------------------------------------------------
C 
C	HANDLE DOUBLE TAG INPUT COMMANDS
C 
C--------------------------------------------------------------------
C 
C++++++++
C	TIXX: INPUT TITLES
C++++++++
 1050	IF (NCMD3.EQ.0) GO TO 9080
	LSTRN1 = MIN0(LSTRN1,NTITLE)
	DO 1060 I=1,LSTRN1
	TITLE (I,NCMD3) = STRNG1(I)
 1060	CONTINUE
	LTITL(NCMD3) = LSTRN1
	GO TO 1010
C++++++++
C	MMXX: INPUT DATA SPACE EXTREMA
C++++++++
 1070	IF (NCMD5.EQ.0) GO TO 9080
	DECODE (LSTRN1,8020,STRNG1,ERR=9070) XT,YT
	XTREMA(1,NCMD5) = XT
	XTREMA(2,NCMD5) = YT
	LNSCAN(NCMD5) = XT.NE.YT
	LSCAN = .FALSE.
	DO 1075 I=1,4
 1075	LSCAN = LSCAN .OR. (.NOT.LNSCAN(I) .AND. LSPACE(I))
	GO TO 1010
C++++++++
C	FMXX: INPUT AXIS TICK MARK LABEL FORMATS
C++++++++
 1080	IF (NCMD2.EQ.0) GO TO 9080
	LSTRN1 = MIN0(LSTRN1,NTLFOR)
	DO 1090 I=1,LSTRN1
	TLFORM(I,NCMD2) = STRNG1(I)
 1090	CONTINUE
	LTLFOR(NCMD2) = LSTRN1
	GO TO 1010
C++++++++
C	TMXX:  INPUT TICK MARK PARAMETERS
C++++++++
 1100	IF (NCMD2.EQ.0) GO TO 9080
	DECODE (LSTRN1,8070,STRNG1,ERR=9070) DELLTX(NCMD2),DELSTX(NCMD2),
	1N3,ANGLAB(NCMD2)
	NLABEL(NCMD2) = MAX0(1,N3)
	GO TO 1010
C++++++++
C	MOXX:  INPUT AXIS MODE CONTROL PARAMETERS
C++++++++
 1110	IF (NCMD2.EQ.0) GO TO 9080
	DECODE (LSTRN1,8080,STRNG1,ERR=9070) IDISAB(NCMD2),IMODE(NCMD2),
	1                  II
	IF (II.EQ.0) II = 1
	IFUNC(NCMD2) = II
	GO TO 1010
C++++++++
C	CPXX:  INPUT CHARACTER PARAMETERS
C++++++++
 1120	IF (NCMD4.EQ.0) GO TO 9080
	DECODE (LSTRN1,8020,STRNG1,ERR=9070) (CPARAM(K,NCMD4),K=1,4)
	GO TO 1010
C++++++++
C	CNXX: INPUT CHARACTER PARAMETERS
C++++++++
 1130	IF (NCMD4.LE.0) GO TO 9080
	DECODE (LSTRN1,8040,STRNG1,ERR=9070) NIBPT4(NCMD4),CPARAM(5,NCMD4)
	GO TO 1010
C++++++++
C	TXXX:  INPUT TICK MARK LENGTHS
C++++++++
 1140	IF(NCMD2.LE.0) GO TO 9080
	DECODE (LSTRN1,8020,STRNG1,ERR=9070) (TIXLNG(J,NCMD2),J=1,4)
	GO TO 1010
C++++++++
C	TLXX: INPUT TICK MARK LABEL EXTREMA
C++++++++
 1150	IF (NCMD2.EQ.0) GO TO 9080
	DECODE (LSTRN1,8020,STRNG1,ERR=9070)TLFRST(NCMD2),TLLAST(NCMD2)
	GO TO 1010
C++++++++
C	TPXX: INPUT TICK MARK LINE PATTERNS
C++++++++
 1160	IF (NCMD2.EQ.0) GO TO 9080
	DECODE (LSTRN1,8050,STRNG1,ERR=9070) (LPATTX(I,NCMD2),I=1,4)
	GO TO 1010
C 
C--------------------------------------------------------------------
C 
C	HANDLE SINGLE TAG INPUT COMMANDS
C 
C--------------------------------------------------------------------
C 
C++++++++
C	XA:  INPUT PHYSICAL DESCRIPTION OF THE PLOTTING SURFACE
C++++++++
 1170	DECODE (LSTRN0,8020,STRNG0,ERR=9070) XMARGL,XLNGTH,TEMP
	XMARGU = TEMP
	IF (TEMP.EQ.0.0) XMARGU = XMARGL
	GO TO 1010
C++++++++
C	RA:  INPUT GLOBAL PLOT ROTATION ANGLE AND SCALE FACTOR
C++++++++
 1180	DECODE (LSTRN0,8020,STRNG0,ERR=9070) SCALE,PLTANG
	GO TO 1010
C++++++++
C	YA:  INPUT PHYSICAL DESCRIPTION OF PLOTTING SURFACE
C++++++++
 1190	DECODE (LSTRN0,8020,STRNG0,ERR=9070) YMARGL,YLNGTH,TEMP
	YMARGR = TEMP
	IF (TEMP.EQ.0.0) YMARGR = YMARGL
	GO TO 1010
C++++++++
C	SP:  INPUT DISTANCE BETWEEN TICK MARKS AND LABELS
C++++++++
 1200	DECODE (LSTRN0,8020,STRNG0,ERR=9070) SPACE
	GO TO 1010
C++++++++
C	NA:  INPUT NIB SIZE OF AXES FEATURES
C++++++++
 1210	DECODE(LSTRN0,8030,STRNG0,ERR=9070) NIBAX
	GO TO 1010
C++++++++
C	SF:  GLOBAL SCALE FACTORS
C++++++++
 2000	DECODE (LSTRN0,8020,STRNG0,ERR=9070) SFGLB
	DO 2010 K=1,4
	IF (SFGLB(K).EQ.0.0) SFGLB(K) = 1.0
 2010	CONTINUE
	GO TO 1010
C++++++++
C	OF:  INPUT GLOBAL OFFSETS
C++++++++
 2020	DECODE (LSTRN0,8020,STRNG0,ERR=9070) OFFGLB
	GO TO 1010
C++++++++
C	AS:  ASSIGN AXES TO DATA SPACES
C++++++++
 2030	DECODE (LSTRN0,8030,STRNG0,ERR=9070) (IAXSPC(K),K=1,4)
	LSPACE(1) = IAXSPC(1).EQ.1.OR.IAXSPC(3).EQ.1
	LSPACE(2) = IAXSPC(2).EQ.1.OR.IAXSPC(4).EQ.1
	LSPACE(3) = IAXSPC(1).EQ.2.OR.IAXSPC(3).EQ.2
	LSPACE(4) = IAXSPC(2).EQ.2.OR.IAXSPC(4).EQ.2
	LSCAN = .FALSE.
	DO 2035 I=1,4
 2035	LSCAN = LSCAN .OR. (.NOT.LNSCAN(I) .AND. LSPACE(I))
	GO TO 1010
C++++++++
C	LB:  INBUT LOG BASES
C++++++++
 2040	DECODE (LSTRN0,8020,STRNG0,ERR=9070) (BASLOG(K),K=1,4)
	GO TO 1010
C++++++++
C	RC:  INPUT RECIPROCAL CONSTANTS
C++++++++
 2050	DECODE (LSTRN0,8020,STRNG0,ERR=9070) (RCON(K),K=1,4)
	GO TO 1010
C++++++++
C	VS:  SET DEVICE DRAWING SPEED
C++++++++
 2060	DECODE (LSTRN0,8020,STRNG0,ERR=9070) DRWSPD
	GO TO 1010
C 
C--------------------------------------------------------------------
C 
C	HANDLE SINGLE TAG ACTION COMMANDS
C 
C--------------------------------------------------------------------
C 
C++++++++
C	VE:  TYPE THE VERSION NUMBER
C++++++++
 1220	WRITE (LUNPDL,8500) MPVERS
	GO TO 1010
C++++++++
C	ER:  ERASE THE SCREEN
C++++++++
 1225	IF (LSTRN0 .LE. 0) GOTO 1224	! use the old IDEV if none given
	DECODE(LSTRN0,8030,STRNG0,ERR=9070) IDEV
 1224	CALL VECTOR(X,Y,-5)			! ask VECTOR if a valid device
	IF (X .LE. 0) GOTO 1226			! invalid - do a G? for us
	IF (IDEV .EQ. 0) GOTO 1010		! don't erase a file
	CALL ASSIGN(LUNGRP,GDDEVN(1,IDEV))	! assign the device
	CALL VECTOR (0.0,0.0,-4)		! initialize the device
	CALL VECTOR (0.0,0.0,0)			! clear the screen
	CALL VECTOR (0.0,0.0,4)			! and finish up
	GO TO 1010
C++++++++
C	G?: LIST SUPPORTED GRAPHICS DEVICES
C++++++++
 1226	LSTRN0 = 0			! use the "AG" command ...
	CALL MPASGD
	GO TO 1010
C++++++++
C	DT:  turn on/off the date and time feature
C++++++++
 1227	DECODE(LSTRN0,8030,STRNG0,ERR=9070) I
	LTIDAT = .FALSE.
	IF (I .NE. 0) LTIDAT = .TRUE.
	GOTO 1010
C++++++++
C	AG:  assign/display a graphics device
C++++++++
 1228	CALL MPASGD
	GOTO 1010
C++++++++
C	DF:  SET PLOT PARAMETERS TO DEFAULT
C++++++++
 1230	LISTXY = .FALSE.
	NLSTXY = .TRUE.
	DUMPXY = .FALSE.
	LNEWPL = .FALSE.
	LTIDAT = .TRUE.
	SCALE = 1.0
	XMARGL = 0.5
	XMARGU = 0.5
	XLNGTH = 5.0
	YMARGL = 0.5
	YMARGR = 0.5
	YLNGTH = 4.0
	PLTANG = 0.0
	NIBAX(1) = 2
	NIBAX(2) = 1
	NIBAX(3) = 2
	NIBAX(4) = 1
	LSCAN = .TRUE.
	DO 1240 I=1,4
	SPACE(I) = 0.1
	SFGLB(I) = 1.0
	OFFGLB(I) = 0.0
	IAXSPC(I) = 1
	LSPACE(I) = .TRUE.
	LNSCAN(I) = .FALSE.
	DO 1240 J=1,2
	XTREMA(J,I) = 0.0
	XTREMT(J,I) = 0.0
 1240	CONTINUE
	IAXSPC(3) = 0
	IAXSPC(4) = 0
	LSPACE(3) = .FALSE.
	LSPACE(4) = .FALSE.
	SPACE(2) = 0.2
	SPACE(3) = 0.3
C 
C	INITIALIZE SECONDARY TAG GROUP 1
C 
	DO 1270 I=1,NPTAG2
	TLFRST(I) = 0.0
	TLLAST(I) = 0.0
	DELLTX(I) = -1.
	DELSTX(I) = -1.
	NLABEL(I) = 1
	ANGLAB(I) = 0.0
	TIXLNG(1,I) = 0.1
	TIXLNG(2,I) = 0.1
	TIXLNG(3,I) = 0.05
	TIXLNG(4,I) = 0.05
	RCON(I) = 1.
	BASLOG(I) = 10.
	IFUNC(I) = 1
	IDISAB(I) = 7
C 
	DO 1250 J=1,NTLFOR
	TLFORM(J,I) = DTLFOR(J)
 1250	CONTINUE
	LTLFOR(I) = LDTLFO
C 
	DO 1260 J=1,4
	IDISAB(I) = 0
 1260	LPATTX(I,J) = -1
C 
 1270	CONTINUE
	IMODE(1) = 0
	IMODE(2) = 3
	IMODE(3) = 1
	IMODE(4) = 2
C 
C	INITIALIZE SECONDARY TAG GROUP 2
C 
	DO 1280 I=1,NPTAG3
	LTITL(I) = 0
 1280	CONTINUE
C 
C	INITIALIZE SECONDARY TAG GROUP 3
C 
	DO 1290 I=1,NPTAG4
	NIBPT4(I) = 1
	CPARAM(1,I) = 0.08
	CPARAM(2,I) = 0.08
	CPARAM(3,I) = 1.5*CPARAM(2,I)
	CPARAM(4,I) = 0.0
	CPARAM(5,I) = 0.0
 1290	CONTINUE
	CPARAM(1,1) = 0.2
	CPARAM(2,1) = 0.2
	CPARAM(3,1) = 0.3
	CPARAM(1,3) = 0.1
	CPARAM(2,3) = 0.1
	CPARAM(3,3) = 0.15
	GO TO 1010
C++++++++
C	LT:  TURN ON/OFF LISTING OF X,Y(USER SPACE)
C++++++++
 1300	DECODE (LSTRN0,8030,STRNG0,ERR=9070) KKK
	LISTXY = KKK.EQ.1
	DUMPXY = KKK.EQ.2
	LISTPD = KKK .AND. 4
	NLSTXY = .NOT.LISTXY
	GO TO 1010
C 
C====================================================================
C 
C	F-PHASE
C	INPUT INDIVIDUAL DATASET SPECIFICATIONS AND PARAMETERS
C 
C====================================================================
C 
C++++++++
C	ZF:  REMOVE ALL FILES FROM PHASE F
C++++++++
 1310	NFILE = 1
	KFILE = 1
	GO TO 1010
C 
C	INPUT NEXT COMMAND STRING FOR PHASE F
C 
 2070	NFM1 = KFILE - 1
	PPHASE = .FALSE.
	IF (.NOT.PROMPT) GO TO 2080
	WRITE(LUNTI,8520)NFM1,IPRMPT
	IPRMPT=0
 2080	READ(LUNPDL,8000,END=2431,ERR=9000)LSTRN0,STRNG0
	IF (LABORT) GO TO 2431
	LSTRN0 = MIN0(LSTRN0,NSTRN0)
	IF (LSTRN0 .EQ. 0) GOTO 2070
C 
C	SUPPORT TWO FILE FORMATS; 1) STANDARD PDL FILES WITH CARRIAGE CONTROL,
C	 AND 2) INDIRECT COMMAND FILES WITHOUT CARRIAGE CONTROL.  ASSUME THAT
C	 ANY LINE BEGINNING WITH A SPACE SHOULD BE INTERPRETTED AS A CARRIAGE
C	 CONTROL FORMATTED RECORD.
C 
	IFIRST = 1
	IF(STRNG0(1).NE."40)GO TO 2090
	IFIRST = 2
	LSTRN0 = LSTRN0-1
 2090	DECODE(LSTRN0,8010,STRNG0(IFIRST),ERR=9100)ICMD,LSTRN0,STRNG0
	IFIRST = 1
	LCOMM = ICMD .EQ. '; '
	IF (LCOMM .OR. LISTPD) WRITE (LUNTI,8550) ICMD,
	1(STRNG0(I),I=1,LSTRN0)
	IF (LCOMM) GO TO 2070
C 
C	IDENTIFY PRIMARY TAG
C 
 2100	CALL GETCMD (ICMD,IFTAG1,NFTAG1,NCMD1)
	IF (NCMD1 .EQ. 0) GO TO 9060
	IF (NFILE .GT. 1 .OR. ICMD .EQ. 'FN') GO TO 2105
	PPHASE = .TRUE.
	GO TO 9050
C 
C	COMPLETE INPUT
C 
 2105	GO TO (2110,2130,2150,2310,2200,2220,2230,1010,2510,2431,
	1      2240,2470,2490,1310, 110,2270,2280,2290,2300,2250,
	2      2320,1300,2480,2480,2340,2330,2160,2180,2433,2433,
	3      2350,2060, 120,2440,2450,2510,1225,2315,1226,2520,
	4      2316,2317,1228), NCMD1
C
C++++++++
C	FN:  INPUT DATASET SPECIFICATION FOR NEXT DATA FILE
C++++++++
 2110	IF (NFILE.LE.0) NFILE = 1
	IF (NFILE.GE.NTFIL) GO TO 9040
	NFILE = NFILE + 1
	KFILE = NFILE
	LSTRN0 = MIN0(LSTRN0,NFNAME)
	DO 2120 J=1,LSTRN0
	FNAME(J,NFILE) = STRNG0(J)
 2120	CONTINUE
	LFNAME(NFILE) = LSTRN0
C 
C	SET PARAMETERS TO THE VALUES USED FOR THE LAST FILE.
C	FILE 1 CONTAINS THE DEFAULT VALUES.
C 
	N1 = KFILE
	N2 = KFILE
	KK = NFILE - 1
	GO TO 2360
C++++++++
C	SF:  INPUT DATASET SCALE FACTORS
C++++++++
 2130	DECODE (LSTRN0,8020,STRNG0,ERR=9070) (SFA(K,KFILE),K=1,4)
	DO 2140 K=1,4
	IF (SFA(K,KFILE).EQ.0.0) SFA(K,KFILE) = 1.0
 2140	CONTINUE
	GO TO 2070
C++++++++
C	OF:  INPUT DATASET OFFSETS
C++++++++
 2150	DECODE (LSTRN0,8020,STRNG0,ERR=9070) (OFFA(K,KFILE),K=1,4)
	GO TO 2070
C++++++++
C	PS:  INPUT PRIMARY PLOT SYMBOL
C++++++++
 2160	LSTRN0 = MIN0 (LSTRN0,NPSYMB)
	DO 2170 I=1,LSTRN0
	PSYMBL(I,KFILE) = STRNG0(I)
 2170	CONTINUE
	LPSYMB(KFILE) = LSTRN0
	GO TO 2070
C++++++++
C	SS:  INPUT SECONDARY PLOT SYMBOL
C++++++++
 2180	LSTRN0 = MIN0 (LSTRN0,NSSYMB)
	DO 2190 I=1,LSTRN0
	SSYMBL(I,KFILE) = STRNG0(I)
 2190	CONTINUE
	LSSYMB(KFILE) = LSTRN0
	GO TO 2070
C++++++++
C	FM:  INPUT FORMAT OF DATA
C++++++++
 2200	LSTRN0 = MIN0(LSTRN0,NRDFOR)
	DO 2210 I=1,LSTRN0
 2210	RDFORM(I,KFILE) = STRNG0(I)
	LRDFOR(KFILE) = LSTRN0
	GO TO 2070
C++++++++
C	TG:  INPUT TAG FOR DATA TO BE PLOTTED
C++++++++
 2220	ITAGA(KFILE) = ICMD1
	GO TO 2070
C++++++++
C	IM:  SET INCREMENTAL MODE
C++++++++
 2230	DECODE (LSTRN0,8020,STRNG0,ERR=9070) XINIT(KFILE),XDELTA(KFILE)
	GO TO 2070
C++++++++
C	DF:  SET DATASET PARAMETERS TO DEFAULT
C++++++++
 2240	KK = 1
	N1 = KFILE
	N2 = KFILE
	GO TO 2360
C++++++++
C	CF:  CHANGE DATASET SPECIFICATION FOR CURRENT DATA FILE
C++++++++
 2250	LSTRN0 = MIN0(LSTRN0,NFNAME)
	DO 2260 J=1,LSTRN0
 2260	FNAME(J,KFILE) = STRNG0(J)
	LFNAME(KFILE) = LSTRN0
	GO TO 2070
C++++++++
C	GF:  REOPEN FILE KFILE
C++++++++
 2270	DECODE (LSTRN0,8030,STRNG0,ERR=9070) KFILE
	KFILE = KFILE + 1
	IF (KFILE.LE.1) KFILE = NFILE
	IF (KFILE.GT.NFILE) GO TO 9030
	GO TO 2070
C++++++++
C	XE:  INPUT DATAFILE X-EXTREMA
C++++++++
 2280	DECODE (LSTRN0,8020,STRNG0,ERR=9070) XFMINA(KFILE),XFMAXA(KFILE)
	GO TO 2070
C++++++++
C	YE:  INPUT DATAFILE Y-EXTREMA
C++++++++
 2290	DECODE (LSTRN0,8020,STRNG0,ERR=9070) YFMINA(KFILE),YFMAXA(KFILE)
	GO TO 2070
C++++++++
C	ND:  INPUT NUMBER OF POINTS TO SKIP BETWEEN CONSIDERED POINTS
C++++++++	     AND THE NUMBER OF POINTS PER LINE
C 
 2300	DECODE (LSTRN0,8030,STRNG0,ERR=9070) NUMPP,IDEL
	IF (NUMPP.LE.0) NUMPP = 1
	NUMPPL(KFILE) = NUMPP
	IF (IDEL.LE.0) IDEL = 1
	IDELTA(KFILE) = IDEL
	GO TO 2070
C++++++++
C	BG:  INPUT BAR GRAPH PARAMETERS
C++++++++
 2310	DECODE (LSTRN0,8075,STRNG0,ERR=9070)
	1		DXHIST(KFILE),BGBASE(KFILE),KBGOPN(KFILE)
	GO TO 2070
C++++++++
C	BL:  INPUT BAR GRAPH AND LINE PLOT LINE PARAMETERS
C++++++++
 2315	DECODE (LSTRN0,8060,STRNG0,ERR=9070) NIBHS(KFILE),LPATHS(KFILE)
	GO TO 2070
C++++++++
C	BS:  input Bar graph Shading parameters
C++++++++
 2316	DECODE (LSTRN0,8045,STRNG0,ERR=9070) KBGSHD(KFILE),BSDIST(KFILE)
	GOTO 2070
C+++++++
C	SL: input Shading Line types for bar graphs
C+++++++
 2317	DECODE (LSTRN0,8060,STRNG0,ERR=9070) NIBBS(KFILE),LPATBS(KFILE)
	GOTO 2070
C++++++++
C	RF:  REMOVE FILE FROM PHASE F
C++++++++
 2320	DECODE (LSTRN0,8030,STRNG0,ERR=9070) N1
	N1 = N1 + 1
	IF (N1.GT.NFILE) GO TO 9030
	IF (N1.LE.1) GO TO 9030
	NFILE = NFILE - 1
	IF (NFILE .LE. 1) GO TO 1010
	KFILE = NFILE
	N2 = KFILE
	GO TO 2360
C++++++++
C	FS:  ASSOCIATE DATA WITH APPROPRIATE DATA SPACE
C++++++++
 2330	DECODE (LSTRN0,8030,STRNG0,ERR=9070) I1,I2
	IF (I1.EQ.0) I1 = 1
	IF (I2.EQ.0) I2 = 1
	KSPACE(1,KFILE) = I1
	KSPACE(2,KFILE) = I2
	GO TO 2070
C++++++++
C	FF:  PLOT FUNCTIONS FOR THIS FILE
C++++++++
 2340	DECODE (LSTRN0,8030,STRNG0,ERR=9070) I1,I2
	IF (I1.EQ.0) I1 = 1
	IF (I2.EQ.0) I2 = 1
	KFUNCT(1,KFILE) = I1
	KFUNCT(2,KFILE) = I2
	GO TO 2070
C++++++++
C	FT:  INPUT PLOT TYPE FOR THIS FILE
C++++++++
 2350	DECODE (LSTRN0,8030,STRNG0,ERR=9070)KPLTYP(KFILE)
	1,ISDELT(KFILE),ISINIT(KFILE)
	GO TO 2070
C 
C----------------------------------------------------------------------
C 
C	SET F-PHASE PARAMETERS
C 
C----------------------------------------------------------------------
C 
 2360	DO 2430 KKK =N1,N2
	IF ((ICMD .NE. 'RF') .AND. (ICMD .NE. 'rf') .AND.
	1   (ICMD .NE. 'Rf') .AND. (ICMD .NE. 'rF')) GO TO 2380
	KK = KKK + 1
	LL = LFNAME(KK)
	DO 2370 J=1,LL
 2370	FNAME(J,KKK) = FNAME(J,KK)
	LFNAME(KKK) = LFNAME(KK)
 2380	IDELTA(KKK) = IDELTA(KK)
	ISDELT(KKK) = ISDELT(KK)
	ISINIT(KKK) = ISINIT(KK)
	XFMINA(KKK) = XFMINA(KK)
	XFMAXA(KKK) = XFMAXA(KK)
	YFMINA(KKK) = YFMINA(KK)
	YFMAXA(KKK) = YFMAXA(KK)
	NUMPPL(KKK) = NUMPPL(KK)
	ITAGA(KKK)  = ITAGA(KK)
	XDELTA(KKK) = XDELTA(KK)
	XINIT(KKK)  = XINIT(KK)
	KFUNCT(1,KKK) = KFUNCT(1,KK)
	KFUNCT(2,KKK) = KFUNCT(2,KK)
	KSPACE(1,KKK) = KSPACE(1,KK)
	KSPACE(2,KKK) = KSPACE(2,KK)
	KPLTYP(KKK) = KPLTYP(KK)
	DXHIST(KKK) = DXHIST(KK)
	BGBASE(KKK) = BGBASE(KK)
	KBGOPN(KKK) = KBGOPN(KK)
	NIBHS(KKK) = NIBHS(KK)
	LPATHS(KKK) = LPATHS(KK)
	KBGSHD(KKK) = KBGSHD(KK)
	BSDIST(KKK) = BSDIST(KK)
	NIBBS(KKK) = NIBBS(KK)
	LPATBS(KKK) = LPATBS(KK)
C 
	LL = LRDFOR(KK)
	DO 2390 J=1,LL
 2390	RDFORM(J,KKK) = RDFORM(J,KK)
	LRDFOR(KKK) = LRDFOR(KK)
C 
	LL = LSSYMB(KK)
	DO 2400 J=1,LL
 2400	SSYMBL(J,KKK) = SSYMBL(J,KK)
	LSSYMB(KKK) = LSSYMB(KK)
C 
	LL = LPSYMB(KK)
	DO 2410 I=1,LL
	PSYMBL(I,KKK) = PSYMBL(I,KK)
 2410	CONTINUE
	LPSYMB(KKK) = LPSYMB(KK)
C 
	DO 2420 K=1,4
	SFA(K,KKK) = SFA(K,KK)
	OFFA(K,KKK) = OFFA(K,KK)
 2420	CONTINUE
C 
 2430	CONTINUE
	GO TO 2070
C 
C---------------------------------------------------------------------
C 
C	EOF FOR PDL
C 
C--------------------------------------------------------------------
C 
 2431	IF (PROMPT) STOP
	LABORT = .FALSE.
	CLOSE (UNIT=LUNPDL)
	IF (PFILE2) GO TO 2432
	PFILE1 = .FALSE.
	LUNPDL = LUNTI
	PROMPT = .TRUE.
	IPRMPT = BELL
	GO TO 1010
 2432	PFILE2 = .FALSE.
	LUNPDL = LUNPD1
	GO TO 1010
C 
C--------------------------------------------------------------------
C 
C	STOP
C 
C--------------------------------------------------------------------
C 
C++++++++
C	HA:  HALT
C++++++++
 2433	STOP 'MULPLT'
C 
C--------------------------------------------------------------------
C 
C	W>, N>: SPAWN OTHER TASKS
C 
C--------------------------------------------------------------------
C 
 2440	ISYNCH = 1
	GO TO 2460
 2450	ISYNCH = 0
 2460	CALL KBCKOF
	CALL FORMCR (STRNG0,IEMCRW,ISYNCH,LSTRN0)
	CALL KBCKON (5,ICHART,ICHARF,LFLAG)
	IF (IEMCRB .LT. 0) GO TO 9010
	IF (PROMPT) IPRMPT = BELL
	GO TO 1010
C 
C======================================================================
C 
C	DP: DUMP THE PDL
C 
C======================================================================
C 
 2470	IPHASE = NPDUMP
	JFILE = 0
	RETURN
C 
C======================================================================
C 
C	LI:, PR: LIST THE PDL
C 
C======================================================================
C 
 2480	IPHASE = NPDUMP
	GO TO 2500
C 
C======================================================================
C 
C	GO TO SCAN PHASE
C 
C======================================================================
C 
 2490	IPHASE = NPSCAN
 2500	DECODE (LSTRN0,8030,STRNG0,ERR=9070) JFILE,JFILE1
	RETURN
C 
C======================================================================
C 
C	GO TO PLOT PHASE
C 
C======================================================================
C 
 2510	JFILE  = 0
	JFILE1 = 0
	IF (LSTRN0 .LE. 0) GOTO 2515
	DECODE (LSTRN0,8030,STRNG0,ERR=9070) IDEV,JFILE,JFILE1
 2515	CALL VECTOR(X,Y,-5)			! ask VECTOR if a valid device
	IF (X .LE. 0) GOTO 1226			! invalid - do a G? for us
	IF (IDEV .GT. 0) CALL ASSIGN(LUNGRP,GDDEVN(1,IDEV)) ! assign the device
	IPHASE = NPPLOT
	INITPL = (ICMD .EQ. 'GE') .OR. (ICMD .EQ. 'ge') .OR.
	1	 (ICMD .EQ. 'Ge') .OR. (ICMD .EQ. 'gE') .OR.
	2	((JFILE .EQ.  0) .AND. (JFILE1 .EQ. 0))
	RETURN
C
C======================================================================
C
C	?? help commands
C
C======================================================================
C
2520	CALL KBCKOF
	IF (LSTRN0 .GT. 68) LSTRN0 = 68
	LSTRN0 = LSTRN0 + 12
	IF (LSTRN0 .EQ. 12) GOTO 2535		! no subtopic specified
	DO 2530 I=LSTRN0,13,-1
	STRNG0(I) = STRNG0(I-12)		! make room ...
2530	CONTINUE
2535	DO 2540 I=1,12
	STRNG0(I) = QHELP(I)			! add in the 'HELP MULPLT'
2540	CONTINUE
	CALL FORMCR(STRNG0,IEMCRW,1,LSTRN0)	! get the help
C	and get back to serious MULPLTing
	CALL KBCKON(5,ICHART,ICHARF,LFLAG)
	IF (IEMCRB .LT. 0) GOTO 9010
	IF (PROMPT) IPRMPT = BELL
	GOTO 1010
C 
C----------------------------------------------------------------------
C 
C	ERROR HANDLER
C 
C----------------------------------------------------------------------
C 
 9000	IERR1 = IERR1 + 1
 9010	IERR1 = IERR1 + 1
 9020	IERR1 = IERR1 + 1
 9030	IERR1 = IERR1 + 1
 9040	IERR1 = IERR1 + 1
 9050	IERR1 = IERR1 + 1
 9060	IERR1 = IERR1 + 1
 9070	IERR1 = IERR1 + 1
 9080	IERR1 = IERR1 + 1
 9090	IERR1 = IERR1 + 1
 9100	IERR1 = IERR1 + 1
 9110	IERR1 = IERR1 + 1
	CALL ERRPRT ('  MPREAD',IERR1,1,ERRMSG(1,IERR1))
	IERR1 = 0
	IF (NEWPL) GO TO 1230
	IF (PPHASE) GO TO 9120
	WRITE (LUNEL,8530) KFILE-1,ICMD,(STRNG0(J),J=IFIRST,LSTRN0)
	GO TO 2070
 9120	WRITE (LUNEL,8540) ICMD,(STRNG0(J),J=IFIRST,LSTRN0)
	GO TO 1010
 9130	DO 9135 I=1,32
	IF (GDDEV0(I) .EQ. 0) GOTO 9140
 9135	CONTINUE
	I = 33
 9140	WRITE (LUNEL,8560) (GDDEV0(J),J=1,I-1)
	GOTO 1010
C 
C----------------------------------------------------------------------
C 
C	FORMAT STATEMENTS
C 
C----------------------------------------------------------------------
C 
 8000	FORMAT (Q,82A1)
 8010	FORMAT (A2,Q,82A1)
 8020	FORMAT (4E14.0)
 8030	FORMAT (4I7)
 8040	FORMAT (I7,3E14.0)
 8045	FORMAT (O7,E14.0)
 8050	FORMAT (4O7)
 8060	FORMAT (I7,O7)
 8070	FORMAT (2E14.0,I7,E14.0)
 8075	FORMAT (2E14.0,O7)
 8080	FORMAT (O7,2I7,E14.0)
C 
 8500	FORMAT (/' MULPLT Version ',A8/)
 8510	FORMAT (/'$P:',A1)
 8520	FORMAT (/'$F',I2,':',A1)
 8530	FORMAT ('  ?->F',I2,':',A2,80A1)
 8540	FORMAT ('  ?->P:',A2,80A1)
 8550	FORMAT (1X,A2,80A1)
 8560	FORMAT ('0MPREAD error opening binary vector output file: ',32A1)
	END