File KUWA1.FT (FORTRAN source file)

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


C	KURSWAHL - ERSTELLEN EINER LISTE VON SCHUELERNUMMERN
        DIMENSION NAME(11,148),L(149)
        ISPAC=-2016
        WRITE(1,100)ISPAC,
100     FORMAT(/'KLASSENSTUFE:',A1)
        READ(1,275)IFORM
180	WRITE(1,120)ISPAC,
120     FORMAT('HALBJAHR:    ',A1)
        READ(1,130)IHALB
130     FORMAT(A1)
	IF(IFORM+910) 160,150,140
140	ISTA=4
	GOTO 170
150	ISTA=2
	GOTO 170
160	ISTA=0
170	IF(IHALB+928) 180,185,190
190	ISTA=ISTA+1
185	ISTA=200*ISTA
	ISTL=26+ISTA
	ISTM=38+ISTA
	ISTL=-ISTL
	ISTM=-ISTM
        DO 1 K1=1,148
        L(K1)=0
        DO 1 K2=1,11
1       NAME(K2,K1)=0
	L(149)=0
        WRITE (1,200) ISPAC,
200     FORMAT (/'EXISTIERT EINE LISTE VON SCHNR AUF BAND?',A1)
        READ (1,275)IFRAGE
        IF (IFRAGE-672)230,210,230
210     CALL RTAPE(1,ISTL,149,L)
	CALL RTAPE(1,ISTM,1628,NAME)
	L2=L(149)
	ISTL=-ISTL
        WRITE (1,213) ISPAC,
213     FORMAT (/'SOLL EINE LISTE VON SCHNR AUSGEDRUCKT WERDEN?',A1)
        READ (1,275)IFRAGE
        IF (IFRAGE-672)221,215,221
215     DO 217 K1=L2,148,10
        DO 218 K2=0,9
        IF (K1+K2-148)214,214,217
214     WRITE (1,219)L(K1+K2),
219     FORMAT (2X,I3)
218     CONTINUE
	WRITE (1,219)
