C* FPARS		SPECIAL FILE PARSE
C
C	SUBROUTINE FPARS(LUN,CIV,IPT,CDEFS,NER,CRETV,NCRET)
C
C	WHERE -
C		LUN	= LOGICAL UNIT NUMBER  -  INPUT
C		CIV	= FILE NAME TO OPEN (ANY OR ALL PARTS OF A FILE-SPEC
C			  MAY BE SUPPLIED.  -  INPUT
C		IPT	= POINTS TO START OF STRING IN BNAM.
C			  IPT>0	- IPT UPDATED TO END OF SCAN ON RETURN
C			  *** IMPORTANT - DO NOT USE A CONSTANT! ***
C		CDEFS	= DEFAULT FILE SPEC (ANY OR ALL PARTS OF FILE-SPEC
C			  ARE VALID AS IN CIV.  -  INPUT
C		NER	= ERROR CODE.
C			  NER=0 , NO ERROR
C			  NER<0 , FCS ERROR RETURN CODE
C			  NER>0 , FPARS ERROR CODE
C
C		CRETV	= BYTE ARRAY CONTAINING COMPLETE FILESPEC,
C			  CREATED FROM CIV, CDEFS AND SYSTEM DEFAULT
C			  - OUTPUT
C
C		NCRET	= NUMBER OF CHARACTERS OF FILESPEC IN CRETV
C			  - OUTPUT
C
C	**NOTES**
C		1) SCAN OF CIV AND CDEFS ARE TERMINATED BY FIRST OCCURANCE OF
C		   BLANK, TAB, EQUAL SIGN, ZERO BYTE.
C
C-
	SUBROUTINE FPARS(LUN,CIV,IPT,CDEFS,NER,CRETV,NCRET)
	IMPLICIT LOGICAL * 1 (C)
	DIMENSION CIV(1),CDEFS(1),IDFNB(30),ICSI(1),CRETV(1)
	DIMENSION IDSD(6),IFNMV(6)
CC6	10/23/77  CSIFPC.COM	USED FOR CSIFP COMMUNICATION
	COMMON /CSISPF/ ISTAT,ICMLD(2),IDEVD(2),IDIRD(2)
	COMMON /CSISPF/ IFILD(2),ISWAD,IMKW1,IMKW2,IFILLX(10)
C
	COMMON /CSIDEF/ LEQU,LNMF,LDIF,LDVF,LWLD,LMOR,ICSSZ
CE
	EQUIVALENCE (ISTAT,ICSI)
	DATA NWFNB,NFNAM,NFTYP/30,4,7/
	DATA C0CH,CPERC/'0','.'/,CBLNK/' '/
C
	NCRET = 0
	DO 10 I = 1,ICSSZ	!CLEAR CSI BLOCK
10	ICSI(I) = 0
	DO 20 I = 1,NWFNB	!CLEAR DFNB
20	IDFNB(I) = 0
C
C		DEFAULT STRING PRESENT?
C
	IF(CDEFS(1) .EQ. 0 .OR. CDEFS(1) .EQ. CBLNK) GO TO 100
	IF(LUN .LE. 0) GO TO 100
	IP = 1
	CALL CSIFP(CDEFS,IP,ISTAT,NER)	!PARSE DEFAULT STRING
	IF(NER .NE. 0) GO TO 910
	ISAV = ISTAT
	DO 40 I = 1,6
40	IDSD(I) = IDEVD(I)
C
C		FILE NAME STRING IN DEFAULT STRING?
C
	IF(IAND(LNMF,ISTAT) .EQ. 0) GO TO 100	!NO
	ISTAT = IEOR(LNMF,ISTAT)	!TURN FLAG OFF
	CALL GETADR(IAD,CDEFS)		!GET ADDR OF STRING
	IP =IFILD(2) - IAD  + 1	!ADDR OF FILE NAME STRING
	CALL FPARS1(CDEFS,IP,IFILD(1),IFNMV)
	NC = IFNMV(1)
	IF(NC .LE. 0) GO TO 80
	CALL IRAD50(NC,CDEFS(IFNMV(2)),IDFNB(NFNAM))
80	CONTINUE
	NC = IFNMV(3)
	IF(NC .LE. 0) GO TO 100
	CALL IRAD50(NC,CDEFS(IFNMV(4)),IDFNB(NFTYP))
100	CONTINUE
C
C		PARSE INPUT STRING
C
	CALL CSIFP(CIV,IPT,ISTAT,NER)
	IF(NER .NE. 0) GO TO 900
	IF(IAND(LDVF,ISTAT) .NE. 0) GO TO 120
	IF(IAND(LDVF,ISAV) .EQ. 0) GO TO 120
	IDEVD(1) = IDSD(1)
	IDEVD(2) = IDSD(2)
120	CONTINUE
	IF(IAND(LDIF,ISTAT) .NE. 0) GO TO 140
	IF(IAND(LDIF,ISAV) .EQ. 0) GO TO 140
	IDIRD(1) = IDSD(3)
	IDIRD(2) = IDSD(4)
140	CONTINUE
	IF(LUN .LE. 0) GO TO 990	!ONLY WANTS PARSE
	CALL FPARS2(LUN,IDEVD,IDFNB,NER)	!FINISH PARSE
	CALL FFNAM(LUN,CRETV,NCRET)
	GO TO 990
900	CONTINUE
	NER = NER + 1000
910	CONTINUE
	NER = NER + 1000
990	CONTINUE
	RETURN
	END
C FPARS1	PARSE FILE NAME STRING INTO NAME,TYPE & VERSION
	SUBROUTINE FPARS1(CIV,IPT,NC,IFNMV)
	IMPLICIT LOGICAL * 1 (C)
	DIMENSION CIV(1),IFNMV(6)
	DATA CPERC,CSEMIC/'.',';'/
C
C		CLEAR FILE NAME CTL BLOCK
C
	DO 10 I = 1,6
10	IFNMV(I) = 0 
	MXP1 = IPT + NC		!END PTR
	MXP = MXP1 - 1
	IF(MXP .LT. IPT) GO TO 900
	DO 20 IPERP = IPT,MXP
	IF(CIV(IPERP) .EQ. CPERC) GO TO 40
	IF(CIV(IPERP) .EQ. CSEMIC) GO TO 30
20	CONTINUE
	ISEMIP = MXP1
	IPERP = MXP1
	GO TO 100
30	CONTINUE
	ISEMIP = IPERP
	IPERP = MXP1
	GO TO 100
40	CONTINUE
	I = IPERC + 1
	IF(I .GT. MXP) GO TO 60
	DO 50 ISEMIP = I,MXP
	IF(CIV(ISEMIP) .EQ. CSEMIC) GO TO 100
50	CONTINUE
60	ISEMIP = MXP1
100	CONTINUE
	I = MIN0(IPERP,ISEMIP) - IPT
	IF(I .LE. 0) GO TO 120
	IFNMV(1) = I
	IFNMV(2) = IPT
120	CONTINUE
	IF(IPERP .GE. MXP1) GO TO 140
	IFNMV(3) = ISEMIP - IPERP - 1
	IFNMV(4) = IPERP + 1
140	CONTINUE
	IF(ISEMIP .GE. MXP1) GO TO 900
	IFNMV(5) = MXP - ISEMIP
	IFNMV(6) = ISEMIP + 1
900	CONTINUE
	RETURN
	END