Google
 

Trailing-Edge - PDP-10 Archives - decuslib10-01 - 43,50071/simple.f4
There are no other files named simple.f4 in the archive.
C     TITLE 'SIMPLE' IV                                                         
C     SIMULATION PROBLEM-ORIENTED LANGAUGE FOR ENGINEERS                        
C     B.P. MOLINARI,P.O. DUFTY,P.I. COOPER                                      
C     UNIVERSITY OF W.A.                                                        
C                                                                               
C      DIMENSIONING ARRAYS                                                      
      COMMON NDEV1,NDEV2,LWIDTH                                                 
      COMMON ISY,NTYPE,MPAR,KPAR,MM                                             
      COMMON NEQ,NH,NOUT,IOU                                                    
      COMMON NPR(4,8),TTL(2,12),ARITH(6)                                        
      COMMON NDF(5,4),TP( 80),SYMB(50)                                          
      COMMON PAR(1000),VAL(1100),MAP(4000)                                      
      COMMON DFG(4,50)                                                          
      DIMENSION CTROL(10,2),BLOCK(6,6),OUT(4)                                   
      DIMENSION ITEMP(30)                                                       
C      1. CONSTANTS SECTION                                                     
      CTROL(1,1)=5HNEWJO                                                        
      CTROL(1,2)=5HB                                                            
      CTROL(2,1)=5HPROGR                                                        
      CTROL(2,2)=5HAM                                                           
      CTROL(3,1)=5HDATA                                                         
      CTROL(4,1)=5HOUTPU                                                        
      CTROL(4,2)=5HT                                                            
      CTROL(5,1)=5HRUN                                                          
      CTROL(6,1)=5HFINIS                                                        
      CTROL(6,2)=5HH                                                            
      CTROL(3,2)=5H                                                             
      CTROL(5,2)=5H                                                             
      BLANK=5H                                                                  
      BLOCK(1,1)=5HSQR                                                          
      BLOCK(1,2)=5HEXP                                                          
      BLOCK(1,3)=5HLN                                                           
      BLOCK(1,4)=5HAT                                                           
      BLOCK(1,5)=5HABS                                                          
      BLOCK(1,6)=5HPOW                                                          
      BLOCK(2,1)=5HMUL                                                          
      BLOCK(2,2)=5HDIV                                                          
      BLOCK(2,3)=5HSUM                                                          
      BLOCK(2,4)=5HNEG                                                          
      BLOCK(2,5)=5HERR                                                          
      BLOCK(2,6)=5HSPL                                                          
      BLOCK(3,1)=5HBB                                                           
      BLOCK(3,2)=5HLIM                                                          
      BLOCK(3,3)=5HDS                                                           
      BLOCK(3,4)=5HIR                                                           
      BLOCK(3,5) = 5HRFG                                                        
      BLOCK(3,6)=5HRDH                                                          
      BLOCK(4,1)=5HRES                                                          
      BLOCK(4,3)=5HOR                                                           
      BLOCK(5,1)=5HDFG                                                          
      BLOCK(5,2)=5HDEL                                                          
      BLOCK(6,1)=5HINT                                                          
      BLOCK(6,2)=5HALG                                                          
      BLOCK(6,3)=5HTRF                                                          
      ARITH(1)=5H(                                                              
      ARITH(2)=5H)                                                              
      ARITH(3)=5H*                                                              
      ARITH(4)=5H/                                                              
      ARITH(5)=5H+                                                              
      ARITH(6)=5H-                                                              
      CONST=5HCONST                                                             
      OUT(1)=5HTITLE                                                            
      OUT(2)=5HINTVL                                                            
      OUT(3)=5HPRINT                                                            
      OUT(4)=5HWRITE                                                            
      COMMA=5H,                                                                 
      JPRG=0                                                                    
