Google
 

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