217     CONTINUE
221     WRITE (1,220)
220     FORMAT (//'WELCHE SCHNR SOLLEN GELOESCHT WERDEN?')
222     READ (1,224)NUM4
224     FORMAT ('? ',I3)
        IF (NUM4)230,230,227
227     DO 226 NUM3=1,148
        IF (L(NUM3)-NUM4)226,228,226
228     L(NUM3)=0
226     CONTINUE
        GOTO 222
230     WRITE(1,232)
232     FORMAT (/'WELCHE SCHUELERNUMMERN KOMMEN NEU HINZU? ')
242     READ (1,224)NUM4
        IF (NUM4)5,5,235
235     IF (NUM4-1)233,237,233
237     L(NUM3)=0
        GOTO 242
233     DO 234 NUM1=1,148
        IF (L(NUM1)-NUM4)234,239,234
239     WRITE (1,241)
241     FORMAT ('EXISTIERT SCHON!')
        GOTO 242
234     CONTINUE
        DO 236 NUM3=1,148
        IF (L(NUM3))236,238,236
238     L(NUM3)=NUM4
	WRITE(1,380)ISPAC,
380	FORMAT('NAME:',A1)
        READ (1,390)(NAME(K,NUM3),K=2,11)
390     FORMAT (10A2)
        NAME(1,NUM3)=NUM4
        GOTO 242
236     CONTINUE
        WRITE (1,240)
240     FORMAT (/'LISTE VOLL!'//)
5       L2=1
        DO 10 L1=1,148
        IF (L(L1))20,20,10
20      L(L1)=L(L2)
        L(L2)=0
        DO 396 K1=1,11
        NAME(K1,L1)=NAME(K1,L2)
        NAME(K1,L2)=-2016
396     CONTINUE
        NAME(1,L2)=0
        L2=L2+1
10      CONTINUE
        DO 30 L1=L2,147
        L3=L1

C						SEITE 1
C	KUWA1
C
C       KURSWAHL - ERSTELLEN EINER LISTE VON SCHUELERNUMMERN
C
        COMMON NAME,L
        DIMENSION NAME(11,148),L(149)
        ISPAC=-2016
        WRITE(1,100)ISPAC,
100     FORMAT(/'KLASSENSTUFE:',A1)
        READ(1,275)IFORM
180	WRITE(1,120)ISPAC,
120     FORMAT('HALBJAHR:    ',A1)
        READ(1,130)IHALB
130     FORMAT(A1)
	IF (IFORM + 910)160,150,140
140	ISTA=4
	GOTO 170
150	ISTA=2
	GOTO 170
160	ISTA=0
170	IF(IHALB+928) 180,185,190
190	ISTA=ISTA+1
185	ISTA=200*ISTA
	ISTL=26+ISTA
	ISTM=38+ISTA
        DO 1 K1=1,148
        L(K1)=0
        DO 1 K2=1,11
1       NAME(K2,K1)=0
	L(149)=0
        WRITE (1,200) ISPAC,
200     FORMAT (/'EXISTIERT EINE LISTE VON SCHNR AUF BAND?',A1)
        READ (1,275)IFRAGE
        IF (IFRAGE-672)230,210,230
210     CALL RTAPE(1,-ISTL,149,L)
	CALL RTAPE(1,-ISTM,1628,NAME)
	L2=L(149)
        WRITE (1,213) ISPAC,
213     FORMAT (/'SOLL EINE LISTE VON SCHNR AUSGEDRUCKT WERDEN?',A1)
        READ (1,275)IFRAGE
        IF (IFRAGE-672)221,215,221
215     DO 217 K1=L2,148,10
        DO 218 K2=0,9
        IF (K1+K2-148)214,214,217
214     WRITE (1,219)L(K1+K2),
219     FORMAT (2X,I3)
218     CONTINUE
C
C						SEITE 2
C
	WRITE (1,219)
217     CONTINUE
221     WRITE (1,220)
220     FORMAT (//'WELCHE SCHNR SOLLEN GELOESCHT WERDEN?')
222     READ (1,224)NUM4
224     FORMAT ('? ',I3)
        IF (NUM4)230,230,227
227     DO 226 NUM3=1,148
        IF (L(NUM3)-NUM4)226,228,226
228     L(NUM3)=0
226     CONTINUE
        GOTO 222
230     WRITE(1,232)
232     FORMAT (/'WELCHE SCHUELERNUMMERN KOMMEN NEU HINZU? ')
242     READ (1,224)NUM4
        IF (NUM4)5,5,235
235     IF (NUM4-1)233,237,233
237     L(NUM3)=0
        GOTO 242
233     DO 234 NUM1=1,148
        IF (L(NUM1)-NUM4)234,239,234
239     WRITE (1,241)
241     FORMAT ('EXISTIERT SCHON!')
        GOTO 242
234     CONTINUE
        DO 236 NUM3=1,148
        IF (L(NUM3))236,238,236
238     L(NUM3)=NUM4
        READ (1,390)(NAME(K,NUM3),K=2,11)
390     FORMAT ('NAME: '10A2)
        NAME(1,NUM3)=NUM4
        GOTO 242
236     CONTINUE
        WRITE (1,240)
240     FORMAT (/'LISTE VOLL!'//)
5       L2=1
        DO 10 L1=1,148
        IF (L(L1))20,20,10
20      L(L1)=L(L2)
        L(L2)=0
        DO 396 K1=1,11
        NAME(K1,L1)=NAME(K1,L2)
        NAME(K1,L2)=-2016
396     CONTINUE
        NAME(1,L2)=0
        L2=L2+1
10      CONTINUE
C
C						SEITE 3
C
        DO 30 L1=L2,147
        L3=L1
        DO 40 L4=L1,148
        IF (L(L4)-L(L3))50,40,40
50      L3=L4
40      CONTINUE
        ITEM=L(L1)
        L(L1)=L(L3)
        L(L3)=ITEM
        DO 395 K1=1,11
        ITEM=NAME(K1,L1)
        NAME(K1,L1)=NAME(K1,L3)
395     NAME(K1,L3)=ITEM
30      CONTINUE
	L(149)=L2
        CALL WTAPE(1,ISTL,149,L)
275     FORMAT (A2)
        CALL WTAPE(1,-ISTM,1628,NAME)
	WRITE(1,350)ISPAC,

350 FORMAT(//'SOLL EINE SCHUELERLISTE GEDRUCKT WERDEN ?',A1) READ(1,275)IFRAGE IF(IFRAGE-672)310,320,310 320 WRITE(1,325) 325 FORMAT(////) DO 300 K1=L2,148 300 WRITE(1,330)(NAME(K2,K1),K2=1,11) 330 FORMAT(I3,3X,10A2) 310 CONTINUE 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