File CMPLRB.

Directory of image this file is from
This file as a plain text file

C	HAUPTPROGRAMM
C	NAME: RB2704
C	BERECHNET KLEINPHIRB UND GROSSPHIRB

	COMMON ASUM,BSUM
	DIMENSION ASUM(500),BSUM(500)

	READ(1,100) IN
100	FORMAT('ANZAHL DER SCHRITTE: 'I7)

200	IK1=0
	CALL IOPEN('SYS','BATCHD')
	READ(4,300) RQ,RC1,RC2,RC3,M1,M2,DATEI
300	FORMAT(F4.1/F4.1/F4.1/F4.1/A1/A2/A6)
	GOTO 500
400	IK1=IK1+1
	IF (IK1-27) 410,2000,2000
410	CALL IOPEN('SYS','BATCHD')
	DO 440 J=1,IK1
	DO 430 I=1,7
	READ(4,420) ILAUF
420	FORMAT(I0)
430	CONTINUE
440	CONTINUE
	READ(4,300) RQ,RC1,RC2,RC3,M1,M2,DATEI
500	RTIN=1.0/(FLOAT(IN))

	RALPH=RTIN*RQ
	RBETA=RTIN*(1.2+RQ)
	RGAMM=RTIN*(1.2+RC3-RC1+RQ)


C	**** BERECHNUNG VON KLEIN PHIRA+RK ****
C	
	IF (RQ) 1000,1405,1000

1000	CALL SQUAR(0.3,1.5,0.,RM,RB,RH)
	PHIRA=1.0/RQ

	DO 1200 J=1,IN
	SUM=0.

	DO 1100 I=1,IN
	RT1=0.3+RBETA*FLOAT(J-1)-RALPH*FLOAT(I-1)
	IF (RT1-0.3) 1100,1100,1020
1020	IF (RT1-1.5) 1040,1040,1100
C	GO 1100, CAUSE PHIRK=0.0
1040	PHIRK=RT1*RM+RB
	SUM=SUM+PHIRA*PHIRK
1100	CONTINUE
	BSUM(J)=RALPH*SUM
1200	CONTINUE

C	BERECHNUNG VON KLEINPHIRB

	CALL SQUAR(RC1,RC2,RC3,RM,RB,RH)
	CALL OOPEN('SYS',DATEI)

	DO 1400 K=1,IN
	SUM=0.
	RTK=RC1+0.3+RGAMM*FLOAT(K-1)

	DO 1300 J=1,IN
	RT1=RC1+RGAMM*FLOAT(K-1)-RBETA*FLOAT(J-1)
	IF (RT1-RC1) 1300,1300,1202
1202	IF (RT1-RC3) 1205,1205,1300
1205	IF (RT1-RC2) 1210,1220,1220
1210	PHIRU=RM*RT1+RB
	GOTO 1230
1220	PHIRU=RH
1230	SUM=SUM+BSUM(J)*PHIRU
1300	CONTINUE

	ASUM(K)=RBETA*SUM
	WRITE(4,1310) RTK,ASUM(K)
1310	FORMAT(E15.6,F15.10)
1400	CONTINUE
	CALL OCLOSE
	GOTO 1700

C	*** SONDERFALL MIT Q=0 ***

1405	CALL SQUAR(0.3,1.5,0.,RSTEI,RORD,RH)
	CALL SQUAR(RC1,RC2,RC3,RM,RB,RH)
	CALL OOPEN('SYS',DATEI)

	DO 1600 K=1,IN
	SUM=0.
	RTK=RC1+0.3+RGAMM*FLOAT(K-1)

	DO 1500 J=1,IN
	RT1=RC1+RGAMM*FLOAT(K-1)-RBETA*FLOAT(J-1)
	RT2=0.3+RBETA*FLOAT(J-1)
	IF (RT2-0.3) 1500,1500,1403
1403	IF (RT2-1.5) 1404,1404,1500
1404	IF (RT1-RC1) 1500,1500,1407
1407	IF (RT1-RC3) 1409,1409,1500
1409	IF (RT1-RC2) 1410,1420,1420
1410	PHIRU=RM*RT1+RB
	GOTO 1430
1420	PHIRU=RH
1430	PHIRK=RSTEI*RT2+RORD
	SUM=SUM+PHIRK*PHIRU
1500	CONTINUE

	ASUM(K)=RBETA*SUM
	WRITE(4,1310) RTK,ASUM(K)
1600	CONTINUE
	CALL OCLOSE

1700	GOTO 400

2000	CALL EXIT
	END

Feel free to contact me, David Gesswein djg@pdp8online.com with any questions, comments on the web site, or if you have related equipment, documentation, software etc. you are willing to part with. I am interested in anything PDP-8 related, computers, peripherals used with them, DEC or third party, or documentation.

PDP-8 Home Page PDP-8 Site Map PDP-8 Site Search