PDP-10 Archive: 43,50466/csmp.f4 from decuslib10-09

Trailing-Edge - PDP-10 Archives - decuslib10-09 - 43,50466/csmp.f4
There are no other files named csmp.f4 in the archive.
C	THIS PROGRAM WAS OBTAINED FROM DECUS (NO. 10-122) AND
C	 SUBSTANTIALLY MODIFIED AT WESTERN MICHIGAN UNIVERSITY.
C	CONTINUOUS SYSTEM MODELING PROGRAM
C
C	CSMP MAIN PROGRAM
C
C	CARNEGIE-MELLON UNIVERSITY
C	HYBRID COMPUTATION LABORATORY
C	JANUARY, 1969
C
C	REVISED VERSION FOR THE PDP-10
C	WILLIAM CORWIN WORKING FOR 
C	C. GORDON BELL
C	JANUARY 1971
C
C	INSTALLED ON WMU - KALAMAZOO PDP-10
C	RUSSELL BARR III
C	MAY 1973
C
C	BLOCKS A,C,E IMPLIMENTED AS LOADABLE FUNCTIONS
C	RUSSELL BARR III
C	APRIL 1974
C
C	ADDED GRAPHICS MODIFICATION
C	RUSSELL BARR III
C	APRIL 1975
C
C	TO MAKE SYSTEM COPIES:
C
C  COM CSMP4,/FU:CSMPA CSMP,CSMP1,CSMP2,CSMP3,CSMP5,CSMP6,TIMES,USAGE
C  FUDGE
C  LOAD CSMPA,CSMP4,SYS:FORLIB/LIB %'SEG:LOW'
C  SAV CSMP
C  MA CSMP.CMD
C  IREL:CSMPA,REL:CSMP4/LIB,SYS:FORLIB/LIB %'SEG:LOW'
C  $EX$$
C	
C	LOAD ON SYS: CSMP.SAV, CSMP.CMD
C	LOAD ON REL: CSMPA.REL,CSMP4.REL
C
C
C
C	NOTE: PLOT SUPPORT ROUTINES IN CSMP6.REL(NO SOURCE) COURTESY:
C		JHLIB  - JOHN HERMAN - WMU PHYSIC DEPT.
C		PLOT10 - JOHN HERMAN AND TEKTRONICS CORP.
C
C
C	TO USE SAV VERSION:
C		R CSMP
C
C	TO USE REL VERSION:
C		EXECUTE BLOCKA,BLOCKC,BLOCKE,SYS:@CSMP
C
C	WHERE ANY OR ALL OF BLOCKA,C,E MAY BE OMITED TO USE THE
C	DEFAULT FUNCTIONS [(A) ALOG(CJ) ,(B) COS(CJ+3.14159265*P1) ,
C	(C) EXP(CJ) ].
C
C	BLOCK? ARE OF THE FORM:
C
C	FUNCTION BLOCKA(CJ,CK,CL,P1,P2,P3,*)
C	[ ANY LEGAL FUNCTION THAT CONTAINS: BLOCKA= .....
C	IF AN ERROR RETURN THAT TERMINATES THE RUN IS DESIRED,
C	DO A   RETURN 1
C	]
C	RETURN
C	END
C
C
C	CJ,CK,CL ARE INPUT VALUES FROM THE 
C	BLOCKS I1,I2,I3 RESPECTIVELY.
C	P1,P2,P3 ARE INPUT PARAMETERS 1,2, AND 3 RESPECTIVELY
C
C

	INTEGER SEMI,BLANK,REENTE,PNUM,PDEV,PFILNA,STOPS,
	1COMMAN(18),IFILNA,OFILNA,CMD,ONUM,
	2TEST1,TEST2,TEST3,TEST4,TEST5,TEST7,TEST8,INPUT(80),FILS(15)
C
	LOGICAL RSAC
C
	DATA COMMAN/3HHEL,3HLOO,3HCON,3HPAR,3HFUN,3HPUN,
	13HINT,3HOUT,3HGOE,3HFIL,3HRES,3HEXI,3HTIM,
	23HPRI,3HPLO,3HRUN,3HINP,3HGRA/
	DATA PDEV/4HDSK0/,PFILNA/5HMODEL/,PNUM/24/,
	1ONUM/1/
	DATA IDEV/3HTTY/,ODEV/3HDSK/,IFILNA/5HINPUT/,
	1OFILNA/5HOUTPT/
	DATA BLANK/1H /,SEMI/1H;/,REENTE/0/
