PDP-10 Archive: decus/20-0054/flmon.for from decuslib20-02

Trailing-Edge - PDP-10 Archives - decuslib20-02 - decus/20-0054/flmon.for
There is 1 other file named flmon.for in the archive. Click here to see a list.
C	EXECUTIVE PROGRAM FOR PIPING DIAGRAM PLOT ROUTINES
C
	COMMON XSC,YSC
	COMMON ICOM(3),ARRAY(4),IARAY(4),IDENT(5),IHDNG(8)
	EQUIVALENCE (ARRAY(1),X,X1,XLL),(ARRAY(2),Y,Y1,YLL),
     *(ARRAY(3),X2,W),(ARRAY(4),Y2,H),(IARAY(1),IND,I1),
     *(IARAY(2),I2),(IARAY(3),I3),(IARAY(4),I4),(ICOM(1),IC)
	LUNO = 3
	CALL IFILE (2,'FLMON')
C
C	CONSTANTS FOR IMPLEMENTED COMMANDS
C
	IEN=5HEND  
	IPI=5HPIPE 
	IVA=5HVALVE
	ICH=5HCHECK
	IVE=5HVESSE
	ICO=5HCOMME
	ISC=5HSCALE
	IFL=5HFLANG
	IOR=5HORIFI
	IBO=5HBORDE
	ILA=5HLABEL
C
	XSC = 1.
	YSC = 1.
	CALL PLOTS(I)
	READ (2,99) IHDNG,IPRNT
99	FORMAT (8A5,I1)
	IF(IPRNT.EQ.1)GO TO 1
	WRITE (LUNO,100)IHDNG
