File KUR2A.FT (FORTRAN source file)

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


C       KURSWAHL - SORTIEREN - FALSCHE DATEN - FEHLENDE SCHUELER
        COMMON IFORM,IHALB,FILEB,FILED,FILEE,FILEF,FILEL,FILEM,FILEN
        COMMON LANF,IANF,I,IZFE,IZFA
        DIMENSION I(12,296),L(296)
        CALL IOPEN ('DTA1',FILEL)
        READ (4,10)LANF
        DO 20 K1=1,296
        READ (4,10)L(K1)
20      I(12,K1)=0
10      FORMAT (A2)
        IZFE=0
        IZFA=0
        IWEIC=1
C       SORTIEREN
100     K0=296
        DO 110 K3=LANF,296
        K4=296-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),IWEIC
300     IZFE=IZFE+1
        I(12,IZFE)=L(K4)
310     FORMAT(I3)
110     CONTINUE
C       AUSDRUCK DER FASCHEN SCH.NR
        GOTO(30,200),IWEIC
30      DO 340 K3=1,K0
        IF (I(1,K3))350,340,350
350     GOTO (360,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
        IF (K0-148)35,45,45
35      CALL OOPEN ('DTA1',FILED)
        DO 40 K1=1,148
        DO 40 K2=1,11
40      WRITE (4,10)I(K2,K1)
        CALL OCLOSE
45      CALL OOPEN ('DTA1',FILEE)
        DO 50 K1=149,296
        DO 50 K2=1,11
50      WRITE (4,10)I(K2,K1)
        CALL OCLOSE
        CALL IOPEN ('DTA1',FILEF)
        DO 70 K1=1,296
        DO 70 K2=1,6
70      READ (4,10)I(K2,K1)
        IWEIC=2
        GOTO 100
200     DO 230 K1=1,K0
230     I(1,K1)=0
        CALL OOPEN ('DTA1',FILEF)
        DO 210 K1=1,296
        DO 210 K2=1,6
210     WRITE (4,10)I(K2,K1)
        CALL OCLOSE
        IANF=K0+1
C       AUSDRUCK DER FEHLENDEN SCHUELER
        IF (IZFE)250,250,240
240     IF (LANF-148)510,510,520
510     CALL IOPEN ('DTA1',FILEN)
        DO 530 K1=1,148
        DO 530 K2=1,11
530     READ (4,10)I(K2,K1)
520     CALL IOPEN ('DTA1',FILEM)
        DO 540 K1=149,296
        DO 540 K2=1,11
540     READ (4,10)I(K2,K1)
        WRITE (1,550)
550     FORMAT (//'FEHLENDE SCHUELER!'/)
        DO 560 K1=1,IZFE
        DO 560 K2=LANF,296
        IF (I(1,K2)-I(12,IZFE-K1+1))560,570,560
570     WRITE (1,80)(I(K3,K2),K3=1,11)
80      FORMAT (I3,2X,10A2)
560     CONTINUE
        CALL IOPEN ('DTA1',FILEF)
        DO 90 K1=1,296
        DO 90 K2=1,6
90      READ (4,10)I(K2,K1)
250     CALL CHAIN ('KUR2B')
        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