File KUWA2C.FT (FORTRAN source file)

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


C						SEITE 1
C	KUWA2C
C
C       KURSWAHL - WAHLAUFLAGEN UEBERPRUEFEN
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),N(67),KAKBE(5),KSKBE(5,8),NONLK(15)
        DIMENSION KAUFG(3,15),KAUFL(106)
C       EINLESEN WAHLAUFLAGEN
        CALL RTAPE(1,ISTB,106,KAUFL)
        DO 10 IZ=1,5
10      KAKBE(IZ)=KAUFL(IZ)
	IH=5
        DO 20 IZ1=1,5
        DO 20 IZ=1,8
	IH=IH+1
20      KSKBE(IZ1,IZ)=KAUFL(IH)
        DO 30 IZ1=1,3
        DO 30 IZ=1,15
	IH=IH+1
30      KAUFG(IZ1,IZ)=KAUFL(IH)
        DO 40 IZ=1,15
	IH=IH+1
40      NONLK(IZ)=KAUFL(IH)
        IKURA=KAUFL(106)
400     FORMAT (A2)
        DO 800 K1=IANF,148
C       IKURA UEBERPRUEFUNG
        IZ=0
        DO 100 K2=2,11
        IF (I(K2,K1)-1)100,100,110
110     IZ=IZ+1
100     CONTINUE
        IF (IKURA-IZ)130,130,120
120     I2(K1)=I2(K1)+8
C       NONLK UEBERPRUEFUNG
130     DO 140 K3=1,15
        IF (NONLK(K3))160,160,145
145     DO 140 K2=2,3
        IF (NONLK(K3)-I(K2,K1))140,150,140
150     I2(K1)=I2(K1)+16
        GOTO 160
140     CONTINUE
C       DOPPELTES ABITURFACH
160     DO 200 K3=2,4
        K5=K3+1
C
C						SEITE 2
C
        DO 200 K2=K5,5
        IF (I(K3,K1)-I(K2,K1))200,220,200
220     I2(K1)=I2(K1)+32
        GOTO 305
200     CONTINUE
C       ABDECKUNG DER AUFGABENFELDER
305     IF (IFORM+911)306,440,306
306     DO 320 K3=1,3
        IF (KAUFG(K3,1))320,320,307
307     DO 300 K5=1,15
        IF (KAUFG(K3,K5))321,321,302
302     DO 300 K2=2,5
        IF (I(K2,K1)-KAUFG(K3,K5))300,320,300
300     CONTINUE
321     I2(K1)=I2(K1)+64
        GOTO 440
320     CONTINUE
C       ABSOLUTE FACHBELEGUNG
440     DO 420 K3=1,5
        IF (KAKBE(K3))500,500,405
405     DO 410 K2=2,11
        IF (I(K2,K1)-KAKBE(K3))410,420,410
410     CONTINUE
        I2(K1)=I2(K1)+128
        GOTO 500
420     CONTINUE
C       SUBSTITUIERBARE FACHGRUPPEN
500	DO 510 K4=1,5
	IF(KSKBE(K4,1))510,510,535
535	DO 520 K3=1,8
	IF(KSKBE(K4,K3))525,525,515
515	DO 530 K2=2,11
	IF(I(K2,K1)-KSKBE(K4,K3))530,510,530
530	CONTINUE
520	CONTINUE
525	I2(K1)=I2(K1)+256
	GOTO 800
510	CONTINUE
800	CONTINUE
	CALL CHAIN ('KUWA2D')
	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