Trailing-Edge
-
PDP-10 Archives
-
decuslib10-09
-
43,50466/csmp2.f4
There are no other files named csmp2.f4 in the archive.
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