File KUWA3C.FT (FORTRAN source file)

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


C						SEITE 1
C	KUWA3C
C
C	KURSWAHL - SPEICHERN DER SCHRIFTLICHEN FAECHER
C	FUER DAS 3. ABITURFACH
C
	COMMON IFORM,IHALB,ISTA,ISTB,ISTD,ISTE,ISTF,ISTG,ISTL,ISTM
	COMMON LANF,IANF,I,I2,IZFE,IZFA,N
	DIMENSION I(11,148),I2(148),I3(4,148),N(67),NKU(6),IKN(148)
	DIMENSION FACH(2,42),IFE(227)
	ISPAC=-2016
	ISTFN=1+ISTA
	ISTC=148+ISTA
	ISTS=160+ISTA
	DO 1 K1=1,148
	I(1,K1)=0
	I2(K1)=0
	I3(1,K1)=0
	I3(2,K1)=3
	I3(3,K1)=4
1	I3(4,K1)=-1
	CALL RTAPE(1,ISTFN,252,FACH)
	WRITE(1,800)IFORM,IHALB,ISPAC,
800	FORMAT(/'SIND DIE SCHRIFTLICHEN FAECHER FUER ',A2,'.',A1,
	1' SCHON GESPEICHERT ?',A1)
	READ(1,20)IFRAGE
	IF(IFRAGE-672) 830,820,830
830	DO 840 K1=1,148
840	I2(K1)=1
	GOTO 810
820	CALL RTAPE(1,-ISTS,592,I3)
810	CALL DATF3(IFRAGE,I3)
85	CALL RTAPE(1,ISTG,1628,I)
20	FORMAT(A2)
	CALL KUSOR(I3)
400	CALL WTAPE(1,-ISTS,592,I3)
C	KURSWAHL - AUSGABE DER FUER DAS 3.ABITURFACH
C	VORGESEHENEN KURSE
	WRITE(1,241)
241	FORMAT(//80('-'))
	ISEI=0
	IWEIC=1
	DO 110 K1=IANF,149,40
	ISEI=ISEI+1
	MAX=148
	IF(K1-109) 112,114,114
112	MAX=K1+39
114	WRITE(1,120)IFORM,IHALB,ISEI
	WRITE(1,121)I3(1,K1),I3(1,MAX)
C
C						SEITE 2
C
120	FORMAT(///'KLASSENSTUFE ',A2,' HALBJAHR ',A2,32X,'SEITE',I3)
121	FORMAT(/' SCHUELERNUMMER ',I3,' BIS ',I3///)
	DO 150 K2=0,19,10
	DO 160 K3=0,9
	L1=K1+K2+K3
	IF(L1-148) 115,115,110
115	IF(K2+K3-19) 151,151,150
151	ITEM1=L1
	ITEM2=L1+20
	IEND=0
	IF(L1-128)705,705,755
755	IREST=149-K1
	IF(IREST-2*(IREST/2)) 710,725,710
710	IEND=IREST/2+1
	GOTO 735
725	IEND=IREST/2
735	IF(L1+IEND-148) 745,745,715
745	ITEM2=L1+IEND
	GOTO 705
715	ITEM2=L1
	IWEIC=2
705	N11=I3(2,ITEM1)/10
	N12=I3(2,ITEM2)/10
	N21=I3(3,ITEM1)/10
	N22=I3(3,ITEM2)/10
	N31=I3(4,ITEM1)/10
	N32=I3(4,ITEM2)/10
	NKU(1)=I3(2,ITEM1)-10*N11
	NKU(2)=I3(3,ITEM1)-10*N21
	NKU(3)=I3(4,ITEM1)-10*N31
	NKU(4)=I3(2,ITEM2)-10*N12
	NKU(5)=I3(3,ITEM2)-10*N22
	NKU(6)=I3(4,ITEM2)-10*N32
	DO 605 J=1,6
	NHI=NKU(J)+1
	GOTO(615,625,635,645,655),NHI
615	ITEM=-2016
	GOTO 605
625	ITEM=-1999
	GOTO 605
635	ITEM=-1998
	GOTO 605
645	ITEM=-1997
	GOTO 605
655	ITEM=-1996
605	NKU(J)=ITEM
	IF(L1+IEND-148)665,665,675
C
C						SEITE 3
C
675	DO 685 J=4,6
685	NKU(J)=-2016
665	CALL RTAPE(1,ISTM,1628,I)
	KK=1
	DO 170 K4=1,148
	IF(I(1,K4)-I3(1,L1)) 175,190,175
190	K=K4
	KK=KK+1
	GOTO(175,175,260),KK
175	IF(I(1,K4)-I3(1,ITEM2)) 170,185,170
185	KK=KK+1
	L=K4
	GOTO(170,170,260),KK
170	CONTINUE
260	WRITE(1,250)(I(K5,K),K5=1,11),N(N11),N(N21),N(N31),
	IF(L1+IEND-148)720,720,730
730	WRITE(1,740)ISPAC
740	FORMAT(A1)
	GOTO 750
720	WRITE(1,251)(I(K5,L),K5=1,11),N(N12),N(N22),N(N32)
250	FORMAT(/I3,2X,10A2,3(2X,A2))
251	FORMAT(6X,I3,2X,10A2,3(2X,A2))
750	WRITE(1,500)(NKU(J),J=1,6)
500	FORMAT(25X,3(2X,A2),31X,3(2X,A2))
	GOTO(160,110),IWEIC
160	CONTINUE
	WRITE(1,270)
270	FORMAT(2X)
150	CONTINUE
	WRITE(1,280)
280	FORMAT(80('-'))
110	CONTINUE
	CALL DRUFA(FACH,I3)
	CALL RTAPE(1,-ISTD,1628,I)
C	RESTAURIERUNG DES COMMON-BEREICHS
	CALL RTAPE(1,-ISTC,227,IFE)
	DO 880 K1=1,148
880	I2(K1)=IFE(K1+12)
	CALL CHAIN ('KUWA3S')
	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