File CAWA2.FT (FORTRAN source file)

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


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



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