1	READ (2,101)ICOM,ARRAY,IARAY,IDENT
100	FORMAT('1INPUT TO PIPE SCHEMATIC PROGRAM'//2H  ,8A5/)
101	FORMAT(2A5,A2,4F6.2,4I2,5A5)
C
C	CHECK FOR VALID COMMAND
C
	IF(IC.EQ.IEN)GO TO 50
	IF(IC.EQ.IPI)GO TO 20
	IF(IC.EQ.IVA)GO TO 30
	IF(IC.EQ.ICH)GO TO 40
	IF (IC.EQ.IVE)GO TO 10
	IF (IC.EQ.ICO)GO TO 74
	IF(IC.EQ.ISC)GO TO 45
	IF (IC.EQ.IFL)GO TO 70
	IF(IC.EQ.IOR)GO TO 71
	IF (IC.EQ.IBO)GO TO 10
	IF(IC.EQ.ILA)GO TO 73
C
	WRITE(LUNO,103)ICOM
103	FORMAT(2A5,A2,6X,'INVALID COMMAND')
	GO TO 1
70	IF(IPRNT.EQ.1)GO TO 271
	WRITE (LUNO,109)ICOM,X,Y,I1,IDENT
109	FORMAT(' ',2A5,A2,2F6.2,12X,I2,6X,5A5)
271	CALL FLANG(X,Y,I1)
	GO TO 1
71	IF(IPRNT.EQ.1)GO TO 272
	WRITE (LUNO,109)ICOM,X,Y,I1,IDENT
272	CALL ORIF (X,Y,I1)
	GO TO 1
73	IF(IPRNT.EQ.1)GO TO 274
	WRITE (LUNO,106)ICOM,X,Y,X2,IDENT
106	FORMAT(' ',2A5,A2,3F6.2,14X,5A5)
274	CALL LABEL(X,Y,X2,IDENT)
	GO TO 1
74	IF(IPRNT.EQ.1)GO TO 1
	WRITE(5,107) ICOM,IDENT
	WRITE(LUNO,107)ICOM,IDENT
107	FORMAT('0',2A5,A2,5A5)
	GO TO 1
10	IF(IPRNT.EQ.1)GO TO 210
	WRITE(LUNO,104)ICOM,ARRAY,I1,IDENT
104	FORMAT(' ',2A5,A2,4F6.2,I2,6X,5A5)
210	CALL VESL(XLL,YLL,W,H,IND,IDENT)
	GO TO 1
20	IF(IPRNT.EQ.1)GO TO 221
	WRITE(LUNO,104)ICOM,ARRAY,I1,IDENT
221	CALL PIPE(X1,Y1,X2,Y2,I1)
	GO TO 1
30	IF(IPRNT.EQ.1)GO TO 231
	WRITE(LUNO,105)ICOM,ARRAY,IARAY,IDENT
105	FORMAT(' ',2A5,A2,4F6.2,4I2,5A5)
231	CALL VALVE(X,Y,W,H,I1,I2,I3,I4)
	GO TO 1
40 	IF(IPRNT.EQ.1)GO TO 241
	WRITE(LUNO,109)ICOM,X,Y,IND,IDENT
241	CALL CHKV(X,Y,IND)
	GO TO 1
45	IF(IPRNT.EQ.1)GO TO 246
	WRITE(LUNO,108)ICOM,ARRAY,IDENT
108 	FORMAT(' ',2A5,A2,4F6.2,8X,5A5)
246	XSC=X1
	YSC=Y1
	GO TO 1
50	IF(IPRNT.EQ.1)GO TO 251
	WRITE(LUNO,107)ICOM,IDENT
251	CALL EXIT
	END
	SUBROUTINE ORIF (X,Y,I)
C
C	DRAWS AN ORIFICE CENTERED AT (X,Y)
C	I= 0-HORIZONTAL, 1-VERTICAL
C
	COMMON XSC,YSC
	SIGN = 1.
	IF (I) 4,1,2
1	YINC=0.05
	XINC=0.
	GO TO 3
2	YINC = 0.
	XINC = 0.05
3	YP = Y+YINC*SIGN
	XP = X+XINC*SIGN
	CALL FPLOT (XP,YP,3)
	YP = YP+YINC*SIGN
	XP = XP+XINC*SIGN
	CALL FPLOT (XP,YP,2)
	IF (SIGN) 5,5,4
4	SIGN = -1.
	GO TO 3
5	CALL FLANG (X,Y,I)
	RETURN
	END
	SUBROUTINE PIPE (X1,Y1,X2,Y2,I1)
C
C	DRAWS A PIPE FROM (X1,Y1) TO (X2,Y2)
C
	COMMON XSC,YSC
	CALL FPLOT (X1,Y1,3)
	IF (I1-1) 1,2,3
2	CALL FPLOT (X2,Y1,2)
4	CALL FPLOT (X2,Y2,2)
	GO  TO 5
3	CALL FPLOT (X1,Y2,2)
	GO TO 4
1	CONTINUE
5	CALL FPLOT (X2,Y2,2)
	RETURN
	END
	SUBROUTINE CHKV(X,Y,IND)
C	DRAWS CHECK VALVES,CENTERED AT
C	(X,Y) IND= 0-HORIZONTAL, 1-VERTICAL
C
	DIMENSION BCD(1)
	COMMON XSC,YSC
	XA = 0.2*XSC
	IF(IND) 10,10,20
10	XS = X-0.1
	YS = Y-0.1
	BCD(1)=1HN
	CALL SYMBOL(XS,YS,XA,BCD,0.,1)
	RETURN
20	XS = X-0.1
	YS = Y-0.1
	BCD(1)=1HZ
	CALL SYMBOL(XS,YS,XA,BCD,0.,1)
	RETURN
	END
	SUBROUTINE CIRC (X1,Y1,X2,Y2)
C	DRAWS A CIRCLE OF RADIUS R CENTERED AT
C	(XC,YC) FROM (X1,Y1) CLOCKWISE TO (X2,Y2)
C
	COMMON XSC,YSC
	CALL FPLOT (X1,Y1,3)
	CALL FPLOT (X1,Y1,2)
	IF (X1-X2) 20,10,20
10	YDEL = (Y2-Y1)/25.
	SIGN = -YDEL/ABS(YDEL)
	YH = (Y2-Y1)/2.
	XC = X1+YH
	YC = Y1+YH
	R = SQRT(2.*YH*YH)
	Y=Y1
	DO 15 I=1,25
	Y = Y+YDEL
	X=SQRT(R*R-(Y-YC)*(Y-YC))*SIGN+XC
	CALL FPLOT (X,Y,1)
15	CONTINUE
	CALL FPLOT (X,Y,3)
	RETURN
20	XDEL =(X2-X1)/25.
	SIGN = XDEL/ABS(XDEL)
	XH = (X2-X1)/2.
	XC = X1+XH
	YC = Y1-XH
	R = SQRT(2.*XH*XH)
	X = X1
	DO 25 I=1,25
	X = X+XDEL
	Y = SQRT(R*R-(X-XC)*(X-XC))*SIGN+YC
	CALL FPLOT (X,Y,1)
25	CONTINUE
	CALL FPLOT (X,Y,3)
	RETURN
	END
	SUBROUTINE FLANG(X,Y,I)
C	DRAWS A FLANGE CENTERED AT (X,Y),
C	I = 0-HORIZONTAL, 1-VERTICAL
C
	COMMON XSC,YSC
	FINC = .10
	SIGN = 1.
5	IF(I) 4,1,2
1	XP = X+FINC*SIGN/2.
	YP = Y+FINC
	XF = XP
	YF = Y-FINC
	GO TO 3
2	XP = X+FINC
	YP = Y+FINC*SIGN/2.
	XF = X-FINC
	YF = YP
3	CALL FPLOT(XP,YP,3)
	CALL FPLOT(XF,YF,2)
	IF(SIGN) 4,4,6
6	SIGN = -1.
	GO TO 5
4	CALL FPLOT(X,Y,3)
	RETURN
	END
	SUBROUTINE LABEL (X,Y,CHRSZ,IDENT)
C	LABELS DRAWN IN LETTERS OF SIZE CHRSZ WHERE
C	(X,Y) IS THE  CO-ORDINATES OF THE
C	LOWER LEFT CORNER OF THE FIRST LETTER AND
C	IDENT IS THE 36-CHARACTER MESSAGE
C
	DIMENSION IDENT(5)
	COMMON XSC,YSC
	IBLNK = 5H     
	DO 1 I=1,5
	J=6-I
	IF(IDENT(J).NE.IBLNK)GO TO 3
1	CONTINUE
	RETURN
3	J = 5*J
	CALL SYMBOL(X,Y,CHRSZ,IDENT,0.,J)
	RETURN
	END
	SUBROUTINE VALVE (X,Y,W,H,I1,I2,I3,I4)
C
C	DRAWS VALVE SECTIONS POINTING TO (X,Y) BY QUADRANT
C	BASED ON (IN)
C	I(N) = 0-NOTHING. 1-POINTER, 2-STEM
C
	COMMON XSC,YSC
	X1 = X+.15
	X2=X-.05
	X3=X+.10
	X4=X+.05
	X5=X-.15
	X7=X-.10
	Y1=Y+.05
	Y2=Y+.15
	Y3=Y-.05
	Y4=Y+.10
	Y6=Y-.15
	Y8=Y-.10
	CALL FPLOT (X,Y,3)
	CALL FPLOT (X,Y,0)
	CALL FPLOT (X,Y,2)
	IF(I1-1)3,2,1
1	CALL FPLOT (X1,Y,1)
	CALL FPLOT (X1,Y1,1)
	CALL FPLOT (X1,Y3,1)
	CALL FPLOT (X1,Y,1)
	CALL FPLOT (X,Y,1)
	GO TO 3
2	CALL FPLOT (X3,Y1,1)
	CALL FPLOT (X3,Y3,1)
	CALL FPLOT (X,Y,1)
	IF ( W - .01) 3,3,25
25	CALL FPLOT ( X3,Y,3)
	X9 = X3 +W
	CALL FPLOT (X9,Y,2)
	CALL FPLOT (X,Y,3)
	CALL FPLOT (X,Y,2)
3	IF(I2-1)6,5,4
4	CALL FPLOT (X,Y2,2)
	CALL FPLOT (X2,Y2,2)
	CALL FPLOT (X4,Y2,1)
	CALL FPLOT (X,Y2,1)
	CALL FPLOT (X,Y,2)
	GO TO 6
5	CALL FPLOT (X2,Y4,1)
	CALL FPLOT (X4,Y4,1)
	CALL FPLOT (X,Y,1)
	IF(H - .01) 6,6,55
55	CALL FPLOT (X,Y4,3)
	Y9=Y4 + H
	CALL FPLOT (X,Y9,2)
	CALL FPLOT (X,Y,3)
	CALL FPLOT (X,Y,2)
6	IF(I3-1)9,8,7
7	CALL FPLOT (X5,Y,1)
	CALL FPLOT (X5,Y3,1)
	CALL FPLOT (X5,Y1,1)
	CALL FPLOT (X5,Y,1)
	CALL FPLOT (X,Y,1)
	GO TO 9
8	CALL FPLOT (X7,Y1,1)
	CALL FPLOT (X7,Y3,1)
	CALL FPLOT (X,Y,1)
	IF( W - .01) 9,9,85
85	CALL FPLOT (X7,Y,3)
	X8 = X7 - W
	CALL FPLOT (X8,Y,2)
	CALL FPLOT (X,Y,3)
	CALL FPLOT (X,Y,2)
9	IF (I4 - 1)12,11,10
10	CALL FPLOT (X,Y6,1)
	CALL FPLOT (X4,Y6,1)
	CALL FPLOT (X2,Y6,1)
	CALL FPLOT (X,Y6,1)
	CALL FPLOT (X,Y,1)
	GO TO 12
11	CALL FPLOT (X2,Y8,1)
	CALL FPLOT (X4,Y8,1)
	CALL FPLOT (X,Y,1)
	IF( H - .01) 12,12,95
95	CALL FPLOT (X,Y8,3)
	Y7 = Y8 - H
	CALL FPLOT (X,Y7,2)
	CALL FPLOT (X,Y,3)
	CALL FPLOT (X,Y,2)
12	CONTINUE
	CALL FPLOT (X,Y,3)
	RETURN
	END
	SUBROUTINE VESL(XLL,YLL,W,H,IND,IDENT)
C
C	DRAWS A VESSEL OF HEIGHT H AND WIDTH W WITH LOWER
C	LEFT CORNER AT (XLL,YLL) WITH THE OPTION OF DRAWING AN ARC
C	OVER ANY SIDE.
C	IND = 0-NONE. 1-RIGHT, 2-TOP, 3-LEFT, 4-BOTTOM,
C		5-RIGHT+LEFT, 6-TOP+BOTTOM
C	LETTERS REMARKS FIELD CENTERED IN VESSEL FROM
C	FIRST NON-BLANK CHARACTER TO LAST NON-BLANK CHARACTER
C	OF FIELD.  IF FIRST TWO CHARACTERS ARE NON-BLANK.
C
	DIMENSION IDENT (5)
	COMMON XSC,YSC
	IBLNK = 5H     
	XA = 0.1*XSC
	XC = XLL + .5 * W
	YC = YLL + .5 * H
	CALL FPLOT (XLL,YLL,3)
	CALL FPLOT (XLL,YLL,2)
	X = XLL + W
	CALL FPLOT (X,YLL,1)
	Y = YLL + H
	CALL FPLOT (X,Y,1)
	CALL FPLOT (XLL,Y,1)
	CALL FPLOT (XLL,YLL,1)
	CALL FPLOT (XLL,YLL,3)
C	LABELS VESSEL
	IF (IDENT(1) .EQ. IBLNK)   GO TO 20
	DO 22 I= 1,5
	J =6-I
	IF (IDENT(J) .NE. IBLNK) GO TO 23
22	CONTINUE
	GO TO 20
23	CH = J*5
	IF (W - XA * CH - .1) 12,25,25
12	IF (H - W) 25,25,26
C	VERTICAL LETTERING
26	YLFT = YC - .5*CH*XA
	XLFT = XC
	ROT =90.
	GO TO 27
C	HORIZONTAL LABEL
25	XLFT = XC - .5*CH*XA
	YLFT = YC
	ROT = 0.
27	J=CH
	CALL SYMBOL(XLFT,YLFT,XA,IDENT,ROT,J)
C************************************************
C	CHANGE FOR PDP-10 OUTPUT DEVICE
C************************************************
20 	IF (IND) 10,15,10
10	 GO TO (1,2,3,4,1,2), IND
1	CALL CIRC ( X,Y,X,YLL)
	IF (IND - 5) 15,3,15
2	CALL CIRC (XLL,Y,X,Y)
	IF ( IND - 6) 15,4,15
3	CALL CIRC(XLL,YLL,XLL,Y)
	GO TO 15
4	CALL CIRC (X,YLL,XLL,YLL)
15	RETURN
	END
	SUBROUTINE FPLOT(A,B,N)
	COMMON XSC,YSC
	X = XSC * A
	Y = YSC * B
	CALL PLOT(X,Y,N)
	RETURN
	END