File AB4.FT (FORTRAN source file)

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

C	AUSGABETEIL UEBER ZULASSUNG - GK-BEREICH
	DIMENSION KARTE(25),IFE(227),N(67),LK(6,148),FNAM(4)
	DIMENSION IW(148),I5P(148),KLASSE(10),LOS(4)
	DO 1 K=1,4
	ISTC=148+(K+1)*200
	CALL RTAPE(1,-ISTC,227,IFE)
1	LOS(K)=IFE(10)
	DO 5 K=1,67
5	N(K)=IFE(K+160)
	READ(1,10)FNAM(1)
	READ(1,20)FNAM(2)
	READ(1,30)FNAM(3)
	READ(1,40)FNAM(4)
10	FORMAT('DATEI 12.1:'A6)
20	FORMAT('DATEI 12.2:'A6)
30	FORMAT('DATEI 13.1:'A6)
40	FORMAT('DATEI 13.2:'A6)
	DO 60 K1=1,148
	DO 50 K2=1,6
50	LK(K2,K1)=0
	I5P(K1)=0
60	IW(K1)=0
	CALL IOPEN('RKB1',FNAM(4))
	IANF=LOS(4)
	ILOS=IANF
	DO 120 K1=IANF,148
	READ(4,70)(KARTE(K),K=1,25)
70	FORMAT(13I3,12I2)
	LK(1,K1)=KARTE(1)
	LK(2,K1)=KARTE(4)/10
	LK(3,K1)=KARTE(5)/10
	LK(4,K1)=KARTE(16)
	LK(5,K1)=KARTE(17)
	DO 120 K2=6,13
	IF(N(KARTE(K2)/10)+2016) 80,120,80
80	IW(K1)=IW(K1)+1
	LK(6,K1)=LK(6,K1)+KARTE(K2+12)
	IF(KARTE(K2+12)-5) 90,120,120
90	I5P(K1)=I5P(K1)+1
120	CONTINUE
	DO 210 ISA=1,3
	CALL IOPEN('RKB1',FNAM(ISA))
	IANF=LOS(ISA)
	DO 160 K3=IANF,148
125	READ(4,70)(KARTE(K),K=1,25)
130	DO 150 K1=ILOS,148
	IF(KARTE(1)-LK(1,K1)) 150,140,150
140	INDEX=K1
	GOTO 170
150	CONTINUE
	GOTO 160
170	DO 200 K2=4,13
	IF(N(KARTE(K2)/10)+2016) 180,200,180
180	IW(INDEX)=IW(INDEX)+1
	LK(6,INDEX)=LK(6,INDEX)+KARTE(K2+12)
	IF(KARTE(K2+12)-5) 190,200,200
190	I5P(INDEX)=I5P(INDEX)+1
200	CONTINUE
160	CONTINUE
210	CONTINUE
	CALL OOPEN('RKB1','ABIGKS')
	DO 220 K1=ILOS,148
220	WRITE(4,230)(LK(K2,K1),K2=1,6),I5P(K1)
230	FORMAT(7I3)
	CALL OCLOSE
	DO 240 K=1,10
240	KLASSE(K)=0
	DO 105 K1=ILOS,148
	WRITE(1,250)LK(1,K1),N(LK(2,K1)),LK(4,K1),N(LK(3,K1)),LK(5,K1)
250	FORMAT(6(/),'SCHUELER ',I3/5X,'GK 13.2:'/'3.FACH',5X,A2,2X,
	1I2,' PUNKTE'/'4.FACH',5X,A2,2X,I2,' PUNKTE')
	WRITE(1,260)IW(K1),LK(6,K1)
260	FORMAT(/'PUNKTSUMME DER ',I2,' GK: ',I3,' PUNKTE')
	IF(I5P(K1)-5) 305,305,345
345	WRITE(1,55)I5P(K1)
55	FORMAT('NICHT ZUZULASSEN, WEIL ',I2,' KURSE MIT '/
	1'WENIGER ALS FUENF PUNKTEN EINFACHER WERTUNG '/
	2'ABGESCHLOSSEN WURDEN.')
305	IF(LK(6,K1)-100) 600,700,700
600	WRITE(1,800)
800	FORMAT('NICHT ZUZULASSEN, WEIL WENIGER ALS HUNDERT '/
	1'PUNKTE IM GK - BEREICH')
	GOTO 105
700	IF(LK(6,K1)-276) 900,1000,1000
1000	KLASSE(1)=KLASSE(1)+1
	GOTO 105
900	IGRENZ=271
	DO 1200 K=2,8
	IGRENZ=IGRENZ-20
	IF(LK(6,K1)-IGRENZ) 1200,1300,1300
1300	KLASSE(K)=KLASSE(K)+1
	GOTO 105
1200	CONTINUE
	IF(LK(6,K1)-116) 255,265,265
265	KLASSE(9)=KLASSE(9)+1
	GOTO 105
255	KLASSE(10)=KLASSE(10)+1
105	CONTINUE
	WRITE(1,270)
270	FORMAT(//'U E B E R S I C H T '/'UEBER DIE GRUPPIERUNG DER ',
	1'ZUGELASSENEN SCHUELER')
	WRITE(1,280)
280	FORMAT('IM GK - BEREICH FUER DIE MELDUNG NACH PAR. 18 ABPO'//
	115X,'PUNKT-ZAHL',5X,'ANZAHL SCHUELER'/)
	WRITE(1,290)KLASSE(1)
290	FORMAT(17X,'300-276',12X,I3)
	WRITE(1,300)KLASSE(2)
300	FORMAT(17X,'275-251',12X,I3)
	WRITE(1,310)KLASSE(3)
310	FORMAT(17X,'250-231',12X,I3)
	WRITE(1,320)KLASSE(4)
320	FORMAT(17X,'230-211',12X,I3)
	WRITE(1,330)KLASSE(5)
330	FORMAT(17X,'210-191',12X,I3)
	WRITE(1,340)KLASSE(6)
340	FORMAT(17X,'190-171',12X,I3)
	WRITE(1,350)KLASSE(7)
350	FORMAT(17X,'170-151',12X,I3)
	WRITE(1,360)KLASSE(8)
360	FORMAT(17X,'150-131',12X,I3)
	WRITE(1,370)KLASSE(9)
370	FORMAT(17X,'130-116',12X,I3)
	WRITE(1,380)KLASSE(10)
380	FORMAT(17X,'115-100',12X,I3///)
	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