PDP-10 Archive: decus/20-0137/csmp/csmp2.for from decus_20tap5

Trailing-Edge - PDP-10 Archives - decus_20tap5_198111 - decus/20-0137/csmp/csmp2.for

There is 1 other file named csmp2.for in the archive. Click here to see a list.

	SUBROUTINE CSM4
C	INITIAL CONDITIONS AND PARAMETERS
	INTEGER TEST2,TEST9
	LOGICAL RSAC
	DIMENSION MTRX1(75),PAR(75,3)
	COMMON REALS(395),INTS(547)
	COMMON/NOPR/INPVAR
	EQUIVALENCE (INTS(1),MTRX1(1))
	EQUIVALENCE (INTS(526),TEST2),(INTS(533),TEST9)
	EQUIVALENCE (REALS(81),PAR(1,1))
C	GET INPUT UNIT TEST2
	IF(INPVAR.NE.-1)WRITE(30,10)
10	FORMAT(/10X,29HINITIAL CONDITIONS/PARAMETERS/)
	IF (TEST2.EQ.5) GO TO 40
C	NON-TTY INPUT
	IF(INPVAR.NE.-1)WRITE(30,30)
30	FORMAT(6H BLOCK,3X,7HIC/PAR1,8X,4HPAR2,10X,4HPAR3)
	GO TO 60
C	TTY INPUT
40	WRITE(30,50)
50	FORMAT(27H BLOCK, IC/PAR1, PAR2, PAR3/)
C	INPUT STATEMENTS
60	I=KINPUT(0,IERR)
	IF (IERR) 400,70,300
70	IF (I) 300,400,80
80	IF (I.GT.75) GO TO 300
	P3=0.0
	P2=0.0
	P1=FINPUT(0,IERR)
	IF (IERR) 150,90,280
90	P2=FINPUT(0,IERR)
	IF (IERR) 150,100,280
100	P3=FINPUT(0,IERR)
	IF (IERR) 150,110,280
110	IF (FINPUT(-1,IERR).NE.0.0) GO TO 280
C	LEGAL BLOCK NUMBERS AND PARAMETERS
150	ITYPE=MTRX1(I)
	IF (ITYPE) 240,160,180
160	WRITE(30,170)
170	FORMAT(41H NO CORRESPONDING CONFIGURATION STATEMENT/)
	GO TO 240
C	TEST PARAMETERS
180	IF (ITYPE.GT.10) GO TO 190
C	MODIFIED FOR BLOCKS A,C,E 25 APR 74.
	GO TO (240,210,240,230,240,230,220,210,240,210),ITYPE
190	IF (ITYPE.GT.20) GO TO 200
	ITYPE=ITYPE-10
	GO TO (220,230,210,210,220,210,210,210,220,220),ITYPE
200	ITYPE=ITYPE-20
	GO TO (220,220,240,210,230,220,210,210,210),ITYPE
210	IF (P1.NE.0.) GO TO 280
220	IF (P2.NE.0.) GO TO 280
230	IF (P3.NE.0.) GO TO 280
240	PAR(I,1)=P1
	PAR(I,2)=P2
	PAR(I,3)=P3
	IF (TEST2.EQ.5.OR.RSAC(10)) GO TO 60
C	TELEPRINTER RECORD
	K=3
	DO 250 L=1,3
	IF (PAR(I,K).NE.0.0) GO TO 260
250	K=K-1
	WRITE(30,270) I
	GO TO 60
260	IF(INPVAR.NE.-1)WRITE(30,270) I,(PAR(I,L),L=1,K)
270	FORMAT(3X,I2,1X,3(1X,G13.6))
	GO TO 60
280	WRITE(30,290)
290	FORMAT(33H IMPROPER PARAMETER SPECIFICATION/)
	GO TO 320
300	WRITE(30,310)
310	FORMAT(21H INVALID BLOCK NUMBER/)
320	TEST9=-1
	GO TO 60
C	END OF INITIAL CONDITION AND PARAMETER SPECIFICATION
400	TEST9=0
	RETURN
	END

	SUBROUTINE CSM5
