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

C       AUSDRUCK DER FACHBELEGUNGSLISTEN
        COMMON IFORM,IHALB,FILEB,FILED,FILEE,FILEF,FILEL,FILEM,FILEN
        COMMON LANF,IANF,I,IZFA,IZFE,N
        DIMENSION I(12,296),FACH(2,42),N(67)
        WRITE (3,570)
100     FORMAT (A2)
C       UEBERTRAGEN DER FACHNAMEN VON I(12,K1) IN FACH
        ITEM=0
S       JMP GOON
SKONST, \FACH
SZAEHL, 0
SGOON,  TAD KONST
S       DCA ZAEHL
        DO 1 K1=1,252
        ITEM=I(12,K1)
S       TAD \ITEM
S       DCA I ZAEHL
S       INC ZAEHL
1       CONTINUE
C       LEISTUNGSKURSE
10      IWEI1=1
        ICA=2
        ICE=3
        GOTO 99
40      IF (IFORM+911)50,60,50
C       GRUNDKURSE KLASSE 11/2
60      IWEI1=2
        ICA=4
        ICE=11
        GOTO 99
C       3. ABITURFACH
50      IWEI1=4
        ICA=4
        ICE=4
        GOTO 99
C       4. ABITURFACH
70      IWEI1=5
        ICA=5
        ICE=5
        GOTO 99
C       GRUNDKURSE KLASSE 12 UND 13
80      IWEI1=3
        ICA=6
        ICE=11
C       BEGINN SCHLEIFE: DRUCK DER LISTEN
99      DO 300 IFA=3,67
        IF (N(IFA)+2016)120,300,120
120     IFA1=(IFA/10-1)*7+(IFA-10*(IFA/10))
C       SUCHEN DER SCHUELER FUER EIN FACH
        DO 130 K1=1,296
130     I(12,K1)=0
        K0=1
        DO 180 K1=IANF,296
        DO 180 K2=ICA,ICE
        IF (I(1,K1))180,180,140
140     IF (I(K2,K1)-IFA)180,150,180
150     I(12,K0)=I(1,K1)
        K0=K0+1
180     CONTINUE
        IF (K0-1)300,300,190
C       EINLESEN SCHUELERNAMEN
190     IF (LANF-148)205,205,215
205     CALL IOPEN ('DTA1',FILEN)
        DO 200 K1=1,148
        DO 200 K2=1,11
200     READ (4,100)I(K2,K1)
215     CALL IOPEN ('DTA1',FILEM)
        DO 210 K1=149,296
        DO 210 K2=1,11
210     READ (4,100)I(K2,K1)
C       AUSDRUCK KOPFTEXT
400     IANF1=1
410     IEND1=IANF1+49
        WRITE (3,450)IFORM,IHALB
450     FORMAT(1H1,////'KLASSENSTUFE: ',A2,'  HALBJAHR: ',A1)
        WRITE (3,420)(FACH(K1,IFA1),K1=1,2),
420     FORMAT (1H0,'FACH:  ',2A6)
        GOTO (421,422,422,424,425),IWEI1
421     WRITE (3,431)N(1),
431     FORMAT (2X'LEISTUNGSKURS',A1)
        GOTO 429
422     WRITE (3,432)N(1),
432     FORMAT (2X,'GRUNDKURS',A1)
        GOTO 429
424     WRITE (3,434)N(1),
434     FORMAT (2X,'3.ABITURFACH',A1)
        GOTO 429
425     WRITE (3,435)N(1),
435     FORMAT (2X,'4.ABITURFACH',A1)
429     IF (IANF1-1)440,430,440
440     WRITE (3,441)N(1)
441     FORMAT (3X,'(FORTSETZUNG)',A1,/////)
	GOTO 501
430	K0=K0-1
        WRITE (3,433)K0
433     FORMAT (3X,'('I4' SCHUELER)',/////)
C       DRUCK DER NAMEN
C       1. SPALTE
501	IWEI2=1
        DO 500 K1=IANF1,IEND1
        IF (I(12,K1))505,510,505
505     DO 515 K2=LANF,296
        IF (I(1,K2)-I(12,K1))515,520,515
515     CONTINUE
520     WRITE (3,525)(I(K3,K2),K3=1,11),
525     FORMAT (1H ,I3,2X,10A2)
C       2. SPALTE
        IF (IWEI2-1)530,530,550
530     IF (I(12,K1+50))535,540,535
540     IWEI2=2
        GOTO 550
535     DO 537 K2=LANF,296
        IF (I(1,K2)-I(12,K1+50))537,545,537
537     CONTINUE
545     WRITE (3,547)(I(K3,K2),K3=1,11),
547     FORMAT (10X,I3,2X,10A2)
550     WRITE (3,513)
513	FORMAT(0X)
500     CONTINUE
        WRITE (3,570)
570     FORMAT (1H1)
C       UEBERPRUEFEN: NOCH NAMEN ZU DRUCKEN?
        IF (I(12,IANF1+100))560,800,560
560     IANF1=IANF1+100
        GOTO 410
510	WRITE (3,570)
C       SCHUELERDATEN EINLESEN
800     IF (IANF-148)820,820,830
820     CALL IOPEN ('DTA1',FILED)
        DO 840 K1=1,148
        DO 840 K2=1,11
840     READ (4,100)I(K2,K1)
830     CALL IOPEN ('DTA1',FILEE)
        DO 850 K1=148,296
        DO 850 K2=1,11
850     READ (4,100)I(K2,K1)
300     CONTINUE
        GOTO (40,860,860,70,80),IWEI1
C       ENDE SCHLEIFE: DRUCK DER LISTEN
C       RESTAURIEREN DES "COMMON"-BEREICHS
860     ITEM=IANF-1
        DO 870 K1=1,ITEM
        DO 870 K2=1,11
870     I(K2,K1)=0
        FILEC=FILEB
S       TAD \FILEC
S       TAD (100
S       DCA \FILEC
        CALL IOPEN ('DTA1',FILEC)
        DO 880 K1=1,7
880     READ (4,881)RTEM
881     FORMAT(7A6)
        DO 885 K1=1,4
885     READ (4,100)ITEM
        DO 890 K1=1,296
890     READ (4,100)I(12,K1)
        CALL CHAIN ('KUR3S')
        END