Trailing-Edge
-
PDP-10 Archives
-
DEC-20-OT20A-D-MC9
-
2-exercise-libary/kul07c.for
There are no other files named kul07c.for in the archive.
C CRA = DATENEINGABE (CARD READER ALTERNATE)
C PRA = DRUCKAUSGABE(PRINTER ALTERNATE)
C FL1 = DATENFILE AUF TROMMEL ODER PLATTE
C FL2 = DATENFILE AUF TROMMEL ODER PLATTE
C PR = DRUCKAUSGABE(ERGEBNIS KONTROLLE)
C IP0 LAUFENDE NUMMER DES PROGRAMMES
C IP1 ANZAHL EINZUGEBENDER DATENSAETZE FUER INTEGERZAHLEN
C IP2 ANZAHL EINZUGEBENDER DATENSAETZE FUER EINFACHE GLEITKOMMAZAHLEN
C IP3 ANZAHL EINZUGEBENDER DATENSAETZE FUER DOPPELTE GLEITKOMMAZAHLEN
C IP5 GIBT AN,WIEOFT DAS PROGRAMM EINGAB DURCHLAUFEN WIRD
C IP6 GIBT AN,WIEOFT DAS PROGRAMM AUSGAB DURCHLAUFEN WIRD
C IP7 GIBT AN,WIEOFT DAS PROGRAMM FILEOP DURCHLAUFEN WIRD
C IP8 GIBT AN,WIEOFT DER BAUSTEIN FUER GLEITKOMMAARITHMETIK
C EINFACHER LAENGE DURCHLAUFEN WIRD
C IP9 GIBT AN,WIEOFT DER BAUSTEIN FUER GLEITKOMMAARITHMETIK
C DOPPELTER LAENGE DURCHLAUFEN WIRD
C IP10 GIBT AN,WIEOFT DER BAUSTEIN FUER KONVERTIERUNGEN
C DURCHLAUFEN WIRD
C IP11 GIBT AN,WIEOFT DER BAUSTEIN FUER INTEGERARITHMETIK
C DURCHLAUFEN WIRD
C IP12 GIBT AN,WIEOFT DER BAUSTEIN FUER INDEX-ARITHMETIK
C DURCHLAUFEN WIRD
C IP13 GIBT AN,WIEOFT DER BAUSTEIN FUER LOGISCHE OPERATIONEN
C DURCHLAUFEN WIRD
C IP14 GIBT AN,WIEOFT DER BAUSTEIN FUER UNTERPROGRAMMSPRUENGE
C DURCHLAUFEN WIRD
C IP15 GIBT AN,WIEOFT DAS PROGRAMM ARITOP DURCHLAUFEN WIRD
C IP16 GIBT AN,WIEOFT DAS GESAMTPROGRAMM DURCHLAUFEN WIRD
INTEGER CRA,PRA,FL1,FL2,PR
COMMON B1,B2,B3,B4,B5,B6,B7,B8,B9,B10,B11,B12,B13
COMMON D1,D2,D3,D4,D5,D6,D7,D8,D9,D10
COMMON E1,E2,E3,E4,E5,E6,E7,E8,E9,E10
COMMON IFA(10),IFB(50),IFC(100),IFD(10,10),IFE(50,50),
1 IFF(10,10,10)
COMMON IP0,IP1,IP2,IP3,IP5,IP6,IP7,IP8,IP9,IP10,IP11,IP12,IP13,
1 IP14,IP15,IP16
COMMON I1,I2,I3,I4,I5,I6,I7,I8,I9,I10,I11,I12,I13,I14,I15,I16,
1 I17,I18,I19,I20,I21,I22,I23,I24,I25,I26,I27,I28,I29,I30,
2 I31,I32,I33,I34,I35,I36,I37,I38,I39,I40
COMMON L1,L2,L3,L4,L5,L6,L7,L8,L9,L10
COMMON R1,R2,R3,R4,R5,R6,R7,R8,R9,R10
COMMON S1,S2,S3,S4,S5,S6,S7,S8,S9,S10
COMMON CRA,PRA,FL1,FL2,PR
DOUBLE PRECISION D1,D2,D3,D4,D5,D6,D7,D8,D9,D10
DOUBLE PRECISION S1,S2,S3,S4,S5,S6,S7,S8,S9,S10
LOGICAL B1,B2,B3,B4,B5,B6,B7,B8,B9,B10,B11,B12,B13
CRA = 10
PRA = 11
FL1 = 12
FL2 = 13
PR = 6
IT=0
1 READ(CRA,20) IP0,IP1,IP2,IP3,IP5,IP6,IP7,IP8,IP9,IP10,IP11,
1 IP12,IP13,IP14,IP15,IP16
IF(IT-IP16) 2,19,19
2 IC=0
3 IF(IC-IP5) 4,5,5
4 CALL EINGAB
IC=IC+1
GOTO 3
5 DO 8 I=1,10
IFA(I)=I
DO 6 II=1,5
III=(I-1)*5+II
6 IFB(III)=III
DO 8 J=1,10
IFD(I,J)=I+J
DO 7 II=1,5
III=(I-1)*5+II
DO 7 JJ=1,5
JJJ=(J-1)*5+JJ
7 IFE(III,JJJ)=III+JJJ
DO 8 K=1,10
8 IFF(I,J,K)=I+J+K
B1=.TRUE.
B2=.FALSE.
B3=.TRUE.
B4=.FALSE.
B5=.TRUE.
B6=.FALSE.
IC=0
11 IF(IC-IP15) 12,13,13
12 CALL ARITOP
IC=IC+1
GOTO 11
13 IF(IP7) 15,15,14
14 CALL FILEOP
15 IC=0
16 IF(IC-IP6) 17,18,18
17 CALL AUSGAB
IC=IC+1
GOTO 16
18 IT=IT+1
REWIND CRA
GO TO 1
19 WRITE(PR,21)
WRITE(PR,22) IP0,IP1,IP2,IP3,IP5,IP6,IP7,IP8,IP9,IP10,IP11,IP12,
- IP13,IP14,IP15,IP16
WRITE(PR,30)L1,L2,L3,L4,L5,L6,L7,L8,L9,L10
WRITE(PR,31)R1,R2,R3,R4,R5,R6,R7,R8,R9,R10
WRITE(PR,32)S1,S2,S3,S4,S5,S6,S7,S8,S9,S10
99 STOP
20 FORMAT(16I5)
21 FORMAT(1H1,
-128H IP0 IP1 IP2 IP3 IP5 IP6 IP7 I
-P8 IP9 IP10 IP11 IP12 IP13 IP14 IP15 IP16
-/1X,
-128H DATEN DATEN DATEN N* N* N* RE
-AL REAL2 INTEGER BOOL' UNTER- N* N*
-/1X,
-128H PROGR. N*40 N*10 N*10 DATEN- DRUCK- AUSF. ARIT
-H- ARITH- KONVER- ARITH- IN- ARITH- PROGR. AUSF. AUSF.
-/1X,
-128H NAME INTEGER REAL REAL2 EINGABE AUSGABE FILEOP MET
-IK METIK TIERUNG METIK DEXING METIK AUFRUF ARITHOP SYNPROG
-)
22 FORMAT(1H0,16I8)
30 FORMAT(1H0,10I10)
31 FORMAT(1H0,5E16.8)
32 FORMAT(1H0,2D32.16)
END
!@ELT,IL PF.EINGAB .
SUBROUTINE EINGAB
INTEGER CRA,PRA,FL1,FL2,PR
COMMON B1,B2,B3,B4,B5,B6,B7,B8,B9,B10,B11,B12,B13
COMMON D1,D2,D3,D4,D5,D6,D7,D8,D9,D10
COMMON E1,E2,E3,E4,E5,E6,E7,E8,E9,E10
COMMON IFA(10),IFB(50),IFC(100),IFD(10,10),IFE(50,50),
1 IFF(10,10,10)
COMMON IP0,IP1,IP2,IP3,IP5,IP6,IP7,IP8,IP9,IP10,IP11,IP12,IP13,
1 IP14,IP15,IP16
COMMON I1,I2,I3,I4,I5,I6,I7,I8,I9,I10,I11,I12,I13,I14,I15,I16,
1 I17,I18,I19,I20,I21,I22,I23,I24,I25,I26,I27,I28,I29,I30,
2 I31,I32,I33,I34,I35,I36,I37,I38,I39,I40
COMMON L1,L2,L3,L4,L5,L6,L7,L8,L9,L10
COMMON R1,R2,R3,R4,R5,R6,R7,R8,R9,R10
COMMON S1,S2,S3,S4,S5,S6,S7,S8,S9,S10
COMMON CRA,PRA,FL1,FL2,PR
DOUBLE PRECISION S1,S2,S3,S4,S5,S6,S7,S8,S9,S10
DOUBLE PRECISION D1,D2,D3,D4,D5,D6,D7,D8,D9,D10
IC=0
100 IF(IC-IP1) 101,102,102
101 READ(CRA,20) I1,I2,I3,I4,I5,I6,I7,I8,I9,I10,I11,I12,I13,
1 I14,I15,I16,I17,I18,I19,I20,I21,I22,I23,I24,I25,
2 I26,I27,I28,I29,I30,I31,I32,I33,I34,I35,I36,I37,
3 I38,I39,I40
IC=IC+1
GOTO 100
102 IC=0
103 IF(IC-IP2) 104,105,105
104 READ(CRA,21) E1,E2,E3,E4,E5,E6,E7,E8,E9,E10
IC=IC+1
GOTO 103
105 IC=0
106 IF(IC-IP3) 107,108,108
107 READ(CRA,22) D1,D2,D3,D4,D5,D6,D7,D8,D9,D10
IC=IC+1
GOTO 106
108 CONTINUE
RETURN
20 FORMAT(8I10)
21 FORMAT(5E16.8)
22 FORMAT(2D32.16)
END
!@ELT,IL PF.ARITOP .
SUBROUTINE ARITOP
COMMON B1,B2,B3,B4,B5,B6,B7,B8,B9,B10,B11,B12,B13
COMMON D1,D2,D3,D4,D5,D6,D7,D8,D9,D10
COMMON E1,E2,E3,E4,E5,E6,E7,E8,E9,E10
COMMON IFA(10),IFB(50),IFC(100),IFD(10,10),IFE(50,50),
1 IFF(10,10,10)
COMMON IP0,IP1,IP2,IP3,IP5,IP6,IP7,IP8,IP9,IP10,IP11,IP12,IP13,
1 IP14,IP15,IP16
COMMON I1,I2,I3,I4,I5,I6,I7,I8,I9,I10,I11,I12,I13,I14,I15,I16,
1 I17,I18,I19,I20,I21,I22,I23,I24,I25,I26,I27,I28,I29,I30,
2 I31,I32,I33,I34,I35,I36,I37,I38,I39,I40
COMMON L1,L2,L3,L4,L5,L6,L7,L8,L9,L10
COMMON R1,R2,R3,R4,R5,R6,R7,R8,R9,R10
COMMON S1,S2,S3,S4,S5,S6,S7,S8,S9,S10
COMMON CRA,PRA,FL1,FL2,PR
DOUBLE PRECISION S1,S2,S3,S4,S5,S6,S7,S8,S9,S10
DOUBLE PRECISION D1,D2,D3,D4,D5,D6,D7,D8,D9,D10
LOGICAL B1,B2,B3,B4,B5,B6,B7,B8,B9,B10,B11,B12,B13
200 IC=0
201 IF(IC-IP8) 202,203,203
202 R1=E1*E1+E2*E2+E3*E3+E4*E4-E6/E2+E5
R2=E1-E8-E2/E4-E3/E1-E4*E5+E6*E6+E7
R3=E1*E2+E3*E4+E5*E6+E7*E8-E9/E1+R1
R4=E1-E2-E3/E2-E4/E1-E5*E5+E6*E7+E8
R5=E1*E3+E2*E4+E5*E7+E8*E8-E9/E1+E6
R6=E1-E3-E4/E2-E2/E1-E5*E8+E6*E7+E9
R7=E9*E1+E8*E2+E7*E3+E6*E4-E5/E1+R1
R8=E9-E8-E7/E1-E6/E3-E5*E3+E4*E1+E2
R9=E8*E1+E9*E2+E7*E4+E3*E6-E5/E2+R1
R10=E6-E2-E3/E4-E1/E2-E5*E8+E4*E9+E7
IC=IC+1
GOTO 201
203 IC=0
204 IF(IC-IP9) 205,206,206
205 S1=D1*D1+D2*D2+D3*D3+D4*D4-D6/D2+D5
S2=D1-D8-D2/D4-D3/D1-D4*D5+D6*D6+D7
S3=D1*D2+D3*D4+D5*D6+D7*D8-D9/D1+S1
S4=D1-D2-D3/D2-D4/D1-D5*D5+D6*D7+D8
S5=D1*D3+D2*D4+D5*D7+D8*D8-D9/D1+D6
S6=D1-D3-D4/D2-D2/D1-D5*D8+D6*D7+D9
S7=D9*D1+D8*D2+D7*D3+D6*D4-D5/D1+S1
S8=D9-D8-D7/D1-D6/D3-D5*D3+D4*D1+D2
S9=D8*D1+D9*D2+D7*D4+D3*D6-D5/D2+S1
S10=D6-D2-D3/D4-D1/D2-D5*D8+D4*D9+D7
IC=IC+1
GOTO 204
206 IC=0
207 IF(IC-IP10) 208,209,209
208 J1=E1
J2=E2
J3=E3
J4=E4
J5=E5
J6=E6
J7=E7
T1=J1
T2=J2
T3=J3
T4=J4
T5=J5
T6=J6
T7=J7
J1=E1
J2=E2
J3=E3
J4=E4
J5=E5
J6=E6
J7=E7
T1=J1
T2=J2
T3=J3
T4=J4
T5=J5
T6=J6
T7=J7
IC=IC+1
GOTO 207
209 IC=0
210 IF(IC-IP11) 211,212,212
211 L1=I1+I2-I3+I4*I5-I6*I7+I8*I9+I10+I11
L2=I1-I2+I3+I4*I7-I5*I6-I8+I9+I11+I12
L3=I1+I4-I5+I2*I3-I8*I11+I10*I9+I6+I7
L4=I1-I4+I5+I7*I9-I11*I10-I2+I8+I3+I6
L5=I11+I12-I13+I14*I15-I16*I17+I18*I19+I20+I21
L6=I11-I12+I13+I14*I17-I15*I16-I18+I19+I21+I22
L7=I11+I14-I15+I12*I13-I18*I21+I20*I19+I16+I17
L8=I10-I14+I15+I17*I19-I21*I20-I12+I18+I13+I16
L9=I21+I22-I23+I24*I25-I26*I27+I28*I29+I30+I31
L10=I21-I22+I23+I24*I27-I25*I26-I28+I29+I31+I32
IC=IC+1
GOTO 210
212 IC=0
213 IF(IC-IP12) 214,241,241
214 ID=1
215 ID1=11-ID
IFA(ID1)=IFA(ID)
ID=ID+1
IF(ID-11) 215,216,216
216 ID=1
217 ID1=51-ID
IFB(ID1)=IFB(ID)
ID=ID+1
IF(ID-51) 217,218,218
218 JD=1
219 ID=1
220 ID1=101-ID
IFC(ID1)=IFC(ID)
ID=ID+1
IF(ID-101) 220,221,221
221 JD=JD+1
IF(JD-3) 219,222,222
222 JD=1
223 ID=1
224 ID1=11-ID
KD=1
225 KD1=11-KD
IFD(ID1,KD1)=IFD(ID,KD)
KD=KD+1
IF(KD-11) 225,226,226
226 ID=ID+1
IF(ID-11) 224,227,227
227 JD=JD+1
IF(JD-3) 223,228,228
228 JD=1
229 ID=1
230 ID1=51-ID
KD=1
231 KD1=51-KD
IFE(ID1,KD1)=IFE(ID,KD)
KD=KD+1
IF(KD-51) 231,232,232
232 ID=ID+1
IF(ID-51) 230,233,233
233 JD=JD+1
IF(JD-4) 229,234,234
234 ID=1
235 ID1=11-ID
JD=1
236 JD1=11-JD
KD=1
237 KD1=11-KD
IFF(ID1,JD1,KD1)=IFF(ID,JD,KD)
KD=KD+1
IF(KD-11) 237,238,238
238 JD=JD+1
IF(JD-11) 236,239,239
239 ID=ID+1
IF(ID-11) 235,240,240
240 IC=IC+1
GOTO 213
241 IC=0