C SEITE 1 C KUWA2 C C KURSWAHL - DEF. DATEIEN - EINLESEN DATEN C - KORREKTURPROGRAMM ALS UPRO C COMMON IFORM,IHALB,ISTA,ISTB,ISTD,ISTE,ISTF,ISTG,ISTL,ISTM COMMON LANF,IANF,I,I2 DIMENSION I(13,148),I1(6,148),I2(148) ISPAC=-2016 C EINLESEN: KLASSENSTUFE,HALBJAHR WRITE(1,700)ISPAC, 700 FORMAT(/'KLASSENSTUFE:',A2) READ(1,210)IFORM 210 FORMAT(A2) 660 WRITE(1,220)ISPAC, 220 FORMAT(/'HALBJAHR: ',A1) READ(1,230)IHALB 230 FORMAT(A1) WRITE (1,240)ISPAC, 240 FORMAT(/'BITTE GEBEN SIE DIE ART DES PROGRAMMLAUFS AN:' 1/'KARTEN EINLESEN: 1', 2/'BEGINN DER AUSWERTUNG: 2 ?',A2) READ (1,250)IFRAGE 250 FORMAT(I1) C BERECHNEN DER DATEIADRESSEN IF(IFORM+910) 620,610,600 600 ISTA=4 GOTO 630 610 ISTA=2 GOTO 630 620 ISTA=0 630 IF(IHALB+928) 660,650,640 640 ISTA=ISTA+1 650 ISTA=245*ISTA ISTB= 12+ISTA ISTD=127+ISTA ISTE=102+ISTA ISTF= 60+ISTA ISTG= 77+ISTA ISTL= 23+ISTA ISTM= 35+ISTA GOTO(1,3),IFRAGE C FELDER LOESCHEN 1 DO 10 K1=1,148 I(1,K1)=0 10 I1(1,K1)=0 C C SEITE 2 C N=1 C KARTEN EINLESEN 4 READ(1,50)IKARTE 50 FORMAT('KARTENDECK IN DEN LESER EINGELEGT ?'A1) 5 READ (3,105)I(1,N),I1(2,N),I1(3,N),I1(4,N),I1(5,N),I1(6,N) 1,I(2,N),I(3,N),I(4,N),I(5,N),I(6,N),I(7,N),I(8,N),I(9,N) 2,I(10,N),I(11,N),I(12,N),I(13,N) IF(I(1,N))20,30,20 20 I1(1,N)=I(1,N) 9 N=N+1 GOTO 5 30 NUM=N-1 WRITE (1,40)NUM 105 FORMAT (I3,2('*',I1),'*',I2,2('*',I1),10('*',I3)) 40 FORMAT (/I3,' KARTEN EINGELESEN'/) WRITE(1,290)ISPAC, 290 FORMAT(/'SIND KORREKTUREN NOTWENDIG ?',A2) READ(1,210)IFRAGE IF(IFRAGE-672) 300,350,300 350 CALL KUKOR(I1) DO 75 K1=1,148 DO 75 K2=2,13 75 I(K2,K1)=10*I(K2,K1) 300 CALL WTAPE(1,ISTG,1924,I) CALL WTAPE(1,ISTF,888,I1) WRITE(1,260)ISPAC, 260 FORMAT(/'IST DIE EINGABE DER KURSWAHLEN VOLLSTAENDIG ?',A2) READ(1,210)IFRAGE IF(IFRAGE-672) 270,400,270 3 KK=1 280 CALL RTAPE(1,-ISTG,1924,I) GOTO(400,500),KK 400 DO 60 K1=1,148 DO 60 K2=2,13 60 I(K2,K1)=I(K2,K1)-(I(K2,K1)/10)*10 C C SEITE 3 C CALL WTAPE(1,-ISTE,1924,I) KK=2 ISTG=-ISTG GOTO 280 500 DO 70 K1=1,148 DO 70 K2=2,11 70 I(K2,K1)=I(K2,K1)/10 ISTG=-ISTG CALL CHAIN('CAWA2A') 270 STOP END READ (1,506)I(IFECO,ISNR) 506 FORMAT(I3) GOTO 40 2 CALL OOPEN ('DTA1',FILEF) DO 610 K1=1,148 DO 610 K2=1,6 610 WRITE (4,210)I1(K2,K1) CALL OCLOSE 4 CALL CHAIN ('BKUR21') END