C	FUNCTION GENERATOR SPECIFICATIONS
	INTEGER TEST2,TEST9
	LOGICAL RSAC
	DIMENSION MTRX(75,5),NOFG(3),F(3,11),C(76),PAR1(75),PAR2(75)
	COMMON REALS(395),INTS(547)
	COMMON/NOPR/INPVAR
	EQUIVALENCE (INTS(1),MTRX(1,1))
	EQUIVALENCE (INTS(421),NOFG(1))
	EQUIVALENCE (INTS(526),TEST2),(INTS(533),TEST9)
	EQUIVALENCE (REALS(2),C(1)),(REALS(81),PAR1(1))
	EQUIVALENCE (REALS(156),PAR2(1)),(REALS(306),F(1,1))
C	GET INPUT UNIT TEST2
	IF(INPVAR.NE.-1)WRITE(30,10)
10	FORMAT(/10X,33HFUNCTION GENERATOR SPECIFICATIONS/)
C	GET BLOCK NUMBER
20	I=KINPUT(0,IERR)
	IF (IERR) 300,30,200
30	IF (I) 240,300,40
40	IF (I.GT.75.OR.MTRX(I,1).NE.6) GO TO 240
C	FIND SPOT FOR THE FUNCTION GENERATOR
	DO 50 M=1,3
	IF (I.EQ.NOFG(M)) GO TO 70
50	CONTINUE
	DO 60 M=1,3
	N=NOFG(M)
	IF (N.EQ.0.OR.MTRX(N,1).NE.6) GO TO 70
60	CONTINUE
	GO TO 240
70	N=1
C	GET INTERCEPTS
80	C(N)=FINPUT(0,IERR)
	IF (IERR) 80,90,200
90	N=N+1
	IF (N.LE.11) GO TO 80
	IF (FINPUT(-1,IERR).NE.0.0) GO TO 220
C	STORE FUNCTION GENERATOR
	MTRX(I,5)=M
	NOFG(M)=I
	DO 100 N=1,11
100	F(M,N)=C(N)
	IF(INPVAR.EQ.-1)GO TO 120
	IF (TEST2.NE.5.AND..NOT.RSAC(10)) WRITE(30,110) I,(C(N),N=1,11)
C 	TELEPRINTER RECORD
110	FORMAT(I3,9X,5(1X,G11.4)/6(1X,G11.4))
C	CHECK PAR1 AND PAR2
120	IF (PAR1(I).GT.PAR2(I)) GO TO 20
	WRITE(30,130) I
130	FORMAT(44H SPECIFY LIMITS FOR FUNCTION GENERATOR BLOCK,I3/)
140	WRITE(30,150)
150	FORMAT(14H UPPER, LOWER=$)
	PAR1(I)=FINPUT(0,IERR)
	IF (IERR.NE.0) GO TO 140
	PAR2(I)=FINPUT(0,IERR)
	IF (IERR) 120,160,140
160	IF (FINPUT(-1,IERR).NE.0.0) GO TO 140
	GO TO 120
C	ERROR SECTION
200	WRITE(30,210)
210	FORMAT(13H SYNTAX ERROR/)
	GO TO 260
220	WRITE(30,230)
230	FORMAT(30H TOO MANY INTERCEPTS SPECIFIED/)
	GO TO 260
240	WRITE(30,250) I
250	FORMAT(6H BLOCK,I3,40H WAS NOT DEFINED AS A FUNCTION GENERATOR/)
260	TEST9=-1
	GO TO 20
C	END OF FUNCTION GENERATOR SPECIFICATION
300	TEST9=0
	RETURN
	END

	SUBROUTINE CSM6
C	OPTION TO OUTPUT UPDATED MODEL
	INTEGER OU,TEST4
	LOGICAL RSAC
	DIMENSION MTRX(75,5),NOFG(3),F(3,11),PAR(75,3)
	COMMON REALS(395),INTS(547)
	COMMON/EXTRA2/TY(30)
	EQUIVALENCE (INTS(1),MTRX(1,1)),(INTS(421),NOFG(1))
	EQUIVALENCE (INTS(528),TEST4)
	EQUIVALENCE (REALS(81),PAR(1,1)),(REALS(306),F(1,1))
	COMMON /PDEVIM/OU
