File KUWA2.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(11,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/'ERSTMALIGE DURCHFUEHRUNG  : 1',/'FORTFUEHRUNG DER EIN
	2GABE  : 2',/'BEGINN DER AUSWERTUNG     : 3 ?',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=200*ISTA
	ISTB= 15+ISTA
	ISTD=124+ISTA
	ISTE=101+ISTA
	ISTF= 61+ISTA
	ISTG= 78+ISTA
	ISTL= 26+ISTA
	ISTM= 38+ISTA
	GOTO(1,2,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
	NUM=0
	N=1
	GOTO 4
2	DO 6 K1=1,148
	I(1,K1)=0
6	I1(1,K1)=0
	CALL RTAPE(1,-ISTF,888,I1)
	CALL RTAPE(1,-ISTG,1628,I)
	NUM=0
	N=1
	DO 7 K1=1,148
	IF(I(1,K1)) 65,7,65
65	NUM=NUM+1
7	CONTINUE
5	IF(I(1,N)) 4,4,8
8	NUM=NUM-1
	GOTO 9
C	KARTEN EINLESEN
4	WRITE (1,50)
50	FORMAT('SNR Z E ST H W LK1 LK2 3.A 4.A GK1 GK2 GK3 GK4 GK5 GK6')
	READ (1,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)
	IF(I(1,N))20,30,20
20      I1(1,N)=I(1,N)
9	N=N+1
	IF(148-NUM-N)30,5,5
30      NUM=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)
300	CALL WTAPE(1,ISTG,1628,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,1628,I)
	GOTO(400,500),KK
400	DO 60 K1=1,148
	DO 60 K2=2,11
60	I(K2,K1)=I(K2,K1)-(I(K2,K1)/10)*10
C
C						SEITE 3
C
	CALL WTAPE(1,-ISTE,1628,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('KUWA2A')
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