File KUWA2A.FT (FORTRAN source file)

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


C						SEITE 1
C	KUWA2A
C
C       KURSWAHL - SORTIEREN - FALSCHE DATEN - FEHLENDE SCHUELER
C
        COMMON IFORM,IHALB,ISTA,ISTB,ISTD,ISTE,ISTF,ISTG,ISTL,ISTM
        COMMON LANF,IANF,I,I2,IZFE,IZFA
        DIMENSION I(11,148),I2(148),I1(6,148),L(149)
        CALL RTAPE(1,ISTL,149,L)
	LANF=L(149)
	DO 20 K1=1,148
20	I2(K1)=0
10      FORMAT (A2)
        IZFE=0
        IZFA=0
        IWEIC=1
C       SORTIEREN
100     K0=148
        DO 110 K3=LANF,148
        K4=148-K3+LANF
        DO 120 K5=1,K0
        IF (I(1,K5)-L(K4))120,130,120
130     DO 150 K6=1,11
        ITEM=I(K6,K5)
        I(K6,K5)=I(K6,K0)
150     I(K6,K0)=ITEM
        K0=K0-1
        GOTO 110
120     CONTINUE
C       SCH.NR. NICHT EINGELESEN
        GOTO(300,110,110,110),IWEIC
300     IZFE=IZFE+1
        I2(IZFE)=L(K4)
310     FORMAT(I3)
110     CONTINUE
C       AUSDRUCK DER FALSCHEN SCH.NR
        GOTO(30,200,600,420),IWEIC
30      DO 340 K3=1,K0
        IF (I(1,K3))350,340,350
350     GOTO (360,370,370,370),IWEIC
360     WRITE (1,361)
361     FORMAT(//'FALSCHE SCHUELERNUMMERN !'/)
        IWEIC=2
370     WRITE (1,310)I(1,K3)
        I(1,K3)=0
        IZFA=IZFA+1
340     CONTINUE
	CALL WTAPE(1,-ISTD,1628,I)
	IWEIC=3
C
C						SEITE 2
C
	DO 610 K1=1,148
610	I(1,K1)=0
	CALL RTAPE(1,ISTE,1628,I)
	GOTO 100
600	DO 640 K1=1,K0
640	I(1,K1)=0
	CALL WTAPE(1,-ISTE,1628,I)
	DO 260 K1=1,148
260	I(1,K1)=0
	CALL RTAPE(1,ISTF,888,I1)
        DO 70 K1=1,148
        DO 70 K2=1,6
70      I(K2,K1)=I1(K2,K1)
        IWEIC=2
        GOTO 100
200     DO 230 K1=1,K0
230     I(1,K1)=0
        DO 210 K1=1,148
        DO 210 K2=1,6
210     I1(K2,K1)=I(K2,K1)
        CALL WTAPE(1,ISTF,888,I1)
	IWEIC=4
	DO 400 K1=1,148
400	I(1,K1)=0
	CALL RTAPE(1,-ISTG,1628,I)
	GOTO 100
420	DO 440 K1=1,148
	DO 440 K2=10,11
	IF(I(K2,K1)) 440,450,440
450	I(K2,K1)=100
440	CONTINUE
	CALL WTAPE(1,-ISTG,1628,I)
        IANF=K0+1
C       AUSDRUCK DER FEHLENDEN SCHUELER
        IF (IZFE)250,250,240
240	CALL RTAPE(1,ISTM,1628,I)
        WRITE (1,550)
550     FORMAT (//'FEHLENDE SCHUELER!'/)
        DO 560 K1=1,IZFE
        DO 560 K2=LANF,148
        IF (I(1,K2)-I2(IZFE-K1+1))560,570,560
570     WRITE (1,80)(I(K3,K2),K3=1,11)
80      FORMAT (I3,2X,10A2)
560     CONTINUE
250	CALL RTAPE(1,-ISTF,888,I1)
	DO 90 K1=1,148
	DO 90 K2=1,6
90	I(K2,K1)=I1(K2,K1)
	CALL CHAIN ('KUWA2B')
        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