C	OUTPUT OF MODEL
	WRITE(OU,10)
10	FORMAT(1H1)
30	FORMAT(1H )
C	OUTPUT CONFIGURATION SPECIFICATIONS
40	DO 80 I=1,75
	J=MTRX(I,1)
	IF (J.LE.0) GO TO 80
	K=4
	DO 50 L=1,3
	IF (MTRX(I,K).NE.0) GO TO 60
50	K=K-1
	WRITE(OU,70) I,TY(J)
	GO TO 80
60	WRITE(OU,70) I,TY(J),(MTRX(I,L),L=2,K)
70	FORMAT(3X,I2,5X,A1,3(6X,I3))
80	CONTINUE
	WRITE(OU,30)
C	OUTPUT INITIAL CONDITIONS AND PARAMETERS
	DO 130 I=1,75
	J=MTRX(I,1)
	IF (J.LE.0) GO TO 130
	K=3
	DO 100 L=1,3
	IF (PAR(I,K).NE.0.0) GO TO 110
100	K=K-1
	GO TO 130
110	IF (J.EQ.20.OR.J.EQ.21.OR.J.EQ.26) K=1
C	THE PRECEDING STATEMENT DELETES TEMPORARY DELAY PARAMETERS
C	   GENERATED BY T (TIME PULSE), U (UNIT DELAY), AND 
C	   Z (ZERO ORDER HOLD) BLOCKS DURING EXECUTION (OF CSM11)
	WRITE(OU,120) I,(PAR(I,L),L=1,K)
120	FORMAT(3X,I2,1X,3(1X,G13.6))
130	CONTINUE
	WRITE(OU,30)
C	OUTPUT FUNCTION GENERATORS
	IF (TEST4.EQ.1) GO TO 170
	DO 160 I=1,3
	J=NOFG(I)
	IF (J.LE.0.OR.MTRX(J,1).NE.6) GO TO 160
C	IT IS CONFIRMED THAT THE BLOCK IS A FUNCTION GENERATOR
	WRITE(OU,140) J,(F(I,K),K=1,11)
140	FORMAT(I3,9X,5(1X,G11.4)/6(1X,G11.4))
160	CONTINUE
	WRITE(OU,30)
170	WRITE (OU,180)
180	FORMAT(//1H1)
	RETURN
	END

	SUBROUTINE CSM7
C	REQUEST TIMING INFORMATION
	INTEGER TEST7
	COMMON REALS(395),INTS(547)
	EQUIVALENCE (INTS(531),TEST7)
	EQUIVALENCE (REALS(78),DT),(REALS(79),DTS2),(REALS(80),TTOT)
C
	WRITE(30,10)
10	FORMAT(/10X,19HINTEGRATION CONTROL/)
	TEST7=2
C	TEST7=1 UNTIL FIRST TIME THROUGH CSM7
C	TEST7=2 AFTER FIRST TIME THROUGH CSM7
20	WRITE(30,30)
30	FORMAT(22H INTEGRATION INTERVAL=$)
	DT=FINPUT(0,IERR)
	IF (IERR.NE.0) GO TO 20
	IF (FINPUT(-1,IERR).NE.0.0) GO TO 20
	IF (DT.GT.0.0) GO TO 60
	WRITE(30,50)
50	FORMAT(44H INTEGRATION INTERVAL MUST BE GREATER THAN 0/)
	GO TO 20
60	DTS2=0.5*DT
70	WRITE(30,80)
80	FORMAT(12H TOTAL TIME=$)
	TTOT=FINPUT(0,IERR)
	IF (IERR.NE.0) GO TO 70
	IF (FINPUT(-1,IERR).NE.0.0) GO TO 70
	IF (TTOT.GT.DT) RETURN
	WRITE(30,90)
90    FORMAT(53H TOTAL TIME MUST BE GREATER THAN INTEGRATION INTERVAL/)
	GO TO 70
	END