File AB8.FT (FORTRAN source file)

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

	COMMON LANF,IANF,NAME,IDAT,IPU,IQU
	DIMENSION NAME(11,148),IDAT(23),FANO(4),IPU(4),IQU(4),IHILF(4)
	DIMENSION LIMOB(3),LIMUN(3),LIMUT(3)
	ISPACE=-2016
	ISTM=1038
	CALL RTAPE(1,-ISTM,1628,NAME)
5	CALL IOPEN('RKB1','ABITUR')
15	CALL OOPEN('RKB1','ABIAUS')
25	DO 10 K1=IANF,148
	READ(4,20)(IDAT(K2),K2=1,19)
	IF(IDAT(1)-NAME(1,K1)) 35,45,35
35	WRITE(1,55)IDAT(1),NAME(1,K1)
55	FORMAT(/'BEI ',I3,' STIMMT WAS NICHT (',I4,')')
	GOTO 10
45	ISUM=0
	IP=0
	IQ=0
	DO 205 K=1,4
	IPU(K)=0
	IQU(K)=0
	IDAT(19+K)=0
	IF(IDAT(13+K)-1516) 30,40,40
30	FANO(K)=FLOAT(IDAT(5+K)+IDAT(9+K))/4.
	IF(ABS(FANO(K)-FLOAT(IDAT(13+K)))-4.) 205,50,50
50	IF(K-4) 60,205,205
60	IP=IP+1
	IPU(K)=1
	GOTO 205
40	WRITE(1,630)(NAME(K2,K1),K2=2,11),IDAT(1+K)
20	FORMAT(I3,4A2/14I4)
630	FORMAT(10A2/'PRUEFUNGSERGEBNIS IN ',A2,' FEHLERHAFT')
640	CALL DATEI(1,5,5,1,K1)
	GOTO 10
205	CONTINUE
	DO 150 K=1,3
	IDAT(19+K)=4*IDAT(13+K)+IDAT(9+K)
	ISUM=ISUM+IDAT(19+K)
150	IHILF(K)=IDAT(19+K)
	IF(IDAT(5)-1232) 160,170,160
170	IX=IDAT(17)/100
	IY=IDAT(17)-100*IX
	IDAT(23)=IDAT(13)+(8*IX+4*IY)/3
	GOTO 180
160	IDAT(23)=4*IDAT(17)+IDAT(13)
180	ISUM=ISUM+IDAT(23)
	WRITE(1,100)(NAME(K2,K1),K2=2,11)
100	FORMAT(///17X,24('*')/17X,'* ',10A2,' *'/17X,24('*')//19X,
	1'SCHNITT 12/13',5X,'PKTE 13.2',5X,'PKTE PRFG',5X,'BISH.ERG.'/)
	WRITE(1,110)IDAT(2),FANO(1),IDAT(10),IDAT(14),IDAT(20)
110	FORMAT(5X,'L-FACH ',A2,9X,F5.2,12X,I2,9X,'SCHR  ',I2,9X,I3)
	WRITE(1,110)IDAT(3),FANO(2),IDAT(11),IDAT(15),IDAT(21)
	WRITE(1,120)IDAT(4),FANO(3),IDAT(12),IDAT(16),IDAT(22)
120	FORMAT(5X,'3.FACH ',A2,9X,F5.2,12X,I2,9X,'SCHR  ',I2,9X,I3)
	IF(IDAT(5)-1232) 70,80,70
70	WRITE(1,130)IDAT(5),FANO(4),IDAT(13),IDAT(17),IDAT(23)
130	FORMAT(5X,'4.FACH ',A2,9X,F5.2,12X,I2,9X,'MDL   ',I2,9X,I3)
	GOTO 190
80	WRITE(1,140)IDAT(5),FANO(4),IDAT(13),IX,IY,IDAT(23)
140	FORMAT(5X,'4.FACH ',A2,9X,F5.2,12X,I2,9X,'PR.TH ',I2,'.',I2,6X,I3)
190	WRITE(1,200)ISUM
200	FORMAT(65X,9('-')/53X,'SUMME:',9X,I3)
C	FESTSTELLUNG DER ERGEBNISGRENZEN
	DO 210 K=1,3
	LIMOB(K)=(8*IDAT(13+K)+60)/3+IDAT(9+K)
	IF(IPU(K)) 220,220,230