C
	COMMON /ODEVIM/ONUM
	COMMON /PDEVIM/PNUM
	COMMON /NOSTOP/ITHROU
	COMMON REALS(395),INTS(547)
	COMMON/NOPR/INPVAR
C
      EQUIVALENCE (INTS(380),KEY1),(INTS(381),KEY2),(INTS(382),KEY3)
      EQUIVALENCE (INTS(383),KEY4),(INTS(386),KEY7),(INTS(387),KEY8)
      EQUIVALENCE (INTS(525),TEST1),(INTS(526),TEST2)
      EQUIVALENCE (INTS(527),TEST3),(INTS(528),TEST4)
	EQUIVALENCE (INTS(531),TEST7),(INTS(529),TEST5)
C
C	TIME INITIALIZATION SUBROUTINE
C
	CALL TIMES(IJ,J,K,0)
C
C	WHAT IF THE SYSTEM BOMBED AND YOU WANT BACK IN?
C
	IF(REENTE.NE.1) GO TO 1
C
C	WELL THIS LITTLE VARIABLE WILL LET YOU IN
C
	WRITE (30,5)
	WRITE (30,2)
	TEST5=1
	REENTE=1
	CALL OFILE(ONUM,OFILNA)
	GO TO 20
5	FORMAT (/' TO CLEAR TYPE "RESTART"'//)
C
C	THIS IS THE NORMAL ENTRY- IT ZEROS EVERYTHING
C	CSM0 IS TH INITIALIZATION SUBROUTINE THAT ZEROS EVERYTING
C
C
1	CALL CSM0
	TEST2=5
	IF(IRESTA.EQ.1)TEST2=IOLD
	IRESTA=0
	STOPS=1
	REENTE=1
C		SET UP OUTPUT FILE WITH A NAME
	CALL OFILE (ONUM,OFILNA)
	WRITE (30,2)
2	FORMAT (' FOR HELP TYPE "HELP"'/)
C
C	TEST5 CONTAINS A VALUE DEPENDING ON THE RETURN
C	SOME ARE ERROR RETURNS
C
10	GO TO (20,20,20,30,40,50)TEST5
30	WRITE (30,31)
	GO TO 20
31	FORMAT (/20H ERROR IN PROCESSING/)
40	WRITE (30,41)
	GO TO 20
41	FORMAT (/24H RUN TERMINATED BY A "^"/)
50	WRITE (30,51)
	GO TO 20
51	FORMAT (/33H RUN TERMINATED BY A QUIT ELEMENT/)
C
C	HERE WE COME BACK TO THE SAME OLD POINT
C	IT IS TIME TO GET MORE COMMANDS
C
20	TEST5=1
	WRITE (30,22)
22	FORMAT (2H *$)
	DO 23 J=1,80
23	INPUT(J)=0
	READ (5,21)INPUT
21	FORMAT (80A1)
	I=1
C
C	NOW TO SEPARATE THE COMMAND OUT OF THE INPUT
C
60	CMD=(INPUT(I).AND."774000000000).OR.((INPUT(I+1)/128)
	1.AND."3760000000).OR.((INPUT(I+2)/16384).AND."17777776)
	INPVAR=0
	DO 70 J=1,18
C
C	IS IT A VALID COMMAND, ASK THE ARRAY 'COMMAN'
C	AND THEN JUMP OUT OF THIS LOOP
C
70	IF (CMD.EQ.COMMAN(J))GO TO (120,130,140,150,160,170,180,
	1190,200,210,220,230,240,250,260,270,280,290)J
	GO TO 1100
C
C	CAN'T FIND THE COMMAND - MUST BE AN ERROR
C
C	NOW TO EXECUTE THE COMMANDS
C
120	CALL CSM12
C
C	THIS COMMAND WAS THE "HELP" COMMAND, SO CALL THE SUBROUTINE
C	WITH ALL THE HELP
C
	GO TO 1000
130	TEST2=5
C
C	NOW WE WANT TO LOOK AT THE BLOCK OUTPUTS
C	FIRST SET TEST2 (THE INPUT DEVICE NUMBER) EQUAL TO 5(TTY)
C	THEN CALL THE INTERROGATION ROUTINE
C
	CALL CSM13
	GO TO 1000
140	TEST1=2
C
C	CONFIGURATION- SO YOU WANT TO SET UP A MODEL
C	FIRST SET THE ERROR INDICATOR TO 2 SO WE CAN SEE AN ERROR
C
C	SET UP THE INPUT FILE
C
	CALL IFILE(TEST2,IFILNA)
C
C	THEN GO TO THE INPUT SECTION
C
	CALL CSM1
C
C	NOW THE PRESORT SECTION
C
	CALL CSM2
C
C	BUT WAS THERE AN ERROR?
C
	IF (TEST1.NE.1)GO TO 141
143	WRITE (30,142)
C
C	THERE MUST HAVE BEEN, SO TELL HIM AND SEE IF HE HAS SOME
C	BRIGHT IDEAS
C	BUT DON'T LET HIM GET PAST THIS POINT
C
	STOPS=1
	GO TO 1000
142	FORMAT (/27H CONFIGURATION NOT COMPLETE/)
141	CALL CSM3
C
C	NO ERROR SO SORT THE MODEL AND TEST AGAIN
C
	IF (TEST1.EQ.1) GO TO 143
	STOPS=0
	GO TO 1000
150	IF (STOPS.GT.0) GO TO 143
C
C	DON'T LET HIM IN IF HE ISN'T DONE
C	HE'S IN?  OK, GET THE PARAMETERS
C
	CALL CSM4
	STOPS=-1
	IF (TEST4.EQ.1) GO TO 163
	GO TO 1000
160	IF (STOPS.EQ.1)GO TO 143
	IF(STOPS.LE.-1)GO TO 161
C
C	HELP HIM FIND HIS ERROR, BUT LET HIM THROUGH (161) IF IT'S
C	 ALL RIGHT
C
	WRITE (30,162)
	GO TO 1000
162	FORMAT(24H PARAMETERS NOT COMPLETE)
161	IF (TEST4.EQ.1) GO TO 163
C
C	TEST4 TELLS IF THERE ARE ANY FUNCTIONS IN THE MODEL
C	IF THERE ARE LET HIM SPECIFY THEM
C
	CALL CSM5
163	WRITE (30,164)
C
C	THE MODEL IS NOW ALL SET UP- ON THE OUTPUT PARAMETERS,
C	WHICH ARE CHANGABLE
C
	TEST2=5
	TEST3=2
	STOPS=-2
	GO TO 1000
164	FORMAT (15H MODEL COMPLETE)
170	IF(STOPS.GE.-1) GO TO 171
	IF (TEST3.NE.2) GO TO 171
C
C	SO YOU WANT TO OUTPUT THE MODEL, FIRST CHECK TO SEE IF
C	YOU ARE DONE TO THIS STAGE, YOU ARE? OK CALL CSM6 TO DO 
C	THE ACTUALL OUTPUTING OF THE MODEL
C
C	SET UP PUNCH OUTPUT FILE
	CALL OFILE(PNUM,PFILNA)
C
C
	CALL CSM6
	GO TO 1000
171	WRITE (30,172)
	GO TO 1000
172	FORMAT (19H MODEL NOT COMPLETE)
180	IF(STOPS.LE.-2)GO TO 181
	IF(TEST3.NE.2) GO TO 171
C
C	NOW TO SPECIFY THE INTEGRATION PARAMETERS
C
181	CALL CSM7
	STOPS=-3
	GO TO 1000
190	IF (STOPS.GE.-2) GO TO 171
C
C	SPECIFY THE OUTPUT PARAMETERS TO MAKE IT PRETTY
C
	CALL CSM8A(IOFSET)
	STOPS=-4
	GO TO 1000
191	WRITE (30,192)
	GO TO 1000
192	FORMAT (34H INTEGRATION SPECIFICATIONS NEEDED)
200	IF (STOPS.NE.-4) GO TO 201
	ITHROU=1
C
C	NOW FOR THE DIRTY WORK. CSM8A, BESIDES GETTING THE OUTPUT
C	PARAMETERS ALSO PRINTS THE HEADING.  THIS CAN CAUSE PROBLEMS
C	SO USE A VARIBLE TO LET YOU DO ONE OR THE OTHER BUT NOT
C	BOTH, THIS VARIABLE IS ITHROU.
C
C	BUT DON'T WANT TO SET UP THE SAME OLD FILE IF IT HAS ALREADY 
C	INITIALIZED
C
	CALL CSM8A(IOFSET)
	ITHROU=0
C
C	RESET ITHROU AND THEN GO ON TO EXECUTE THE MODEL
C
	CALL CSM10(IOFSET)
	GO TO 1000
201	WRITE (30,202)
	GO TO 1000
202	FORMAT (16H MORE WORK TO DO)
C
C	NOW TO MAKE USE OF THE PDP-10'S MANY DEVICES
C	FIRST PRINT OUT THE OLD DEVICE NAME
C	THE FILE NAME CAN ONLY BE FIVE CHARACTERS IN LENGTH
C	WITH NO EXTENSION- THANKS TO IFILE AND OFILE
C
210	WRITE (30,211)IDEV,IFILNAM
C
C	FIRST DO THE INPUT DEVICE
C
211	FORMAT (' OLD INPUT FILE WAS ',A4,':',A5,
	1' REPLACE WITH '$)
212	FORMAT (15A1)
	READ (5,212)FILS
C
C	AFTER READING IT IN CALL GETNAM TO GET THE NAME FROM THE
C	INPUT
C
	CALL GETNAM(FILS,IDEV,IFILNA,TEST2)
C
C	BUT THERE ARE SOME DEVICES THAT CAN'T BE USED FOR INPUT
C
	IF(TEST2.EQ.3.OR.TEST2.EQ.7.OR.TEST2.EQ.8)GOTO 210
C
214	WRITE (30,213)ODEV,OFILNA
213	FORMAT (' OLD OUTPUT FILE WAS ',A4,':',
	1A5,' REPLACE WITH '$)
C
	READ (5,212)FILS
	ITMP1=OFILNA
	ITMP2=ONUM
	CALL GETNAM(FILS,ODEV,OFILNA,ONUM)
	IF(ITMP1.EQ.OFILNA.AND.ITMP2.EQ.ONUM)GO TO 216
	ENDFILE (ITMP2)
	CALL RELEAS (ITMP2)
	CALL OFILE (ONUM,OFILNA)
216	CONTINUE
C
C	DO THE SAME FOR THE OUTPUT FILES
C
	IF(ONUM.EQ.2.OR.ONUM.EQ.6)GO TO 214
	WRITE(30,215)PDEV,PFILNA
215	FORMAT (' OLD MODEL OUTPUT FILE WAS ',A4,':',A5,
	1' REPLACE WITH '$)
C
	READ (5,212)FILS
	CALL GETNAM(FILS,PDEV,PFILNA,PNUM)
C
C	AND LAST BUT NOT LEAST FOR THE PUNCH OR MODEL OUTPUT FILE
C
	GO TO 1000
220	WRITE (30,221)
C
C	THIS PART OF THE PROGRAM DOES A 'RESTART'
C	IT CALLS TIME TO FIND, AND RESET THE TIMES
C	IT THEN JUMPS OFF TO THE START OF THE PROGRAM TO 
C	ZERO OUT EVERYTHING
C
	CALL TIMES(IJ,J,K,2)
	A=IJ/1000.
	WRITE (30,232)A
	WRITE (30,233)J,K
	IRESTA=1
	IOLD=TEST2
	CALL RELEA
	GO TO 1
221	FORMAT (/' RESTART IN PROGRESS'/)
230	WRITE (30,231)
C
C	THIS IS THE PART THAT CAUSES AN EXIT FROM THE PROGRAM
C	IF FOR SOME REASON YOU WANT TO STOP AND DON'T WANT TO HIT
C	CONTROL C (SO WHAT IF ALL YOU FILES MIGHT NOT BE SAFE UNDER
C	A CONTROL C, IT'S FASTER)
C
231	FORMAT (//' END OF RUN')
	CALL TIMES(IJ,J,K,1)
C
C	OUTPUT THE TIMES
C
	A=IJ/1000.
	WRITE (30,232)A
232	FORMAT (' TOTAL CPU TIME FOR RUN ',F8.3,' SECONDS')
	WRITE (30,233)J,K
C
C	NOW LEAVE THE PROGRAM TO SEE FORTANS EXIT TIMES
C
	STOP
233	FORMAT (' ELAPSED TIME 'I4,' MIN ',I2,' SECONDS')
C
C	NOW TO FIND OUT WHAT TIME IT IS AND TO RESET THE TIME
C
240	CALL TIMES(IJ,J,K,2)
	A=IJ/1000.
	WRITE (30,232)A
	WRITE (30,233)J,K
	GO TO 1000
C	
C	THE NEXT TWO TELL WHETHER YOU WANT PRINTED OR PLOTED OUTPUT
C
250	KEY7=1
C
C	OK, MAKE IT A PRINT JOB
C
	IF(STOPS.LT.-3)STOPS=-3
C
C	OK, CHANGE THE WAY IT'S OUTPUT AND BETTER GET THE NEEDED
C	INFORMATION
C
	GO TO 1000
260	KEY7=2
C
C	OK, MAKE IT A PLOT JOB
C
	IF(STOPS.LT.-3)STOPS=-3
	GO TO 1000
C
C	THIS IS FOR THE RUN COMMAND
C	IT IS MAINLY TO SAVE TYPING FINGERS
C
270	GO TO (271,272,273,274,275,276)STOPS+5
C
C	FIRST DECIDE WHERE THE USER IS AND PICK UP WHERE HE LEFT OFF
C
	GO TO 1100
276	IF (RSAC(0)) GO TO 1000
	IF(TEST2.NE.5)CALL IFILE(TEST2,IFILNA)
	CALL CSM1
	CALL CSM2
	IF (TEST1.NE.1)GO TO 2761
2762	WRITE (30,142)
	GO TO 276
2761	CALL CSM3
	IF(TEST1.EQ.1)GO TO 2762
	STOPS=0
	IF(RSAC(0)) GO TO 1000
275	CALL CSM4
	STOPS=-1
	IF(RSAC(0)) GO TO 1000
	IF(TEST4.EQ.1) GO TO 2741
274	CALL CSM5
2741	WRITE(30,164)
	TEST2=5
	TEST3=2
	STOPS=-2
	IF(RSAC(0)) GO TO 1000
	IF(INPVAR.EQ.-1)GO TO 1000
273	IF (TEST7.EQ.2) GO TO 272
	CALL CSM7
	STOPS=-3
	IF(RSAC(0)) GO TO 1000
272	IF(TEST8.EQ.2) GO TO 271
	CALL CSM8A(IOFSET)
	STOPS=-4
	IF(RSAC(0)) GO TO 1000
C
C	THE TESTS OF TEST7 AND 8 WERE TO DETERMINE IF THEY HAVE
C	ALREADY BEEN ENTERED AND SO DON'T ASK FOR THEM AGAIN
C
271	STOPS=-4
	ITHROU=1
	CALL CSM8A(IOFSET)
	ITHROU=0
	CALL CSM10(IOFSET)
	GO TO 1000
C
C	INP READS IN A MODEL BUT DOES NOT RUN OR ECHO IT.
C
280	IF(STOPS.GE.1)GO TO 281
	WRITE(30,282)
282	FORMAT(' USE RESTART COMMAND FOR NEW MODEL',/)
	GO TO 1000
281	INPVAR=-1
	GO TO 270
C
C	THE GRAPH OPTION SETUP.
C
290	KEY7=-1
	IF(STOPS.LT.-3)STOPS=-3
C	SINCE THE USER MAY HAVE (SOMEHOW) SWITCHED TERMINALS
C	SINCE THE LAST RUN TYPE COMMAND WE SHOULD GET NEW
C	INFO. (ALSO IF HE MADE A MISTAKE THE FIRST TIME 
C	LET HIM CORRECT IT.)
	CALL DELETE('TRMNL.DAT')
	TYPE=0
	ITYPE=0
C	DUMMY TO INIT TERMINAL VALUES.(NORMAL USE OF THE
C	GPLOT ROUTINES, CALLS FOR USE OF PLOTTE FROM INSIDE
C	ONLY.
C	CALL PLOTTE(TYPE,ITYPE)
	GO TO 1000
C
C	THIS IS WHERE EVERYTHING ENDS UP 
C
1000	DO 1001 J=I+3,80
C
C	IF THE INPUT HAS A SCMICOLON IN IT BE PREPARED FOR ANOTHER
C	COMMAND
C
	IF (INPUT(J).EQ.SEMI) GO TO 1010
C
C	IF THE INPUT IS ZERO THEN EXIT, ELSE LOOP
C
1001	IF (INPUT(J).EQ.0) GO TO 10
	GO TO 10
1010	IF((INPUT(J+1).EQ.0).OR.(INPUT(J+1).EQ.BLANK))GO TO 10
	I=J+1
	IF(TEST5.GT.3) GO TO 10
	GO TO 60
C
C	IF THERE WAS AN ERROR COME HERE
C	HOWEVER, LET THE USER HAVE A BLANK COMMAND
C
1100	IF(CMD.EQ.BLANK)GO TO 20
	WRITE (30,1101)
	GO TO 20
1101	FORMAT (' COMMAND ERROR- FOR HELP TYPE "HELP"')
	END