File KUR1.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
        COMMON NAME,L
        DIMENSION NAME(11,296),L(296)
        ISPAC=-2016
        WRITE(1,100)ISPAC,
100     FORMAT(/'KLASSENSTUFE:',A1)
        READ(1,275)IFORM
        WRITE(1,120)ISPAC,
120     FORMAT('HALBJAHR:    ',A1)
        READ(1,130)IHALB
130     FORMAT(A1)
        FILEB=0
        FILEL=0
        FILEM=0
        FILEN=0
S       TAD \IHALB
S       AND (7700
S       7102
S       TAD (200
S       DCA \FILEB
S       TAD \FILEB
S       TAD (1200
S       DCA \FILEL
S       TAD \FILEL
S       TAD (100
S       DCA \FILEM
S       TAD \FILEM
S       TAD (100
S       DCA \FILEN
S       TAD \IFORM
S       DCA \FILEB#
S       TAD \IFORM
S       DCA \FILEL#
S       TAD \IFORM
S       DCA \FILEM#
S       TAD \IFORM
S       DCA \FILEN#
        DO 1 K1=1,296
        L(K1)=0
        DO 1 K2=1,11
1       NAME(K2,K1)=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 IOPEN ('DTA1',FILEL)
        READ (4,275) L2
        DO 211 K1=1,296
211     READ (4,275)L(K1)
        IF (L2-148)350,350,340
350     CALL IOPEN ('DTA1',FILEN)
        DO 320 K1=1,148
        DO 320 K2=1,11
320     READ (4,275)NAME(K2,K1)
340     CALL IOPEN ('DTA1',FILEM)
        DO 330 K1=149,296
        DO 330 K2=1,11
330     READ (4,275)NAME(K2,K1)
        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,296,10
        DO 218 K2=0,9
        IF (K1+K2-296)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,296
        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,296
        IF (L(NUM1)-NUM4)234,239,234
239     WRITE (1,241)
241     FORMAT ('EXISTIERT SCHON!')
        GOTO 242
234     CONTINUE
        DO 236 NUM3=1,296
        IF (L(NUM3))236,238,236
238     L(NUM3)=NUM4
        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,296
        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,295
        L3=L1
        DO 40 L4=L1,296
        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
        CALL OOPEN ('DTA1',FILEL)
        WRITE (4,275)L2
        DO 270 K1=1,296
270     WRITE (4,275)L(K1)
275     FORMAT (A2)
        CALL OCLOSE
        IF (L2-148)360,360,370
360     CALL OOPEN ('DTA1',FILEN)
        DO 300 K1=1,148
        DO 300 K2=1,11
300     WRITE (4,275)NAME(K2,K1)
        CALL OCLOSE
370     CALL OOPEN ('DTA1',FILEM)
        DO 310 K1=149,296
        DO 310 K2=1,11
310     WRITE (4,275)NAME(K2,K1)
        CALL OCLOSE
        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