220	LIMUN(K)=4*IDAT(13+K)+IDAT(9+K)
	LIMUT(K)=IDAT(13+K)
	GOTO 210
230	LIMUN(K)=(8*IDAT(13+K))/3+IDAT(9+K)
	LIMUT(K)=0
210	CONTINUE
	IHILF(4)=IDAT(23)
	DO 240 K=1,3
240	IHILF(K)=LIMUN(K)
	CALL FERTIG(IHILF,IB,IBA)
	IF(IB-111) 250,260,260
260	IF(IP) 270,270,280
270	WRITE(1,290)
290	FORMAT(/10X,'B E S T A N D E N !'/)
	CALL DATEI(3,4,5,1,K1)
	GOTO 10
280	CALL DATEI(5,5,5,2,K1)
S	JMS MDL
	GOTO 10
C	MAXIMIERUNG ALLER FAECHER
250	DO 340 K=1,3
340	IHILF(K)=LIMOB(K)
	CALL FERTIG(IHILF,IB,IBA)
	IF(IBA) 350,350,360
350	IF(IB-100) 370,370,380
370	WRITE(1,390)
390	FORMAT(/5X,'NICHT BESTANDEN WEGEN 100-PUNKTE-BEDINGUNG')
	IF(IB-10) 380,380,420
380	WRITE(1,410)
410	FORMAT(/5X,'NICHT BESTANDEN WEGEN 25-PUNKTE-BEDINGUNG')
420	CALL DATEI(2,3,4,1,K1)
	GOTO 10
360	IF(IP-3) 430,440,430
C	ERMITTLUNG DER GEFAEHRDUNGSFAECHER, DIE AUF JEDEN FALL
C	GEPRUEFT WERDEN MUESSEN
430	DO 450 K=1,3
	J=K+1
	K0=K+2
	IF(K-2) 460,470,460
470	K0=1
460	IF(K-3) 480,490,500
500	STOP
490	J=1
	K0=2
480	IF(IPU(K0)-1) 510,450,510
510	IBB=0
	LUG=LIMUT(K)
	LUK=LIMUT(J)
	DO 530 KL=LUG,15
	IHILF(K)=(8*IDAT(13+K)+4*KL)/3+IDAT(9+K)
	DO 540 KM=LUK,15
	IHILF(J)=(8*IDAT(13+J)+4*KM)/3+IDAT(9+J)
	IHILF(K0)=LIMOB(K0)
	CALL FERTIG(IHILF,IB,IBA)
	IBB=IBB+IBA
	IHILF(K0)=LIMUN(K0)
	CALL FERTIG(IHILF,IB,IBA)
	IBB=IBB-IBA
	IF(IBB) 540,540,550
540	CONTINUE
530	CONTINUE
	GOTO 450
550	IQU(K0)=1
	IQ=IQ+1
450	CONTINUE
440	CONTINUE
S	JMS MDL
C	FAECHER MIT GEFAEHRDUNGSPRUEFUNGEN DRUCKEN
	IF(IQ) 500,620,560
560	WRITE(1,570)ISPACE,
570	FORMAT(/'MUENDLICHE PRUEFUNG WEGEN GEFAEHRDUNG IN ',A2)
	DO 580 K=1,3
	IF(IQU(K)-IPU(K)-1) 580,590,590
590	WRITE(1,600)IDAT(1+K),ISPACE,
600	FORMAT(2A2)
580	CONTINUE
	WRITE(1,610)
610	FORMAT(/)
620	CALL DATEI(5,5,5,2,K1)
10	CONTINUE
650	CALL OCLOSE
690	STOP
SMDL,	0
	IF(IP) 106,106,206
206	WRITE(1,306)ISPACE,
306	FORMAT(/'MUENDLICHE PRUEFUNG WEGEN ABWEICHUNG IN ',A2)
	DO 406 K=1,3
	IF(IPU(K)) 406,406,506
506	WRITE(1,606)IDAT(1+K),ISPACE,
606	FORMAT(2A2)
406	CONTINUE
	WRITE(1,610)
106	CONTINUE
S	JMP I MDL
	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