C      2. CONTROL SECTION                                                       
  100 NTYPE=1                                                                   
      NDEV1=5                                                                   
      NDEV2=3                                                                   
      WRITE(NDEV1,101)                                                          
  101 FORMAT(//)                                                                
      CALL READ                                                                 
  110 DO 119 I1=1,6                                                             
      DO 112 J1=1,2                                                             
      IF(SYMB(J1)-CTROL(I1,J1))119,112,119                                      
  112 CONTINUE                                                                  
      N=NO(BLANK)                                                               
      IF(N) 120,120,115                                                         
  115 IF(I1-5) 116,117,117                                                      
  116 NDEV1=N                                                                   
      DATRD=SYMB(3)                                                             
      CALL IFILE(NDEV1,DATRD)                                                   
      GO TO 120                                                                 
  117 NDEV2=N                                                                   
      RUNWR=SYMB(3)                                                             
      CALL OFILE(NDEV2,RUNWR)                                                   
      GO TO 120                                                                 
  119 CONTINUE                                                                  
      GO TO 190                                                                 
  120 GO TO (50,200,500,600,300,160),I1                                         
  160 STOP                                                                      
  180 WRITE(5,181)                                                              
  181 FORMAT     (26H**ILLEGAL COMMAND SEQUENCE)                                
      GO TO 100                                                                 
  190 WRITE(5,191)                                                              
  191 FORMAT     (18H** ILLEGAL COMMAND)                                        
      GO TO 100                                                                 
C      3. CLEAR SECTION                                                         
   50 LEVEL=0                                                                   
      ISY=0                                                                     
      IOU=0                                                                     
      LPROG=0                                                                   
      IDF=0                                                                     
   60 DO 61 I=1,1000                                                            
   61 PAR(I)=BLANK                                                              
      DO 62 I=1,1100                                                            
   62 VAL(I)=0.0                                                                
      DO 63 I=1,4000                                                            
   63 MAP(I)=0                                                                  
      DO 64 I=1,5                                                               
      DO 64 J=1,4                                                               
  64  NDF(I,J)=0                                                                
      NDF(1,2)=1                                                                
      DO 55 I=1,4                                                               
      DO 55 J=1,50                                                              
  55  DFG(I,J)=0.0                                                              
      PAR(10)=5HT                                                               
      VAL(9)=1.0                                                                
      PAR(8)=5HXSTOP                                                            
      PAR(7)=5HISTEP                                                            
      VAL(7)=0.1                                                                
      MM=100                                                                    
      MPAR=10                                                                   
      KPAR=1001                                                                 
      NEQ=1                                                                     
      MAP(1)=10                                                                 
      MAP(3901)=9                                                               
      IF(JPRG) 70,70,65                                                         
   65 WRITE(NDEV2,66)                                                           
  66  FORMAT(1H1)                                                               
   70 JPRG=JPRG+1                                                               
      GO TO 100                                                                 
C      4. SYSTEM DESCRIPTION SECTION                                            
  200 IF(LEVEL)180,201,180                                                      
  201 LEVEL=1                                                                   
  205 NTYPE=2                                                                   
      CALL READ                                                                 
      IF(ISY) 205,224,224                                                       
 224  IF(SYMB(1)-ARITH(3))225,240,225                                           
  225 IF(SYMB(1)-CONST)2000,230,2000                                            
  230 KPAR=KPAR+1-ISY                                                           
      DO235 K=2,ISY                                                             
  235 PAR(KPAR+K-2)=SYMB(K)                                                     
      GO TO 205                                                                 
  240 CONTINUE                                                                  
      IF(LPROG) 241,2600,241                                                    
  241 WRITE(5,242)                                                              
  242 FORMAT(25H** ERRORS IN SYSTEM DESC.)                                      
      GO TO 100                                                                 
  245 GO TO 100                                                                 
  260 WRITE(5,261)                                                              
  261 FORMAT     (19H** NONVALID PROGRAM)                                       
      GO TO 100                                                                 
 2000 JI=0                                                                      
      IRT=0                                                                     
 2001 DO 2005I20=1,ISY                                                          
      IF(SYMB(I20)-ARITH(1))2005,2010,2005                                      
 2005 CONTINUE                                                                  
      GO TO 2090                                                                
 2010 DO 2015 I21=1,6                                                           
      DO2015J21=1,6                                                             
      IF(SYMB(I20-1)-BLOCK(I21,J21))2015,2020,2015                              
 2015 CONTINUE                                                                  
      GO TO 2092                                                                
 2020 J=J21                                                                     
      GO TO (2025,2025,2025,2050,2060,2070),I21                                 
 2025 N=JPAR(SYMB(1))                                                           
      DO 2029 I=100,MM-1                                                        
      IF(MAP(I))2029,2027,2029                                                  
 2027 IF(MAP(I+3)-N)2029,2094,2029                                              
 2029 CONTINUE                                                                  
      DO2039I=1,NEQ                                                             
      IF(MAP(I)-N)2039,2094,2039                                                
 2039 CONTINUE                                                                  
      IF(JI)2072,2040,2072                                                      
 2040 MAP(MM+3)=N                                                               
      MAP(MM+2)=J                                                               
      MAP(MM+1)=I21                                                             
      DO 2041 I=4,ISY-1                                                         
 2041 MAP(MM+I)=JPAR(SYMB(I))                                                   
      MM=MM+ISY                                                                 
      IF(IRT)2160,2045,2055                                                     
 2045 IF(I21-5) 205,2215,205                                                    
 2050 IRT=1                                                                     
      ISY=ISY-1                                                                 
      TMP =SYMB(1)                                                              
      DO2051I=1,ISY                                                             
 2051 SYMB(I)=SYMB(I+1)                                                         
      GO TO 2025                                                                
 2055 SYMB(1)= TMP                                                              
      J=J+1                                                                     
      IRT=0                                                                     
      GO TO 2025                                                                
 2060 IDF=IDF+1                                                                 
      NDF(IDF,1) = JPAR(SYMB(1))                                                
      NDF(IDF,3) = NDF(IDF,2) -1 +NO(BLANK)                                     
      IF(IDF-5) 2210,2210,2211                                                  
 2210 NDF(IDF+1,2) = NDF(IDF,3) + 1                                             
 2211 ISY=ISY-1                                                                 
      GO TO 2025                                                                
 2215 MAP(MM)=IDF                                                               
      MM=MM+1                                                                   
      GO TO 205                                                                 
 2070 GO TO (2071,2100,2085,2085,2085,2085),J                                   
 2071 JI=1                                                                      
      GO TO 2025                                                                
 2072 NEQ=NEQ+1                                                                 
      MAP(NEQ)=N                                                                
      MAP(3900+NEQ)=JPAR(SYMB(4))                                               
      GO TO 205                                                                 
 2085 WRITE(NDEV2,2086)                                                         
 2086 FORMAT(15X,33H  * BLOCK TYPE NOT YET AVAILABLE )                          
      LPROG=1                                                                   
      GO TO 205                                                                 
 2090 WRITE(NDEV2,2091)                                                         
 2091 FORMAT(15X,20H  * INCORRECT FORMAT)                                       
      LPROG=1                                                                   
      GO TO 205                                                                 
 2092 WRITE(NDEV2,2093)                                                         
 2093 FORMAT(15X,23H  * ILLEGAL BLOCK TYPE )                                    
      LPROG=1                                                                   
      GO TO 205                                                                 
 2094 WRITE(NDEV2,2095)                                                         
 2095 FORMAT(15X,27H  * OUTPUT ALREADY DEFINED )                                
      LPROG=1                                                                   
      GO TO 205                                                                 
 2100 DO 2101 I=1,30                                                            
 2101 TP(I) = SYMB(I)                                                           
      IT = ISY                                                                  
 2110 DO 2119 IA=3,IT                                                           
      IF(TP(IA) - ARITH(1)) 2111,2118,2111                                      
 2111 IF(TP(IA) - ARITH(2)) 2119,2115,2119                                      
 2115 LE = IA - 1                                                               
      GO TO 2120                                                                
 2118 LB = IA+1                                                                 
 2119 CONTINUE                                                                  
      GO TO 2090                                                                
 2120 IF(LE-LB) 2690,2180,2121                                                  
 2121 KOP = 1                                                                   
      DO 2129 JA=3,6                                                            
      DO 2129 KA=LB,LE                                                          
      IF(TP(KA) - ARITH(JA)) 2129,2130,2129                                     
 2129 CONTINUE                                                                  
      GO TO 2090                                                                
 2130 GO TO (2690,2690,2140,2141,2142,2143),JA                                  
 2140 SYMB(2) = BLOCK(2,1)                                                      
      GO TO 2150                                                                
 2141 SYMB(2) = BLOCK(2,2)                                                      
      GO TO 2150                                                                
 2142 SYMB(2) = BLOCK(2,3)                                                      
      GO TO 2150                                                                
 2143 SYMB(2) = BLOCK(2,5)                                                      
 2150 SYMB(1) = DPAR(IOU)                                                       
      SYMB(3) = ARITH(1)                                                        
      SYMB(4) = TP(KA-1)                                                        
 2151 SYMB(4+KOP) = TP(KA-1+2*KOP)                                              
      IF(TP(KA+2*KOP) - ARITH(JA)) 2155,2152,2155                               
 2152 KOP = KOP+1                                                               
      GO TO 2151                                                                
 2155 ISY = 5+KOP                                                               
      SYMB(ISY) = ARITH(2)                                                      
      IRT = -1                                                                  
      GO TO 2001                                                                
 2160 TP(KA-1) = SYMB(1)                                                        
      DO 2161 I=KA,IT                                                           
 2161  TP(I)=TP(I+2*KOP)                                                        
      IT = IT-2*KOP                                                             
      LE = LE-2*KOP                                                             
      GO TO 2120                                                                
 2180 IF(LE-4) 2090,2185,2181                                                   
 2181 TP(LB+1) = TP(LB)                                                         
      DO 2182 I = LB+1,IT                                                       
 2182 TP(I-2) = TP(I)                                                           
      IT = IT-2                                                                 
      GO TO 2110                                                                
 2185 N = JPAR(TP(1))                                                           
      NI = JPAR(TP(4))                                                          
      DO 2189 I=1,4000                                                          
      IF(MAP(I) - NI) 2189,2186,2189                                            
 2186 MAP(I) = N                                                                
      PAR(NI) = BLANK                                                           
 2189 CONTINUE                                                                  
      GO TO 205                                                                 
C      SORTER SUBSECTION                                                        
 2600 IND=0                                                                     
      IPASS=0                                                                   
      MSORT=100                                                                 
      MTBE=100                                                                  
      TYPE 9004                                                                 
      ACCEPT 9005,NY                                                            
      Y=1HY                                                                     
      N=1HN                                                                     
      IF(NY .EQ. N) GO TO 2615                                                  
      PRINT 9001,(MAP(I),I=1,4000)                                              
      PRINT 9002,(PAR(K),K=1,1000)                                              
 9001 FORMAT (8I14)                                                             
 9002 FORMAT (15A5)                                                             
 9004 FORMAT (' TYPE Y FOR STORAGE ARRAY OR N IF NOT REQUIRED'/)                
 9005 FORMAT (A1)                                                               
      GO TO 2615                                                                
 2611 IF(MTBE-MM)2615,2612,2612                                                 
 2612 IF(IPASS)2613,2700,2613                                                   
 2613 MTBE=MSORT                                                                
      IPASS=0                                                                   
 2615 MTBS=MTBE                                                                 
      DO2619I=1,25                                                              
      IF(MAP(MTBS+I))2619,2620,2619                                             
 2619 CONTINUE                                                                  
      GO TO 2690                                                                
 2620 MTBE=MTBS+I                                                               
 2621 DO2640I=MTBS+4,MTBE-1                                                     
      IF(MAP(I) - KPAR) 2622,2640,2640                                          
 2622 IF(MAP(I) - 10) 2640,2640,2623                                            
 2623 DO2625J=1,MSORT-1                                                         
      IF(MAP(I)-MAP(J))2625,2640,2625                                           
 2625 CONTINUE                                                                  
      IF(IND)2631,2611,2700                                                     
 2631 ISY=ISY+1                                                                 
      SYMB(ISY)=PAR(MAP(I))                                                     
 2640 CONTINUE                                                                  
      IF(IND)2710,2641,245                                                      
 2641 DO2642I=1,MTBE-MTBS                                                       
 2642 ITEMP(I)=MAP(MTBS+I)                                                      
      DO2643I=1,MTBS-MSORT                                                      
 2643 MAP(MTBE+1-I)=MAP(MTBS+1-I)                                               
      DO2644I=1,MTBE-MTBS                                                       
 2644 MAP(MSORT+I)=ITEMP(I)                                                     
      MSORT=MSORT+MTBE-MTBS                                                     
      IPASS=IPASS+1                                                             
      IF(MSORT-MM)2611,2650,2650                                                
 2650 IND=1                                                                     
 2651 MTBS=3897                                                                 
      MTBE=3901+NEQ                                                             
      GO TO 2621                                                                
 2690 WRITE(NDEV2,2691)                                                         
 2691 FORMAT(10X,24H  * THIS SHOULDNT HAPPEN)                                   
      GO TO 260                                                                 
 2700 WRITE(NDEV2,2701)                                                         
 2701 FORMAT(//10X,21H ** NONVALID PROGRAM )                                    
 2702 WRITE(NDEV2,2703)                                                         
 2703 FORMAT(//10X,47H  * IMPLICIT LOOP AND/OR UNDEFINED BLOCK-INPUTS)          
      ISY=0                                                                     
      IF(IND)2690,2705,2706                                                     
 2705 IND=-1                                                                    
      GO TO 2613                                                                
 2706 IND=-2                                                                    
      GO TO 2651                                                                
 2710 IF(ISY)2690,2720,2711                                                     
 2711 WRITE(NDEV2,2712)(SYMB(I),I=1,ISY)                                        
 2712 FORMAT(A20,10A7)                                                          
      ISY=0                                                                     
 2720 IF(IND+2)2690,260,2725                                                    
 2725 IF(MM-MTBE)2690,2706,2615                                                 
C      5. DATA SECTION                                                          
  500 IF(LEVEL-1)180,501,501                                                    
  501 LEVEL=2                                                                   
      JDF=0                                                                     
 505  NTYPE = 3                                                                 
      CALL READ                                                                 
  520 IF(SYMB(1)-ARITH(3)) 521,570,521                                          
  521 DO 522 J=1,IDF                                                            
      IF(JPAR(SYMB(2))-NDF(J,1)) 522,523,522                                    
  522 CONTINUE                                                                  
      JD=0                                                                      
      GO TO 530                                                                 
  523 JD=J                                                                      
       JDF=1                                                                    
      NE=NO(BLANK)                                                              
      DO 526 I=1,LWIDTH                                                         
      IF(TP(LWIDTH-I)-COMMA) 525,524,525                                        
  524 TP(LWIDTH-I)=BLANK                                                        
      GO TO 527                                                                 
  525 TP(LWIDTH-I)=BLANK                                                        
  526 CONTINUE                                                                  
  527 NS=NO(BLANK)                                                              
      IF(NS) 528,529,529                                                        
  528 NS=NE                                                                     
  529 ISY=2*(NE-NS+1)                                                           
  530 READ(NDEV1,531)(TP(I),I=1,ISY)                                            
  531 FORMAT(20F)                                                               
  532 WRITE(NDEV2,533)(TP(I),I=1,ISY)                                           
  533 FORMAT (15X,1P8E13.4)                                                     
  535 IF(JD) 560,536,560                                                        
  536 DO 550 I=1,ISY                                                            
      N=JPAR(SYMB(I))                                                           
      DO540J=1,NEQ                                                              
      IF(N-MAP(J))540,545,540                                                   
  540 CONTINUE                                                                  
      VAL(N)=TP(I)                                                              
      GO TO 550                                                                 
  545 VAL(1000+J)=TP(I)                                                         
  550 CONTINUE                                                                  
      GO TO 505                                                                 
  560 N1=NDF(JD,2)                                                              
      DO 565 I=NS,NE                                                            
      DFG(1,N1+I-1)=TP(2*(I-NS)+1)                                              
  565 DFG(2,N1+I-1)=TP(2*(I-NS)+2)                                              
      NDF(JD,4)=1                                                               
      GO TO 505                                                                 
  570 IF(JDF) 100,100,571                                                       
  571 DO 575 I=1,5                                                              
      IF(NDF(I,4)) 572,575,572                                                  
  572 DO 573 J=NDF(I,2),NDF(I,3)-1                                              
      TMP=DFG(1,J+1) - DFG(1,J)                                                 
      DFG(3,J)=(DFG(2,J+1)-DFG(2,J))/TMP                                        
  573 DFG(4,J)=(DFG(1,J+1)*DFG(2,J)-DFG(1,J)*DFG(2,J+1))/TMP                    
      DFG(4,NDF(I,3))=DFG(2,NDF(I,2))                                           
      NDF(I,4)=0                                                                
  575 CONTINUE                                                                  
      GO TO 100                                                                 
C      6. OUTPUT SECTION                                                        
  600 IF(LEVEL-1)180,601,601                                                    
  601 LEVEL=2                                                                   
      JPR=1                                                                     
  602 DO 603 I=1,4                                                              
      NPR(I,1)=1                                                                
      DO 603 J=2,8                                                              
  603 NPR(I,J)=0                                                                
      DO 604 I=1,2                                                              
      DO 604 J=1,12                                                             
  604 TTL(I,J)=BLANK                                                            
 605  NTYPE=4                                                                   
      CALL READ                                                                 
      IF(SYMB(1)-ARITH(3))625,100,625                                           
  625 IF(SYMB(1)-OUT(1))626,640,626                                             
  626 IF(SYMB(1)-OUT(2))627,650,627                                             
  627 IF(SYMB(1)-OUT(3))628,659,628                                             
  628 IF(SYMB(1)-OUT(4))690,658,690                                             
  640 IF(TTL(1,1)-BLANK) 642,641,642                                            
  641 NTT=1                                                                     
      GO TO 645                                                                 
  642 NTT=2                                                                     
  645 DO 646 I=2,ISY                                                            
  646 TTL(NTT,I-1) = SYMB(I)                                                    
      GO TO 605                                                                 
  650 DO 651 I=JPR,4                                                            
  651 NPR(I,1)=NO(BLANK)                                                        
      GO TO 605                                                                 
  658 IFORM=0                                                                   
      GO TO 660                                                                 
  659 IFORM=+1                                                                  
 660  DO 665 I=2,ISY                                                            
 665  NPR(JPR,I+1) = JPAR(SYMB(I))                                              
      JPR=JPR+1                                                                 
      IF(JPR - 5) 605,690,690                                                   
  690 WRITE(NDEV2,691)                                                          
  691 FORMAT(15X,31H  * TOO MANY OUTPUT STATEMENTS )                            
      GO TO 160                                                                 
C      7. RUN SECTION                                                           
  300 IF(LEVEL-2) 180,301,301                                                   
  301 LEVEL=3                                                                   
  305 NH=0                                                                      
      NOUT=0                                                                    
      DO 306 I=1,4                                                              
  306  NPR(I,2)=0                                                               
      CALL INT(IFORM)                                                           
      WRITE(NDEV2,311)                                                          
  311 FORMAT(///22H  **  RUN FINISHED  **////)                                  
      ENDFILE NDEV2                                                             
      GO TO 100                                                                 
      END                                                                       
C     P.I. COOPER MECH. ENG. JOOB NO. 010 27-4-67                               
C     YDASH 4                                                                   
      SUBROUTINE YDASH(Y,X,INTJ)                                                
      COMMON IZ(7),MM,NEQ,IX(2),IOU                                             
      COMMON DUM(62),N(5,4),A(80)                                               
      COMMON DUMI(1050),V(1100),M(4000)                                         
      COMMON D(4,50)                                                            
      DIMENSION Y(100),X(100)                                                   
      DO 50 I=1,NEQ                                                             
  50  V(M(I))=Y(I)                                                              
   59 IE=100                                                                    
  60  IS=IE                                                                     
      DO 70 I=IS+1,IS+100                                                       
      IF(M(I)) 70,75,70                                                         
  70  CONTINUE                                                                  
  75  IE=I                                                                      
      IR=IE-IS-3                                                                
      DO 80 I=1,IR                                                              
  80  A(I) = V(M(IS+2+I))                                                       
      GO TO(81,82,83,84,85   ),M(IS+1)                                          
  81  GO TO(110,120,130,140,150,160),M(IS+2)                                    
  82  GO TO(210,220,230,240,250,260),M(IS+2)                                    
  83  GO TO (310,320,330,340,350,360),M(IS+2)                                   
  84  GO TO (420,410,440,430,450,460),M(IS+2)                                   
  85  GO TO(510,520,530,540,550,560),M(IS+2)                                    
  110 A(1)=SQRT(A(2))                                                           
      GO TO 700                                                                 
  120 A(1)=EXP(A(2))                                                            
      GO TO 700                                                                 
  130 A(1)=ALOG(A(2))                                                           
      GO TO 700                                                                 
  140 A(1)=ATAN(A(2))                                                           
      GO TO 700                                                                 
  150 A(1)=ABS(A(2))                                                            
      GO TO 700                                                                 
  160 A(1)=A(2)**A(3)                                                           
      GO TO 700                                                                 
  210  A(1) = A(2)                                                              
      DO 215 I=3,IR                                                             
  215 A(1) = A(1)*A(I)                                                          
      GO TO 700                                                                 
  220 A(1) = A(2)/A(3)                                                          
      GO TO 700                                                                 
  230 A(1) = A(2)                                                               
      DO 235 I=3,IR                                                             
  235 A(1) = A(1) + A(I)                                                        
      GO TO 700                                                                 
  240 A(1)= -A(2)                                                               
      IF(IR-2) 700,700,251                                                      
  250 A(1) = A(2)                                                               
  251 DO 255 I=3,IR                                                             
  255 A(1) = A(1) - A(I)                                                        
      GO TO 700                                                                 
  260 A(1)=(A(2)*(A(3)-A(4))/A(5)+A(6)*(A(7)-A(8))/A(9)-A(10)*(A(11)-A(1        
     12))/A(13)-A(14)*(A(15)-A(16))/A(17))/A(18)                                
      GO TO 700                                                                 
  310 IF(A(2)) 312,315,315                                                      
  312 A(1) =-1.0                                                                
      GO TO 700                                                                 
  315 A(1) = 1.0                                                                
      GO TO 700                                                                 
  320 A(1) = A(2)                                                               
      IF(A(4) - A(2)) 325,700,321                                               
  321 A(1) = A(4)                                                               
      GO TO 700                                                                 
  325 IF(A(2) - A(3)) 700,700,326                                               
  326 A(1) = A(3)                                                               
      GO TO 700                                                                 
  330 A(1) = 0.0                                                                
      IF(A(2)-A(3)) 335,700,332                                                 
  332 A(1) = A(2)-A(3)                                                          
      GO TO 700                                                                 
  335  IF(A(2)-A(4)) 336,700,700                                                
  336 A(1) = A(2) - A(4)                                                        
      GO TO 700                                                                 
  340 IF(A(4)) 345,341,341                                                      
  341 A(1)= A(2)                                                                
      GO TO 700                                                                 
  345 A(1) = A(3)                                                               
      GO TO 700                                                                 
C     RANDOM FUNCTION GENERATOR                                                 
  350 IF(V(10))533,532,533                                                      
  532 X03=0.                                                                    
      X04=0.                                                                    
      IU=123456789.*A(2)                                                        
      A(1)=0.                                                                   
      A(2)=0.                                                                   
  533 IF(INTJ-2)534,535,534                                                     
  534 IF(INTJ-4)700,535,700                                                     
  535 CALL RNG(IU,X03)                                                          
      X04=(X03+ 37.4*A(1)- 16.1*A(2))/22.3                                      
      V(M(IS+4))=A(1)                                                           
      A(1)=X04                                                                  
      GO TO 700                                                                 
C                                                                               
  360 IF(ABS(A(2))-A(3))541,541,542                                             
  541 A(1)=0.                                                                   
      GO TO 700                                                                 
  542 IF(A(2)-A(4))544,543,543                                                  
  543 A(1)=A(5)                                                                 
      GO TO 700                                                                 
  544 IF(A(2)+A(4))545,545,546                                                  
  545 A(1)=-A(5)                                                                
      GO TO 700                                                                 
  546 IF(A(1))548,547,549                                                       
  547 A(1)=0.                                                                   
      GO TO 700                                                                 
  548 A(1)=-A(5)                                                                
      GO TO 700                                                                 
  549 A(1)=A(5)                                                                 
      GO TO 700                                                                 
  410 A(1)=SIN(A(2))                                                            
      GO TO 700                                                                 
  420 A(1)=COS(A(2))                                                            
      GO TO 700                                                                 
  430 A(1) = A(2)                                                               
      IF(A(3)) 431,700,700                                                      
  431 A(1) = 0.0                                                                
      GO TO 700                                                                 
  440 A(1) = 0.0                                                                
      IF(A(3)) 700,441,441                                                      
  441 A(1) = A(2)                                                               
      GO TO 700                                                                 
 450  GO TO 700                                                                 
 460  GO TO 700                                                                 
  510 N1=N(M(IS+5),2)                                                           
      N2=N(M(IS+5),3)                                                           
      IF(A(2) - D(1,N1)) 511,512,512                                            
  511 A(1) = D(4,N2)                                                            
      GO TO 700                                                                 
  512 IF(D(1,N2) - A(2)) 513,513,515                                            
  513 A(1) = D(2,N2)                                                            
      GO TO 700                                                                 
  515 DO 519 I=N1,N2-1                                                          
      IF(D(1,I+1)-A(2)) 519,516,516                                             
  516 A(1) = D(3,I)*A(2) + D(4,I)                                               
      GO TO 700                                                                 
  519 CONTINUE                                                                  
 520  GO TO 700                                                                 
  530 GO TO 700                                                                 
  540 GO TO 700                                                                 
 550  GO TO 700                                                                 
 560  GO TO 700                                                                 
  700 V(M(IS+3)) = A(1)                                                         
      IF(IE - MM) 60,710,710                                                    
 710  DO 711 I=1,NEQ                                                            
  711 X(I)=V(M(3900+I))                                                         
      RETURN                                                                    
      END                                                                       
      SUBROUTINE READ                                                           
C      READS A LINE OR CARD , INTERPRETS ,                                      
C         PACKS IT CORRECTLY INTO SYMB ARRAY .                                  
      COMMON NDEV1,NDEV2,LW                                                     
      COMMON IB,N,IZ(7)                                                         
      COMMON DUM(56),ARITH(6),Z9(20)                                            
      COMMON A(80),B(50)                                                        
      CONST=5HCONST                                                             
      TITLE = 5HTITLE                                                           
      COMMA=5H,                                                                 
      BLANK=5H                                                                  
      EQUAL=5H=                                                                 
      IF(NDEV1-5) 9,5,9                                                         
   5  IF(N-1) 7,6,7                                                             
   6  LW=15                                                                     
      GO TO 10                                                                  
   7  LW=30                                                                     
      GO TO 10                                                                  
   9  LW=80                                                                     
   10 READ(NDEV1,11)(A(I),I=1,LW)                                               
  11  FORMAT( 80A1)                                                             
   15 WRITE(NDEV2,12)(A(I),I=1,LW)                                              
  12  FORMAT(15X,105A1)                                                         
  20  IF(A(1) - BLANK) 10,80,10                                                 
  80  DO 81 I=1,30                                                              
  81  B(I)=BLANK                                                                
      IAT=1                                                                     
      IT =1                                                                     
      IA=0                                                                      
      IB=0                                                                      
  90  IA=IA+1                                                                   
  91  IB=IB+1                                                                   
      ITW=0                                                                     
 100  IF(A(IA)-BLANK) 101,130,101                                               
 101  IF(A(IA)-EQUAL) 102,90,102                                                
  102 IF(A(IA)-COMMA) 110,103,110                                               
  103 IF(N-1) 960,506,106                                                       
  506 N=0                                                                       
      IB=2                                                                      
      GO TO 90                                                                  
 106  IF(B(1) - TITLE) 90,107,90                                                
 107  IT=IT+2                                                                   
      IB=IT                                                                     
      GO TO 90                                                                  
 110  IF(N-2) 120,111,120                                                       
 111  DO 119 J=1,6                                                              
      IF(A(IA)-ARITH(J)) 119,200,119                                            
 119  CONTINUE                                                                  
 120  ITW=ITW+1                                                                 
      IF(ITW-5) 125,125,300                                                     
 125  CALL INTO(B(IB),ITW,A(IA))                                                
      IAR=0                                                                     
 130  IA=IA+1                                                                   
      IF(IA-LW) 100,100,950                                                     
 200  IF(IAR) 205,201,205                                                       
 201  IB=IB+1                                                                   
 205  CALL INTO(B(IB),1,A(IA))                                                  
      IAR=1                                                                     
      GO TO 90                                                                  
 300  IF(N-2) 91,301,91                                                         
 301  IF(B(IB)-CONST) 900,91,900                                                
  900 WRITE(NDEV2,901)                                                          
 901  FORMAT(5X,28H   * VARIABLE NAME TOO LONG )                                
      IB=-IB                                                                    
      RETURN                                                                    
 950  IF(B(IB) - BLANK) 960,955,960                                             
 955  IB=IB-1                                                                   
 960  RETURN                                                                    
      END                                                                       
      SUBROUTINE WRITE(IFORM)                                                   
C      WRITES RUN OUTPUT .                                                      
      COMMON ND,NDEV2,IZ(7)                                                     
      COMMON NH,NOUT,IOU                                                        
      COMMON N(4,8),TTL(2,12),DUM(6)                                            
      COMMON TEMP(120),DUM1(1030),VAL(1100)                                     
      DIMENSION DATA(120)                                                       
      IF(IFORM) 99,9008,99                                                      
   99 IF(NH) 200,100,200                                                        
  100 WRITE(NDEV2,101)                                                          
 101  FORMAT(////21H  **  PROGRAM RUN ** // )                                   
      NW=12                                                                     
      IF(NDEV2-5) 110,105,110                                                   
  105 NW=6                                                                      
  110 DO 120 I=1,2                                                              
      WRITE(NDEV2,115)(TTL(I,J),J=1,NW)                                         
  115 FORMAT(A10,A5,5(A15,A5)//)                                                
  120 CONTINUE                                                                  
  200 WRITE(NDEV2,201)                                                          
  201 FORMAT (1H )                                                              
      DO 230 J=1,4                                                              
      IF(N(J,2)-NH) 210,210,260                                                 
  210 K=8                                                                       
  211 IF(N(J,K)) 220,212,220                                                    
  212 K=K-1                                                                     
      IF(K-2) 260,260,211                                                       
  220 WRITE(NDEV2,221)(VAL(N(J,IN)),IN=3,K)                                     
  221 FORMAT(1PE15.4,5E20.4)                                                    
  230 N(J,2)=N(J,2)+N(J,1)                                                      
  260 NOUT=N(1,2)                                                               
      IF(VAL(8)) 265,270,270                                                    
  265 IOU=-1                                                                    
      RETURN                                                                    
 270  IOU=0                                                                     
      RETURN                                                                    
 9008 IF(NH) 300,9009,300                                                       
 9009 TYPE 9006                                                                 
      ACCEPT 9007,NBLOC                                                         
 9006 FORMAT (' TYPE NUMBER OF WORDS PER BLOCK'/)                               
 9007 FORMAT (I)                                                                
  300 IF(NH) 302,301,302                                                        
  301 NDATA=0                                                                   
  302 DO 350 J=1,4                                                              
      IF(N(J,2)-NH)310,310,260                                                  
  310 K=8                                                                       
  311 IF(N(J,K))320,312,320                                                     
  312 K=K-1                                                                     
      IF(K-2) 260,260,311                                                       
  320 DO 330 L=1,K-2                                                            
  330 DATA(NDATA+L)=VAL(N(J,L+2))                                               
      NDATA=NDATA+K-2                                                           
      IF(NDATA-NBLOC) 350,340,340                                               
  340 WRITE(NDEV2)(DATA(IN),IN=1,NBLOC)                                         
      NDATA=0                                                                   
  350 N(J,2)=N(J,2)+N(J,1)                                                      
      GO TO 260                                                                 
      RETURN                                                                    
      END                                                                       
C     INT 4                                                                     
C      FOURTH-ORDER RUNGE-KUTTA INTEGRATION ROUTINE .                           
      SUBROUTINE INT(IFORM)                                                     
      COMMON IZ(8)                                                              
      COMMON NEQ,NH,NOUT,IOU                                                    
      COMMON DUM(1212),VAL(1100)                                                
      DIMENSION A(4),B(4),C(4)                                                  
      DIMENSION Y(100),Q(100),W(100)                                            
      IF(  NH  ) 200,100,200                                                    
  100 A(1)=0.5                                                                  
      C(1)=0.5                                                                  
      C(4)=0.5                                                                  
      A(3)=1.70710678                                                           
      C(3)=1.70710678                                                           
      A(2)=     .29289322                                                       
      C(2)= 0.29289322                                                          
      A(4)=1.0/6.0                                                              
      B(1)=2.0                                                                  
      B(4)=2.0                                                                  
      B(2)=1.0                                                                  
      B(3)=1.0                                                                  
      H=VAL(7)                                                                  
      IOU=0                                                                     
      NH =0                                                                     
      DO 110 I  =1,NEQ                                                          
      Q(I)=0.0                                                                  
  110 Y(I)=VAL(1000+I)                                                          
C      CODING                                                                   
 200  IF(NH - NOUT     ) 210,205,205                                            
 205  IOU=1                                                                     
 210  DO 230 J=1,4                                                              
      CALL YDASH(Y,W,J)                                                         
      IF(IOU) 250,220,215                                                       
  215 CALL WRITE(IFORM)                                                         
 220  DO 225 I=1,NEQ                                                            
      D=A(J)*(W(I) - B(J)*Q(I))                                                 
      Y(I) = Y(I) + H*D                                                         
 225  Q(I) = Q(I) + 3.0*D - C(J)*W(I)                                           
 230  CONTINUE                                                                  
      NH=NH+1                                                                   
      GO TO 200                                                                 
 250  RETURN                                                                    
      END                                                                       
      FUNCTION JPAR(A)                                                          
C      FINDS OR CREATES  A  IN SYMB ARRAY .                                     
      COMMON IZ(5),MPAR,IX(6)                                                   
      COMMON DUM(212),PAR(1000)                                                 
      DO 10 I=1,1000                                                            
      IF(PAR(I)-A) 10,20,10                                                     
   10 CONTINUE                                                                  
      MPAR=MPAR+1                                                               
      PAR(MPAR)=A                                                               
      JPAR=MPAR                                                                 
      RETURN                                                                    
   20 JPAR=I                                                                    
      RETURN                                                                    
      END                                                                       
      FUNCTION DPAR(J)                                                          
C      CREATES A DUMMY LOGICAL NAME .                                           
      COMMON IZ(11),N                                                           
      DIMENSION D(10)                                                           
      IF(J) 200,100,200                                                         
  100 D(1) = 1H0                                                                
      D(2) = 1H1                                                                
      D(3) = 1H2                                                                
      D(4) = 1H3                                                                
      D(5) = 1H4                                                                
      D(6) = 1H5                                                                
      D(7) = 1H6                                                                
      D(8) = 1H7                                                                
      D(9) = 1H8                                                                
      D(10)=1H9                                                                 
      M1=0                                                                      
      M2=0                                                                      
      M3=0                                                                      
      CHAR=4H)000                                                               
      N=1                                                                       
  200 M1=M1+1                                                                   
      IF(M1-10) 260,210,260                                                     
  210 M1=0                                                                      
      M2=M2+1                                                                   
      IF(M2-10) 250,220,250                                                     
  220 M2=0                                                                      
      M3=M3+1                                                                   
      CALL INTO(CHAR,2,D(M3+1))                                                 
  250 CALL INTO(CHAR,3,D(M2+1))                                                 
  260 CALL INTO(CHAR,4,D(M1+1))                                                 
      DPAR=CHAR                                                                 
      RETURN                                                                    
      END                                                                       
      FUNCTION NO(A)                                                            
C     RECOGNISES AN INTEGER IN 'A' FORMAT                                       
      COMMON NDEV1,NDEV2,LW,IZ(9)                                               
      COMMON DUM(82),B(100)                                                     
      DIMENSION DIGIT(10)                                                       
      BLANK = 5H                                                                
      BL=5H)                                                                    
      NO = 0                                                                    
      ND = 1                                                                    
      DIGIT(1)=1H0                                                              
      DIGIT(2)=1H1                                                              
      DIGIT(3)=1H2                                                              
      DIGIT(4)=1H3                                                              
      DIGIT(5)=1H4                                                              
      DIGIT(6)=1H5                                                              
      DIGIT(7)=1H6                                                              
      DIGIT(8)=1H7                                                              
      DIGIT(9)=1H8                                                              
      DIGIT(10)=1H9                                                             
   10 DO 30 I = 1,LW                                                            
      IF(B(LW+1-I) - BLANK) 11,30,11                                            
   11 IF(B(LW+1-I) - BL) 15,30,15                                               
   15 DO 20 J=1,10                                                              
      IF(B(LW+1-I)- DIGIT(J)) 20,25,20                                          
   20 CONTINUE                                                                  
      IF(ND-1) 90,21,90                                                         
  21  NO=-1                                                                     
      GO TO 90                                                                  
   25 NO = (J-1)*ND + NO                                                        
      ND = 10*ND                                                                
   30 CONTINUE                                                                  
   90 RETURN                                                                    
      END