SUBROUTINE CSM0 C INITIALIZATION INTEGER TEST(9),KEYS(16) COMMON REALS(395),INTS(547) EQUIVALENCE (INTS(525),TEST(1)) EQUIVALENCE (INTS(380),KEYS(1)) WRITE(30,10) 10 FORMAT(1H1,10X,38HWMU CONTINUOUS SYSTEM MODELING PROGRAM//) IF(IONE.NE.0)GO TO 13 C CALL USAGE('CSMP ') 13 IONE=1 DO 20 I=1,547 20 INTS(I)=0 DO 30 I=1,395 30 REALS(I)=0.0 DO 50 I=1,8 50 TEST(I)=1 DO 60 I=1,16 60 KEYS(I)=2 RETURN END SUBROUTINE CSM1 C CONFIGURATION SPECIFICATIONS INTEGER TEST2,TEST9 LOGICAL RSAC DIMENSION MTRX(75,5) COMMON REALS(395),INTS(547) COMMON/EXTRA2/TY(30) COMMON/NOPR/INPVAR EQUIVALENCE (INTS(1),MTRX(1,1)) EQUIVALENCE (INTS(526),TEST2) EQUIVALENCE (INTS(533),TEST9) C GET INPUT UNIT TEST2 IF(INPVAR.NE.-1)WRITE(30,10) 10 FORMAT(/10X,27HCONFIGURATION SPECIFICATION/) IF (TEST2.EQ.5) GO TO 40 C NON-TTY INPUT IF(INPVAR.EQ.-1)GO TO 60 WRITE(30,30) 30 FORMAT(40H BLOCK TYPE INPUT 1 INPUT 2 INPUT 3) GO TO 60 C TTY INPUT 40 WRITE(30,50) 50 FORMAT(39H BLOCK, TYPE, INPUT 1, INPUT 2, INPUT 3/) C INPUT STATEMENTS 60 I=KINPUT(0,IERR) IF (IERR) 400,70,340 70 IF (I) 340,400,80 80 IF (I.GT.75) GO TO 340 J=0 K=0 L=0 ATYPE=FINPUT(1,IERR) C SEARCH THROUGH PROGRAM LIBRARY FOR BLOCK TYPE ATYPE DO 90 M=1,30 IF (ATYPE.EQ.TY(M)) GO TO 120 90 CONTINUE C TYPE IS NOT IN THE LIBRARY 100 WRITE(30,110) I 110 FORMAT(28H ILLEGAL BLOCK TYPE IN BLOCK,I3/) GO TO 360 120 IF (IERR) 180,130,320 130 J=KINPUT(0,IERR) IF (IERR) 180,140,320 140 IF (IABS(J).GT.76) GO TO 320 K=KINPUT(0,IERR) IF (IERR) 180,150,320 150 IF (IABS(K).GT.76) GO TO 320 L=KINPUT(0,IERR) IF (IERR) 180,160,320 160 IF (IABS(L).GT.76) GO TO 320 IF (FINPUT(-1,IERR).NE.0.0) GO TO 320 C LEGAL BLOCK, TYPE, AND INPUTS C MODIFIED FOR BLOCKS A,C,E 25 APR 74. 180 IF (M.LE.10) GO TO (250,200,250,200,250,200,200,200,220,190),M N=M-10 IF (N.LE.10) GO TO (190,200,200,200,200,200,210,220,210,200),N N=N-10 GO TO (200,190,220,210,210,210,250,200,210,250),N 190 IF (J.GT.0) GO TO 320 200 IF (K.GT.0) GO TO 320 210 IF (L.GT.0) GO TO 320 220 IF (J.LT.0) GO TO 320 230 IF (K.LT.0) GO TO 320 240 IF (L.LT.0) GO TO 320 C LEGAL STATEMENTS - STORE THE CONFIGURATION 250 MTRX(I,2)=J MTRX(I,3)=K MTRX(I,4)=L IF (TEST2.EQ.5.OR.RSAC(10)) GO TO 290 C TELEPRINTER RECORD K=4 DO 260 L=1,3 IF (MTRX(I,K).NE.0) GO TO 270 260 K=K-1 IF(INPVAR.NE.-1)WRITE(30,280) I,ATYPE GO TO 290 270 IF(INPVAR.NE.-1)WRITE(30,280) I,ATYPE,(MTRX(I,L),L=2,K) 280 FORMAT(3X,I2,5X,A1,3(6X,I3)) C CHECK FOR BLOCK DELETION 290 IF (MTRX(I,1).NE.0) WRITE(30,300) I 300 FORMAT(15H PREVIOUS BLOCK,I3,8H DELETED/) MTRX(I,1)=M IF (M.NE.30) GO TO 60 MTRX(I,1)=0 MTRX(I,5)=0 GO TO 60 C ILLEGAL STATEMENT 320 WRITE(30,330) I 330 FORMAT(15H ERROR IN BLOCK,I3/) GO TO 360 C ILLEGAL BLOCK NUMBER 340 WRITE(30,350) I 350 FORMAT(17H BLOCK NUMBER OF ,I7,11H IS ILLEGAL/) 360 TEST9=-1 GO TO 60 C END OF CONFINURATION SPECIFICATION 400 TEST9=0 RETURN END SUBROUTINE CSM2 C PREPARE FOR SORT INTEGER TEST(9),DELAY(25),ORDER(76) DIMENSION MTRX(75,5),INTG(25) COMMON REALS(395),INTS(547) EQUIVALENCE (INTS(1),MTRX(1,1)) EQUIVALENCE (INTS(396),INTG(1)) EQUIVALENCE (INTS(424),DELAY(1)) EQUIVALENCE (INTS(449),ORDER(1)) EQUIVALENCE (INTS(525),TEST(1)) EQUIVALENCE (INTS(540),NCON) EQUIVALENCE (INTS(541),NOD) EQUIVALENCE (INTS(542),NEQ) EQUIVALENCE (INTS(543),NFG) C RESET ERROR INDICATOR AND COUNTERS IERR=2 NOD=0 NEQ=0 IFG=0 NCON=2 ORDER(1)=76 C C TEST FOR SELECTED ELEMENTS DO 80 I=1,75 ITYPE=IABS(MTRX(I,1)) IF (ITYPE.EQ.0) GO TO 80 MTRX(I,1)=ITYPE IF (ITYPE.NE.21) GO TO 10 C UNIT DELAY NOD=NOD+1 DELAY(NOD)=I GO TO 40 10 IF (ITYPE.NE.9) GO TO 20 C INTEGRATOR NEQ=NEQ+1 INTG(NEQ)=I MTRX(I,5)=NEQ GO TO 40 20 IF (ITYPE.NE.11) GO TO 30 C CONSTANT ORDER(NCON)=I NCON=NCON+1 GO TO 50 C FUNCTION GENERATOR 30 IF (ITYPE.EQ.6) IFG=IFG+1 C NEGATE ELEMENT IDENTIFIER UNTIL AFTER SORTING 40 MTRX(I,1)=-ITYPE 50 DO 70 J=2,4 LTEST=IABS(MTRX(I,J)) IF (LTEST.LE.0.OR.LTEST.GT.75.OR.MTRX(LTEST,1).NE.0) GO TO 70 WRITE(30,60) LTEST,I 60 FORMAT(6H BLOCK,I3,16H, INPUT TO BLOCK,I3,9H, MISSING/) IERR=1 70 CONTINUE 80 CONTINUE C C TEST ON PROPER NUMBER OF ELEMENTS IF (NEQ.GT.0) GO TO 100 WRITE(30,90) 90 FORMAT(31H AT LEAST 1 INTEGRATOR REQUIRED/) IERR=1 GO TO 120 100 IF (NEQ.LE.25) GO TO 120 WRITE(30,110) 110 FORMAT(48H THE MAXIMUM OF 25 INTEGRATORS HAS BEEN EXCEEDED/) IERR=1 120 IF (NOD.LE.25) GO TO 140 WRITE(30,130) 130 FORMAT(48H THE MAXIMUM OF 25 UNIT DELAYS HAS BEEN EXCEEDED/) IERR=1 140 IF (IFG.LE.3) GO TO 170 WRITE(30,150) 150 FORMAT(55H THE MAXIMUM OF 3 FUNCTION GENERATORS HAS BEEN EXCEEDED 1/) C UNSUCCESSFUL PRE-SORT 160 TEST(1)=1 RETURN 170 IF (IERR.EQ.1) GO TO 160 IF (IFG.GT.0) GO TO 180 C NO FUNCTION GENERATORS TEST(4)=1 NFG=0 GO TO 190 C SOME FUNCTION GENERATORS 180 TEST(4)=2 IF (IFG.GT.NFG) TEST(3)=1 C TEST3=1 TO SIGNAL ADDITION OF FUNCTION GENERATOR BLOCK(S) NFG=IFG C SUCCESSFUL PRE-SORT 190 TEST(1)=2 RETURN END SUBROUTINE CSM3 C SORT INTEGER TEST1,DELAY(25),ORDER(76) DIMENSION MTRX(75,5),INTG(25) COMMON REALS(395),INTS(547) EQUIVALENCE (INTS(1),MTRX(1,1)),(INTS(396),INTG(1)) EQUIVALENCE (INTS(424),DELAY(1)),(INTS(449),ORDER(1)) EQUIVALENCE (INTS(525),TEST1),(INTS(534),NLIST) EQUIVALENCE (INTS(540),NCON),(INTS(541),NOD),(INTS(542),NEQ) C RESET ERROR INDICATOR IERR=2 DO 10 N=NCON,76 10 ORDER(N)=0 C C SORT OPERATION NLIST=NCON-1 20 DO 80 I=1,75 IF (MTRX(I,1).GE.0) GO TO 80 DO 70 J=2,4 LTEST=IABS(MTRX(I,J)) IF (LTEST.EQ.0) GO TO 70 IF (NOD.EQ.0) GO TO 40 DO 30 K=1,NOD IF (LTEST.EQ.DELAY(K)) GO TO 70 30 CONTINUE 40 DO 50 K=1,NEQ IF (LTEST.EQ.INTG(K)) GO TO 70 50 CONTINUE DO 60 K=1,NLIST IF (LTEST.EQ.ORDER(K)) GO TO 70 60 CONTINUE GO TO 80 70 CONTINUE GO TO 130 80 CONTINUE C C SORT TEST DO 90 I=1,75 IF (MTRX(I,1).LT.0) GO TO 110 90 CONTINUE IF (IERR.EQ.1) GO TO 100 C SUCCESSFUL SORT TEST1=2 RETURN C UNSUCCESSFUL SORT 100 TEST1=1 RETURN C SORT FAILURE - SET ERROR INDICATOR, TYPE ERROR MESSAGE, C AND PUT BLOCK IN THE SORT ORDER LIST TO DETERMINE C WHETHER THE REST OF THE CONFIGURATION WOULD BE OK 110 IERR=1 WRITE(30,120) I 120 FORMAT(22H SORT FAILURE AT BLOCK,I3/) 130 MTRX(I,1)=-MTRX(I,1) NLIST=NLIST+1 ORDER (NLIST)=I GO TO 20 END