home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 9 / 09.iso / e / e003 / 12.ddi / TAP61.FOR < prev    next >
Encoding:
Text File  |  1988-01-08  |  69.9 KB  |  886 lines
  1. C     SUBROUTINE  **TAPIN**                                                     
  2. C          DATA INPUT                                                           
  3.       SUBROUTINE TAPIN (ISTART,NSTART)                                          
  4.       INTEGER NY1(3000),NY2(1000),NZA(1000),INXP(1000),INWP(1000)               
  5.       INTEGER NXP(1000),KEY(1000),IZ(1000),IPR(500),IPH(100)                    
  6.       INTEGER NTHEAD(100),NTTAIL(100),NFLAG(1000)                               
  7.       DIMENSION  ZZ(16000),DYTCQ(11030),Y(3000),T(1000)                         
  8.      X,GAIN(1000)                                                               
  9.      X ,PHT1(100),PHH1(100),PHT2(100),PHH2(100),QCH1(100)                       
  10.      X,QCH2(100),CON(20),PRTIM(10),DELTIM(10),TITLE(17,10),TABL(1000)           
  11.      X,CL(12,30),TL(6,10),BB(12),AL(2),AB(2),I(3),E(2),K(2),J(2),F(2)           
  12.        COMMON/I2BYT/NY1,NY2,NZA,NXP,INXP,INWP,KEY,IPR,IPH                       
  13.      X,NTHEAD,NTTAIL,NFLAG,IZ                                                   
  14.         REAL*8 FILE                                                             
  15.       COMMON /LAB1/ PLOT(100,10),IPLOT(10),TMAX(1000)                           
  16.       COMMON/LAB5/TITLE                                                         
  17.       COMMON /LAB7/LABX(5),LABY(5),LCURVE(3,5),XALIM(2),YALIM(2)                
  18.       COMMON ZZ                                                                 
  19.         EQUIVALENCE(FILE,F(1))                                                  
  20.       EQUIVALENCE(I(1),I1),(I(2),I2),(I(3),I3),(E(1),E1),(E(2),E2)              
  21.      X,          (J(1),JA),(J(2),JB),(K(1),KA),(K(2),KB)                        
  22.       EQUIVALENCE(ZZ(001),TIME),             (ZZ(002),Y(1),DYTCQ(1))            
  23.      X,       (ZZ(3002),T(1)),     (ZZ(11018),NSAP),                            
  24.      X         (ZZ(11002),CON(1) ),             (ZZ(11010),CON9,SIGMA),         
  25.      X     (ZZ(10001),LYMIN)    , (ZZ(10501),LYMAX),                            
  26.      X           (ZZ(10002),GAIN(1)),                                           
  27.      X         (ZZ(11011),CON10,TZERO),         (ZZ(11032),PRTIM(1))  ,         
  28.      X         (ZZ(11042),DELTIM(1)),           (ZZ(11053),I(1) )     ,         
  29.      X         (ZZ(11056),E(1)),                (ZZ(11058),J(1))      ,         
  30.      X         (ZZ(11060),K(1)),                (ZZ(11062),AA(1))               
  31.       EQUIVALENCE(ZZ(11069), LFLAG),              (ZZ(11070), IERFL)            
  32.      X,          (ZZ(11071),PRTMX),               (ZZ(11072),DTHETA)            
  33.      X,          (ZZ(11073),RCMIN),               (ZZ(11074), JSAVE)            
  34.      X,          (ZZ(11075),DELTAT),              (ZZ(11076),DTMAX )            
  35.      X,          (ZZ(11077), IMIN),               (ZZ(11078), IMAX )            
  36.      X,          (ZZ(11079), IXMIN),              (ZZ(11080), IXMAX)            
  37.      X,          (ZZ(11081),IPHMAX),              (ZZ(11082),IPRMAX)            
  38.      X,          (ZZ(11083),IPFLAG),              (ZZ(11084),ISFLAG)            
  39.      X,          (ZZ(11085),MAXNOT),              (ZZ(11086),MAXNOY)            
  40.      X,          (ZZ(11087),NARITH),              (ZZ(11088),NCRIT )            
  41.       EQUIVALENCE(ZZ(11089),NTIME),               (ZZ(11090),IXX)               
  42.      X,          (ZZ(11091),NTLAST),              (ZZ(11092),NWW)               
  43.      X,          (ZZ(11093),NXX),                 (ZZ(11094),NZZ)               
  44.      X,          (ZZ(11095), W ),                 (ZZ(11096), X )               
  45.      X,          (ZZ(11097), Z ) ,                (ZZ(11098), NTAB)             
  46.      X,          (ZZ(11099),INZ),                 (ZZ(11100),ODTIME)            
  47.      X,          (ZZ(11101),DTIME ),              (ZZ(11102),PHT1(1) )          
  48.      X,          (ZZ(11202),PHH1(1) ),            (ZZ(11302),PHT2(1) )          
  49.      X,          (ZZ(11402),PHH2(1) ),            (ZZ(11502),QCH1(1) )          
  50.      X,          (ZZ(11602),QCH2(1) )                                           
  51.       EQUIVALENCE(ZZ(15002),TABL(1))                                            
  52.       INTEGER    AA(7),XLAB,YLAB                                                
  53.       DATA  CL(1,30),CL(2,30),CL(3,30),CL(4,30),CL(5,30),CL(6,30)               
  54.      X,CL(7,30),CL(8,30),CL(9,30),CL(10,30),CL(11,30),CL(12,30)/12*1H /         
  55. C                                                                               
  56.       DATA  CL(1,1),CL(2,1),CL(3,1),CL(4,1)/4HSPEC,4HIFIE,4HD DE,4HLTA-/
  57.      X,     CL(5,1)                        /4HTIME/
  58.      X,     CL(1,2),CL(2,2),CL(3,2),CL(4,2)/4HMINI,4HMUM ,4HALLO,4HWABL/        
  59.      X,     CL(5,2),CL(6,2),CL(7,2)        /4HE DE,4HLTA-,4HTIME/               
  60.      X,     CL(1,3),CL(2,3),CL(3,3),CL(4,3)/4HDELT,4HA-TI,4HME M,4HULTI/        
  61.      X,     CL(5,3),CL(6,3)                /4HPLIE,4HR   /
  62.      X,     CL(1,4),CL(2,4),CL(3,4),CL(4,4)/4HCONV,4HERGE,4HNCE ,4HTEST/        
  63.      X,     CL(5,4),CL(6,4),CL(7,4),CL(8,4)/4H DEL,4HTA-T,4HEMRT,4HRATU/
  64.      X,     CL(9,4)                        /4HRE  /
  65.      X,     CL(1,5),CL(2,5),CL(3,5),CL(4,5)/4H+1.0,4H = S,4HTEAD,4HY-ST/
  66.      X,     CL(5,5)                        /4HATE /   
  67.      X,     CL(1,6),CL(2,6),CL(3,6),CL(4,6)/4H+1.0,4H = D,4HYDCQ,4H DUM/        
  68.      X,     CL(5,6),CL(6,6),CL(7,6),CL(8,6)/4HP AT,4H END,4H OF ,4HRUN /        
  69.       DATA  CL(1,8),CL(2,8),CL(3,8),CL(4,8)/4HMAXI,4HMUM ,4HERRO,4HR AL/        
  70.      X,     CL(5,8),CL(6,8),CL(7,8),CL(8,8)/4HLOWE,4HD IN,4H TEM,4HP.  /        
  71.      X,     CL(1,9),CL(2,9),CL(3,9),CL(4,9)/4HSTEF,4HAN-B,4HOLTZ,4HMANN/        
  72.      X,     CL(5,9),CL(6,9),CL(7,9)        /4H CON,4HSTAN,4HT   /
  73.      X, CL(1,10),CL(2,10),CL(3,10),CL(4,10)/4HABSO,4HLUTE,4H ZER,4HO TE/
  74.      X, CL(5,10),CL(6,10),CL(7,10) /4HMPER,4HATUR,4HE   /
  75.      X, CL(1,11),CL(2,11),CL(3,11),CL(4,11)/4HSUPP,4HRESS,4HION-,4HNODE/
  76.      X, CL(5,11),CL(6,11),CL(7,11),CL(8,11)/4H SUM,4HMARY,4H(+1.,4H0), /        
  77.       DATA  TL(1,1),TL(2,1),TL(3,1),TL(4,1)/4HTITL,4HES  ,4H    ,4H    /
  78.      X,     TL(1,2),TL(2,2),TL(3,2),TL(4,2)/4HNETW,4HORK ,4HDESC,4HRIPT/
  79.      X,     TL(5,2),TL(6,2)                /4HION ,4H    /
  80.      X,     TL(1,3),TL(2,3),TL(3,3),TL(4,3)/4HINIT,4HIAL ,4HVALU,4HES  /
  81.      X,     TL(1,4),TL(2,4),TL(3,4),TL(4,4)/4HFUNC,4HTION,4HS   ,4H    /
  82.      X,     TL(1,5),TL(2,5),TL(3,5),TL(4,5)/4HTABL,4HES  ,4H    ,4H    /
  83.      X,     TL(1,6),TL(2,6),TL(3,6),TL(4,6)/4HCRT ,4HPLOT,4HTING,4H    /
  84.      X,     TL(1,8),TL(2,8),TL(3,8),TL(4,8)/4HSPEC,4HIAL ,4HCONS,4HTANT/
  85.      X,     TL(1,7),TL(2,7),TL(3,7),TL(4,7)/4HLATE,4HNT H,4HEAT ,4HDATA/
  86.      X,     TL(5,8),TL(6,8)                /4H VAL,4HUES /
  87.      X,     TL(1,9),TL(2,9),TL(3,9),TL(4,9)/4HPRIN,4HT SP,4HECIF,4HICAT/
  88.      X,     TL(5,9),TL(6,9)                /4HIONS,4H    /
  89.      X,     TL(1,10),TL(2,10),TL(3,10)     /4HRUN ,4HCONT,4HROL /
  90.       DATA CL(1,12),CL(2,12),CL(3,12),CL(4,12),CL(5,12),CL(6,12),               
  91.      XCL(7,12),CL(8,12)/4H+0=N,4HEWTO,4HN SO,4HL.,+,4H    ,4H    ,4H    
  92.      X,4HN   /,CL(1,13),CL(2,13),CL(3,13),                                      
  93.      XCL(4,13),CL(5,13),CL(6,13),CL(7,13),CL(8,13),CL(9,13),CL(10,13),          
  94.      XCL(11,13)/4HCONS,4HTANT,4H TO ,4HVARY,4H THE,4H NO.,4H OF ,4H*030,
  95.      X4H EVA,4HLUAT,4HIONS/,CL(1,14),CL(2,14),CL(3,14),CL(4,14),CL(5,14)        
  96.      X,CL(6,14),CL(7,14),CL(8,14)/4HCONS,4HTANT,4H TO ,4HVARY,4H THE,
  97.      X4H ERR,4HOR T,4HEST /,CL(1,15),CL(2,15),CL(3,15),CL(4,15),CL(5,15)        
  98.      X,CL(6,15),CL(7,15),CL(8,15)/4H+1 F,4HOR 1,4H00 S,4HERIE,4HS EV,
  99.      X4HAL *,4H097 ,4HRUN /
  100.       DATA CL(1,16),CL(2,16),CL(3,16),CL(4,16),CL(5,16),CL(6,16)/4H+1.0,
  101.      X4H = R,4HADIO,4HSITY,4H ANA,4HLOG /
  102.         DATA CL(1,17),CL(2,17),CL(3,17),CL(4,17),CL(5,17),CL(6,17),             
  103.      XCL(7,17),CL(8,17),CL(9,17)/                                               
  104.      X4H+1.0,4H= WR,4HITE ,4HDATA,4HFOR ,4HSAP-,4H6 PR,4HOGRA,4HM   /
  105.       LFLAG = 0                                                                 
  106.         MEGA=1000000                                                            
  107.       INPT= 0                                                                   
  108.       MAXNT= MAXNOT + 3000                                                      
  109.       IF(NSTART.NE.-98) GO TO 1                                                 
  110.       DO 1001 IC=1,1000                                                         
  111.  1001 IZ(IC)= 1                                                                 
  112.       YALIM(1) =0.                                                              
  113.       YALIM(2)= 0.                                                              
  114.       XALIM(1) = 0.                                                             
  115.       XALIM(2) = 0.                                                             
  116.     1 CALL READ                                                                 
  117.       IF (I1) 2,1,12                                                            
  118.     2 IF (I1 .GE. -90) GO TO 5                                                  
  119.     3 IF (I1 .LE. -100) GO TO 14                                                
  120.       GO TO 9                                                                   
  121. C     IT = 1+C0L 3 OF FIELD I1 = DIRECTION FOR TYPE OF INPUT                    
  122.     5 IT=1-(I1/10)                                                              
  123. C     ITT = 1+C0L 4 OF FIELD I1 = DIRECTION FOR REPLACEMENT OF INPUT            
  124.       ITT = (10*(I1/10))-I1+1                                                   
  125.       LFLAG = 0                                                                 
  126.                                                                                 
  127.       WRITE (6,13) (TL(M,IT),M=1,6)                                             
  128.    13 FORMAT(22X,6A4)  
  129.       GOTO(50,100,200,300,400,500,600,700,810,910),IT                           
  130. C          TITLES                                                               
  131.    50 N=10                                                                      
  132.       READ (5,51) AI1,II1, (TITLE(M,N),M=1,17),C,D                              
  133.    51 FORMAT (A1,I3,19A4)                                                       
  134.       I1 = LINK(AI1,II1)                                                        
  135.    57 WRITE (6,58) AI1,II1, (TITLE(M,N),M=1,17),C,D                             
  136.    58 FORMAT (6X,A1,I3,17A4,16X,2A4)                                            
  137.       IF (I1) 2,50,52                                                           
  138.    52 N = MOD(II1,10)                                                           
  139.       DO 53 M=1,17                                                              
  140.    53 TITLE(M,N) = TITLE(M,10)                                                  
  141.       GO TO 50                                                                  
  142. C          NETWORK DESCRIPTION                                                  
  143.   100 IF(ITT.GT.1) GO TO 150                                                    
  144.       WRITE(6,101)                                                              
  145.   101 FORMAT(23X,16HSTAR TEN SECTION/  '      YMIN YMAX YINC     INT.VAL        
  146.      1UE                 T(1) T(2) TINC TINC      COMMENTS ')                   
  147.       LFLAG=-1                                                                  
  148.   102 CALL READ                                                                 
  149.       IF (I1) 2,102,103                                                         
  150.   103 CONTINUE                                                                  
  151.       IF(I1.GT.3000) GO TO 10                                                   
  152.   104 NY1(I1)= 1000*JA+JB                                                       
  153.   107 IF(E1.GT.0.)Y(I1)= E1                                                     
  154.       IF(I1.LT.I2) GO TO 110                                                    
  155.       MAXNOY = MAX0(MAXNOY,I1)                                                  
  156.       GO TO 102                                                                 
  157.   110 JA= JA+KA                                                                 
  158.       JB= JB+KB                                                                 
  159.       INC= MAX0(I3,1)                                                           
  160.       I1= I1+ INC                                                               
  161.       GO TO 103                                                                 
  162. C                FLOW NETWORK DESCRIPTION                                       
  163. 150     IF(ITT.GT.6)GO TO 160                                                   
  164.         WRITE(6,151)                                                            
  165.   151 FORMAT(19X,'STAR FIFTEEN SECTION'/19X,'CIRCUIT FOR FLOW NODES')           
  166.       LFLAG= -1                                                                 
  167.   153 CONTINUE                                                                  
  168.   152 CALL READ                                                                 
  169.       IF(I1)2,152,154                                                           
  170.   154 IF(I1.GT.3000) GO TO 10                                                   
  171.       NY1(I1)= MEGA+1000*JA + JB                                                
  172.       LYMAX=LYMAX+1                                                             
  173.       NY2(LYMAX)= I1                                                            
  174.       IF(E1.GT.0.)Y(I1)= E1                                                     
  175.       IF(I1.GE.I2) GO TO 152                                                    
  176.       JA= JA+KA                                                                 
  177.       JB= JB+KB                                                                 
  178.       INC= MAX0(I3,1)                                                           
  179.       I1= I1 + INC                                                              
  180.       GO TO 154                                                                 
  181.  160   CALL CONY                                                                
  182.        NSAP=1                                                                   
  183.        GO TO 1                                                                  
  184. C    INITIAL AND CONSTANT VALUES                                                
  185.  200   WRITE(6,201)                                                             
  186.        LFLAG=0                                                                  
  187.  201   FORMAT(20X,19HSTAR TWENTY SECTION)                                        
  188.  202   CALL READ                                                                
  189.       IF(I1)210,202,203                                                         
  190.   210 MAXNOT= MAXNT -3000                                                       
  191.       GO TO 2                                                                   
  192.   203 IA = I1                                                                   
  193.       IB = I2                                                                   
  194.        INC=MAX0(I3,1)                                                           
  195.       DYTCQ(IA)= E1                                                             
  196.        IA2=IA+INC                                                               
  197.       IF(IA2.GT.IB) GO TO 205                                                   
  198.       DO 204 IX= IA2,IB,INC                                                     
  199.   204 DYTCQ(IX)= DYTCQ(IX-INC)+E2                                               
  200.   205 CONTINUE                                                                  
  201.       IF(IA/1000.NE.3) GO TO 202                                                
  202.         I4=I3                                                                   
  203.         IF(I3.EQ.0) I4=1                                                        
  204.        NFLAG(IA-3000)=I4                                                        
  205.   208 DO 209 IX=IA,IB                                                           
  206.       IF(I3.GE.0)I4=MAX0(1,NFLAG(IX-3000))                                      
  207.   209 NFLAG(IX-3000)= I4                                                        
  208.       IF(I3.NE.-1) MAXNT= MAX0(IA,IB,MAXNT)                                     
  209.       GOTO202                                                                   
  210. C          FUNCTIONS                                                            
  211.   300 IX = ISTART                                                               
  212.       WRITE(6,301)                                                              
  213.   301 FORMAT(19X,19HSTAR THIRTY SECTION/'  NO. ZMIN ZMAX  KEY INC  INT.         
  214.      1VALUE(E1) GAIN(E2)    X    W  XINC WINC     COMMENTS ')                   
  215.       LFLAG = 1                                                                 
  216.   302 IXX= IX                                                                   
  217.       CALL READ                                                                 
  218.   303 IF(I1)311,302,304                                                         
  219.   304 GO TO (314,316,316,316,316,316,316,316,316,327),ITT                       
  220. C     REPLACEMENT OF SPECIFIC FUNCTIONS                                         
  221.   316 NAB = 1                                                                   
  222.   317 DO 322 IX=1,IMAX                                                          
  223.   319 IF (NZA(IX) .NE. I1) GO TO 322                                            
  224.   320 NAB = NAB+1                                                               
  225.   321 IF (ITT .EQ. NAB) GO TO 315                                               
  226.   322 CONTINUE                                                                  
  227.   324  IFTAG=I1                                                                 
  228.       WRITE (6,325) IFTAG,ITT                                                   
  229.   325 FORMAT (1H0,6X,A4,14H, ENTRY NUMBER, I3, 29H, NOT LOCATED AMONG FU        
  230.      1NCTIONS)                                                                  
  231.   309 I1 = -99                                                                  
  232.       GO TO 9                                                                   
  233.   327 ITT = 1                                                                   
  234.   331 IX = 0                                                                    
  235.   332 IMAX = 0                                                                  
  236.       IMIN = 1                                                                  
  237. C     STANDARD INPUT FOR FUNCTIONS                                              
  238.   314 IX = IX+1                                                                 
  239.       IF(IX.GT.1000)GO TO 10                                                    
  240.   315 NZA(IX)= 10000*I1+I2                                                      
  241.       IMAX= MAX0(IMAX,IX)                                                       
  242.       NXP(IX)= 10000*JA+JB                                                      
  243.       INXP(IX) = KA                                                             
  244.       INWP(IX) = KB                                                             
  245.       IZ(IX)= MAX0(INZ,1)                                                       
  246.       GAIN(IX) = E2                                                             
  247.       KEY(IX) = I3                                                              
  248.   307 IF (E1 .EQ. 0.0) GO TO 302                                                
  249.   310 DO 328 IC=I1,I2                                                           
  250.   328 DYTCQ(IC) = E1                                                            
  251.       GO TO 302                                                                 
  252.   311 IF (ITT .GT. 1) GO TO 330                                                 
  253.   329 ISTART = IX                                                               
  254.   330 IMAX = MAX0(IMAX,IX)                                                      
  255.       LFLAG = 0                                                                 
  256.       GO TO 2                                                                   
  257. C          TABLES                                                               
  258.   400 NT = NTLAST                                                               
  259.       WRITE(6,401)                                                              
  260.       LFLAG = 0                                                                 
  261.   401 FORMAT(15X,19HSTAR FOURTY SECTION//7X,5HTABLE,16X,1HX,14X,1HZ)
  262.       NTAB=0                                                                    
  263.   402 CALL READ                                                                 
  264.       IF (I1 .NE. 0) GO TO 405                                                  
  265.   403 NT = NT+2                                                                 
  266.       IF(NT.GT.999) GO TO 10                                                    
  267.       TABL( NT )=E1                                                             
  268.       ITAB = I1+NTABP                                                           
  269.       IF(ITAB.EQ.0.AND.TABL(NT).LE.TABL(NT-2)) GO TO 14                         
  270.       TABL(NT+1)=E2                                                             
  271.       GO TO N4,(402,404)                                                        
  272.   404 NTP = NTP+2                                                               
  273.       TABL(NT) = TABL(NTP)                                                      
  274.       GO TO 402                                                                 
  275.   405 ASSIGN 402 TO N4                                                          
  276.                                                                                 
  277.   406 NTTAIL(NTAB) = NT+1                                                       
  278.       IF (I1 .LE. 0) GO TO 419                                                  
  279.   410 NTAB = I1                                                                 
  280.       NTABP = 0                                                                 
  281.       IF (NTAB .GE. 100) GO TO 414                                              
  282.   411 NTHEAD(NTAB) = NT+2                                                       
  283.       IF (I2 .LE. 0) GO TO 403                                                  
  284.   407 ASSIGN 404 TO N4                                                          
  285.       NTABP = I2                                                                
  286.       IF (NTHEAD(NTABP) .LE. 0) GO TO 412                                       
  287.   408 NTP =(NTHEAD(NTABP)) - 2                                                  
  288.       GO TO 403                                                                 
  289.   412 WRITE (6,413)                                                             
  290.   413 FORMAT (49H0 ERROR, COPYING OF A NONEXISTENT TABLE REQUESTED)             
  291.       GO TO 12                                                                  
  292.   414 WRITE (6,415)                                                             
  293.   415 FORMAT (48H0 ERROR, TABLE NUMBER IS EQUAL TO OR EXCEEDS 100)              
  294.       GO TO 12                                                                  
  295.   419 NTLAST = NT                                                               
  296.       GO TO 2                                                                   
  297. C     PLOT DATA                                                                 
  298.   500 CONTINUE                                                                  
  299.       LFLAG = 7                                                                 
  300.       WRITE(6,501)                                                              
  301.   501 FORMAT(19X,18HSTAR FIFTY SECTION)
  302.   502 CALL READ                                                                 
  303.       JPLOT=0                                                                   
  304.       IF(I1.LT.0) GO TO 2                                                       
  305.       LT= I1                                                                    
  306.   503 IF(I1.GT.0.OR.I3.LE.0)GO TO 520                                           
  307.       IF(I3.GT.1)GO TO 510                                                      
  308.       YALIM(1)= E1                                                              
  309.       YALIM(2)= E2                                                              
  310.       DO505 M=1,5                                                               
  311.   505 LABY(M)=AA(M)                                                             
  312.       WRITE(6,551)LABY,(AA(IC),IC=6,7)                                          
  313.   551 FORMAT(8X,'Y AXIS LABEL IS  ',5A4, 49X,2A4)                               
  314.       GOTO502                                                                   
  315.   510 IF(I3.GT.2) GO TO 590                                                     
  316.       XALIM(1) = E1                                                             
  317.       XALIM(2) = E2                                                             
  318.       DO 515 M=1,5                                                              
  319.   515 LABX(M)= AA(M)                                                            
  320.       WRITE(6,552) LABX,(AA(IC),IC=6,7)                                         
  321.   552 FORMAT(8X,'X AXIS LABEL IS  ',5A4,49X,2A4)                                
  322.       GOTO502                                                                   
  323.   520 IF(I1.GT.0)JZ=2*I1                                                        
  324.       IF(I1.LE.5) GO TO 521                                                     
  325.       LT1= I1                                                                   
  326.       GOTO590                                                                   
  327.   521 M3= 3*I1                                                                  
  328.       M2=M3-1                                                                   
  329.       M1=M2-1                                                                   
  330.       IF(I1.LE.0) GO TO 525                                                     
  331.       JPLOT1=0                                                                  
  332.       LCURVE(1,I1)= AA(1)                                                       
  333.       LCURVE(2,I1)= AA(2)                                                       
  334.       LCURVE(3,I1)= AA(3)                                                       
  335.       IF(I3.GT.0) GO TO 530                                                     
  336.   525 JPLOT=JPLOT1+1                                                            
  337.       IF(JPLOT.GT.100)GOTO502                                                   
  338.       JPLOT1=JPLOT                                                              
  339.       PLOT(JPLOT,JZ-1)=E(1)                                                     
  340.       PLOT(JPLOT,JZ)=E(2)                                                       
  341.       IPLOT(JZ-1)=JPLOT                                                         
  342.       IF(I1.EQ.0) GO TO 554                                                     
  343.       WRITE(6,553) I1,(LCURVE(M,I1),M=1,3),(AA(IC),IC=6,7)                      
  344.   553 FORMAT(8X,'CURVE NO.',I3,' LABEL IS  ',3A4,51X,2A4)                       
  345.       WRITE(6,555)LABX,LABY                                                     
  346.      1,(AA(IC),IC=6,7)                                                          
  347.   554 CONTINUE                                                                  
  348.   555 FORMAT(13X,'PT.NO.',6X,5A4,6X,5A4, 23X,2A4)                               
  349.       WRITE(6,556)JPLOT,E,(AA(IC),IC=6,7)                                       
  350.   556 FORMAT(16X,I3,2E26.4,23X,2A4)    
  351.       GOTO502                                                                   
  352.   530 IF(I1.GT.0)WRITE(6,553)I1,(LCURVE(M,I1),M=1,3),(AA(IC),IC=6,7)            
  353.       GOTO502                                                                   
  354.   590 WRITE(6,591)LT1                                                           
  355.   591 FORMAT(20H  CRT INPUT CONSTANT,I4,13H IS TOO LARGE) 
  356.       GO TO 12                                                                  
  357. C                LATENT HEAT DATA                                               
  358.   600 IPP= IPHMAX+1                                                             
  359.       WRITE(6,601)                                                              
  360.   601 FORMAT(19X,'STAR SIXTY SECTION')                                          
  361.   602 CALL READ                                                                 
  362.       IF(I1)613,609,603                                                         
  363.   603 GOTO(604,615,615,615,615,615,615,615,622),ITT                             
  364. C     REPLACEMENT OF SPECIFIC INPUT ITEMS                                       
  365.   615 NAB=1                                                                     
  366.       DO 618 IX=1,IPHMAX                                                        
  367.       IF(I1.NE.0)GOTO618                                                        
  368.   616 NAB=NAB+1                                                                 
  369.       IF(NAB-ITT)618,621,619                                                    
  370.   618 CONTINUE                                                                  
  371.   619 WRITE(6,620)I1,ITT                                                        
  372.   620 FORMAT(1H0,6X,5H NODE,I4,'ENTRY NUMBER',I3,'NOT LOCATED IN LATEN'
  373.      X,'TEAT INPUT')
  374.       GOTO309                                                                   
  375.   621 IPP=IX                                                                    
  376.       GOTO604                                                                   
  377. C     REMOVAL OF ALL PREVIOUS INPUT OF THIS TYPE                                
  378.   622 ITT=1                                                                     
  379.       IPHMAX=0                                                                  
  380.       IPP=1                                                                     
  381.   604 IA=MOD(I1,1000)                                                           
  382.       IB=MOD(I2,1000)                                                           
  383.       IPX=IPP                                                                   
  384.   605 IF(IPP.GT.100)GOTO10                                                      
  385.   606 IPH(IPP)=IA                                                               
  386.       PHH1(IPP)=E2                                                              
  387.       PHT1(IPP)=E1                                                              
  388.       PHT2(IPP)=1.E15                                                           
  389.       PHH2(IPP)=0.0                                                             
  390.       IPP=1+IPP                                                                 
  391.       IF(IB.GT.IA)GOTO608                                                       
  392.   607 IPZ=IPP-1                                                                 
  393.       GOTO602                                                                   
  394.   608 IA=1+IA                                                                   
  395.       GOTO605                                                                   
  396.   609 DO610IP=IPX,IPZ                                                           
  397.       PHT2(IP)=E1                                                               
  398.   610 PHH2(IP)=E2                                                               
  399.       GOTO602                                                                   
  400.   613 IF(IPP.GT.100)GOTO10                                                      
  401.       IPHMAX=IPP-1                                                              
  402.       GOTO2                                                                     
  403. C          RUN CONTROL CONSTANTS                                                
  404.   700 WRITE(6,751)                                                              
  405.   751 FORMAT(23X,20HSTAR SEVENTY SECTION) 
  406.       LFLAG = 7                                                                 
  407.   752 CALL READ                                                                 
  408.       IF(I1.LT.0) GO TO 2                                                       
  409.       IF(I1.GT.30) I1=30                                                        
  410.       CON(I1) = E1                                                              
  411.       LT= I1                                                                    
  412.       WRITE(6,701) I1,E1,(CL(M,LT),M=1,12),(AA(IC),IC=6,7)                      
  413.   701 FORMAT(6X,I4,10X,E15.6,2X,12A4,9X,2A4)                                    
  414.       GO TO 752                                                                 
  415. C          PRINT-OUT SPECIFICATIONS                                             
  416.   810 WRITE(6,811)                                                              
  417.   811 FORMAT(23X,19HSTAR EIGHTY SECTION)  
  418.   800 IP = IPRMAX                                                               
  419.   802 CALL READ                                                                 
  420.   803 IF (I1) 808,802,804                                                       
  421.   804 IP = IP+1                                                                 
  422.       IF(IP.GT.99) GO TO 10                                                     
  423.       IPR(IP) = I1                                                              
  424.        IPR(IP+100)=I2                                                           
  425.        IPR(IP+200)=MAX0(I3,1)                                                   
  426.        GO TO 802                                                                
  427.   808 IPRMAX = IP                                                               
  428.       GO TO 2                                                                   
  429. C          RUN CONTROL                                                          
  430.   910 WRITE(6,911)                                                              
  431.   911 FORMAT(18X,19HSTAR NINETY SECTION)    
  432.   900 LL=0                                                                      
  433.   902 CALL READ                                                                 
  434.       IF (I1 .LT. 0) GO TO 905                                                  
  435.   903 LL=LL+1                                                                   
  436.       IF(LL.GT.10) GO TO 10                                                     
  437.       IF(I1.LT.0) GO TO 905                                                     
  438.       PRTIM(LL) = E1                                                            
  439.       DELTIM(LL)= E2                                                            
  440.       IF((E1.GT.0.).AND.(E2.EQ.0.)) PRTMX= PRTIM(LL)                            
  441.       GO TO 902                                                                 
  442.   905 IF(PRTMX.LE.0.)PRTMX= PRTIM(LL)                                           
  443.       GO TO 2                                                                   
  444.    10 WRITE (6,11)                                                              
  445.    11 FORMAT(55H0 ERROR-STORAGE CAPACITY FOR THIS TYPE OF DATA EXCEEDED)        
  446.       GO TO 12                                                                  
  447.    14 WRITE (6,15)                                                              
  448.    15 FORMAT (33H    THIS TYPE OF INPUT IS ILLEGAL)                             
  449.    12 CALL ERROR                                                                
  450.     9 NSTART = I1                                                               
  451.       RETURN                                                                    
  452.       END                                                                       
  453. C     SUBROUTINE  **ERROR**                                                     
  454.       SUBROUTINE ERROR                                                          
  455.       DIMENSION  ZZ(16000),A(19)                                                
  456.       EQUIVALENCE(ZZ(11070),IERFL)                                              
  457.      X,          (ZZ(11053),I1)                                                 
  458.       COMMON  ZZ                                                                
  459.       DATA TEST/1H*/
  460.       WRITE (6,7)                                                               
  461.     7 FORMAT (108H- AN ERROR HAS OCCURRED, THE FOLLOWING IS A LISTING OF        
  462.      1 THE REMAINING INPUT DATA UNTIL A *98 OR *99 IS FOUND,/2X,70H AT W        
  463.      2HICH POINT THE PROGRAM WILL START A NEW RUN OR QUIT, RESPECTIVELY)        
  464.     1 READ (5,2) AI1,II1,A                                                      
  465.     2 FORMAT (A1,I3,19A4)                                                       
  466.       WRITE(6,3)AI1,II1,A                                                       
  467.     3 FORMAT (5X,A1,I3,17A4,2X,2A4)                                             
  468. C     SEE IF CARD HAS A *                                                       
  469.       IF(AI1.NE.TEST)GOTO1                                                      
  470. C     SEE IF CARD HAS A 99 OR 98                                                
  471.     4 IF(II1.LT.98) GO TO 1                                                     
  472.     5 IERFL = 2                                                                 
  473.       IF(II1.EQ.99)IERFL= 3                                                     
  474.       I1= -II1                                                                  
  475.     6 RETURN                                                                    
  476.       END                                                                       
  477. C     SUBROUTINE  **ARITH**                                                     
  478. C                                                                               
  479. C                                                                               
  480.       SUBROUTINE ARITH                                                          
  481.       INTEGER NY1(3000),NY2(1000),NZA(1000),INXP(1000),INWP(1000)               
  482.       INTEGER NXP(1000),KEY(1000),NFLAG(1000),IZ(1000),IPR(500),IPH(100)        
  483.      X,NTHEAD(100),NTTAIL(100)                                                  
  484.       DIMENSION  ZZ(16000),DYTCQ(11030),Y(3000),T(1000),CON(20)                 
  485.      X,C(1000)        ,Q(1000)        ,GAIN(1000) ,A(1000),B(1000)              
  486.      X,D(1000),SUMY(1000),SUMYT(1000), TOLD(1000),L(1000)                       
  487.      X,TITLE(17,10),TABL(1000),PHH1(100)                                        
  488.      X,          PHT1(100),PRTIM(10)                                            
  489.        COMMON/I2BYT/NY1,NY2,NZA,NXP,INXP,INWP,KEY,IPR,IPH                       
  490.      X,NTHEAD,NTTAIL,NFLAG,IZ                                                   
  491.       COMMON /LAB1/ PLOT(100,10),IPLOT(10),TMAX(1000)                           
  492.       COMMON /LAB2/DATE(2)                                                      
  493.       COMMON /LAB5/TITLE                                                        
  494.       COMMON  ZZ                                                                
  495.       EQUIVALENCE(ZZ(001),TIME),              (ZZ(002),Y(1),DYTCQ(1))           
  496.      X,          (ZZ(3002),T(1)),                 (ZZ(4002),C(1))               
  497.      X,          (ZZ(5002),Q(1)),                 (ZZ(6002),D(1))               
  498.      X,          (ZZ(7002),A(1)),                 (ZZ(8002),B(1))               
  499.      X,          (ZZ(9002),L(1)),                 (ZZ(10002),GAIN(1))           
  500.      X,       (ZZ(11002),CON(1)),       (ZZ(11010),CON9,SIGMA),                 
  501.      X         (ZZ(11011),CON10,TZERO),         (ZZ(11032),PRTIM(1))  ,         
  502.      X         (ZZ(11070),IERFL)                                                
  503.       EQUIVALENCE(ZZ(11072),DTHETA),              (ZZ(11090),IXX)               
  504.      X,          (ZZ(11081),IPHMAX),              (ZZ(11202),PHH1(1) )          
  505.      X,          (ZZ(11077), IMIN),               (ZZ(11078), IMAX )            
  506.      X,          (ZZ(11079), IXMIN),              (ZZ(11080), IXMAX)            
  507.      X,          (ZZ(11083),IPFLAG),              (ZZ(11084),ISFLAG)            
  508.      X,          (ZZ(11085),MAXNOT),              (ZZ(11086),MAXNOY)            
  509.      X,          (ZZ(11087),NARITH),              (ZZ(11088),NCRIT )            
  510.       EQUIVALENCE(ZZ(11091),NTLAST),              (ZZ(11092),NWW)               
  511.      X,          (ZZ(11093),NXX),                 (ZZ(11094),NZZ)               
  512.      X,          (ZZ(11095), W ),                 (ZZ(11096), X )               
  513.      X,          (ZZ(11097), Z ) ,                (ZZ(11098), NTAB)             
  514.      X,          (ZZ(11101),DTIME ),              (ZZ(11102),PHT1(1) )          
  515.      X,          (ZZ(11099),CFLAG),               (ZZ(11100),ODTIME)            
  516.      X,          (ZZ(15002),TABL(1) )                                           
  517.       IF(NARITH.GT.0)TIME2= PRTIM(1)                                            
  518.       DTIME2= TIME-TIME2                                                        
  519.         RAD=57.296                                                              
  520.         MEGA=1000000                                                            
  521.       DO 304 IX = IMIN,IMAX                                                     
  522.       KEYP = KEY(IX)                                                            
  523.       KH = KEYP/100                                                             
  524.                                                                                 
  525.       IF (NARITH .EQ. 0) IF(KH) 304,303,304                                     
  526.   302 IF (KH) 321,307,303                                                       
  527.   321 KEYP = KEYP+100                                                           
  528.       GO TO 306                                                                 
  529.   307 IXMIN = MIN0(IXMIN,IX)                                                    
  530.       JPLT=0                                                                    
  531.       JPCH=0                                                                    
  532.       IXMAX = MAX0(IXMAX,IX)                                                    
  533.   303 IF(KEYP) 306,304,305                                                      
  534.   305 KEYM = KEYP - (100*KH)                                                    
  535.       KT = (KEYM/10)+1                                                          
  536.       KU = KEYM+11-(10*KT)                                                      
  537.   306 NZZ= NZA(IX)/10000                                                        
  538.       NZB1= MOD(NZA(IX),10000)                                                  
  539.       NXX= NXP(IX)/10000                                                        
  540.       NWW= MOD(NXP(IX),10000)                                                   
  541.       NXD  = INXP(IX)                                                           
  542.       NWD  = INWP(IX)                                                           
  543.   311 X = DYTCQ(NXX)                                                            
  544.       W = DYTCQ(NWW)                                                            
  545.       IF (KEYP) 330,304,331                                                     
  546.   330 NTAB = -KEYP                                                              
  547.       IXX = IX                                                                  
  548.       IF (NTAB .LT. 50) GO TO 350                                               
  549.   352 CALL BIVAR                                                                
  550.       GO TO 351                                                                 
  551.   350 NPRE= NTHEAD(NTAB)                                                        
  552.       XXX=  X                                                                   
  553.       KXX= NXX                                                                  
  554.       CALL TABXX(ZXX,XXX,NTAB,NPRE,KXX)                                         
  555.       Z= ZXX                                                                    
  556.       IF(NWW.GT.0)Z=Z*W                                                         
  557.   351 IF (IERFL .EQ. 1) GO TO 312                                               
  558.       GO TO 320                                                                 
  559.   331 GO TO (101,110,120,130,140,150,160,170,180,190),KT                        
  560.   101 KV = KU-1                                                                 
  561.       GO TO (1,2,3,4,5,6,7,8,9,201)  ,KV                                        
  562.     1 Z = X                                                                     
  563.       GO TO 312                                                                 
  564.     2 Z = 1.0/X                                                                 
  565.       GO TO 312                                                                 
  566.     3 Z = X * X                                                                 
  567.       GO TO 312                                                                 
  568.     4 Z = SQRT(ABS(X))                                                          
  569.       GO TO 312                                                                 
  570.     5 Z = X**3                                                                  
  571.       GO TO 312                                                                 
  572.     6 Z = X**4                                                                  
  573.       GO TO 312                                                                 
  574.     7 Z=ABS(X)                                                                  
  575.       GOTO 312                                                                   
  576.     8 Z= ERF(X)                                                                 
  577.       GO TO 312                                                                 
  578.     9 Z= ERFC(X)                                                                
  579.       GO TO 312                                                                 
  580.   110 GO TO (10,11,12,13,201,15,16,201,201,201)KU                              
  581.    10 Z = EXP(X)                                                                
  582.       GO TO 312                                                                 
  583.    11 Z = EXP(2.30259*X)                                                        
  584.       GO TO 312                                                                 
  585.    12 Z = ALOG(X)                                                               
  586.       GO TO 312                                                                 
  587.    13 Z = ALOG10(X)                                                             
  588.       GO TO 312                                                                 
  589.    15 Z= X*DTIME2                                                               
  590.       GO TO 312                                                                 
  591.    16 Z=0.                                                                      
  592.       IF(DTIME2.GT.0.)Z= X/DTIME2                                               
  593.       GO TO 312                                                                 
  594.   120 GO TO (20,21,22,23,24,25,26,201,201,201) , KU                             
  595.  20    Z=SIN(X/RAD)                                                             
  596.       GO TO 312                                                                 
  597.  21    Z=COS(X/RAD)                                                             
  598.       GO TO 312                                                                 
  599.  22       Z=SIN(X/RAD)/COS(X/RAD)                                               
  600.       GO TO 312                                                                 
  601. 23      Z=RAD*ATAN(SQRT(X**2/(1.-X**2)))                                        
  602.         GOTO 312                                                                
  603. 24      Z=RAD*ATAN(SQRT((1.-X**2)/X**2))                                        
  604.         GOTO 312                                                                
  605. 25      Z=RAD*ATAN(X)                                                           
  606.         GOTO 312                                                                
  607.    26 GO TO 201                                                                 
  608.   130 GO TO (131,131,131,133,201,135,136,201,201,201)KU                        
  609.   131 XE = EXP(X)                                                               
  610.       GO TO (30,31,32)KU                                                       
  611.    30 Z = (XE-(1.0/XE))/2.0                                                     
  612.       GO TO 312                                                                 
  613.    31 Z = (XE+(1.0/XE))/2.0                                                     
  614.       GO TO 312                                                                 
  615.    32 Z = (XE-(1.0/XE))/(XE+(1.0/XE))                                           
  616.       GO TO 312                                                                 
  617.   133 GO TO 201                                                                 
  618.   135 Z= X/(1.-X)                                                               
  619.       GO TO 312                                                                 
  620.   136  NFLAG(NZZ-3000)=GAIN(IX)                                                 
  621.        KEY(IX)=136                                                              
  622.        GO TO 340                                                                
  623.   140  GO TO(40,40,40,40,44,40,47,40,44,44)KU                                  
  624. C                CALCULATE HEAT FLOW THROUGH PATH SPECIFIED                     
  625.    40 NXXX=NXX                                                                  
  626.       NA=  MOD(NY1(NXXX),MEGA)/1000                                             
  627.       NB= MOD(NY1(NXXX),1000)                                                   
  628.       IF(KU.EQ.6.OR.KU.EQ.8)GO TO 450                                           
  629.       Z=Y(NXXX)*(T(NA)-T(NB))                                                   
  630.       IF(CON(16).LE.0.) GO TO 141                                               
  631.         IF(NFLAG(NA).NE.-4.AND.NFLAG(NB).NE.-4)GO TO 141                        
  632.       TA=(T(NA)+TZERO)**4                                                       
  633.       TB=(T(NB)+TZERO)**4                                                       
  634.       Z= SIGMA*Y(NXXX)*(TA-TB)                                                  
  635.   141 CONTINUE                                                                  
  636.        IF(KU.EQ.2)Z=Z*DTIME2                                                    
  637.        IF(KU.EQ.3)Z=AMAX1(ABS(T(NA)-T(NB)),1.)**.25                             
  638.        IF(KU.EQ.4)Z=AMAX1(ABS(T(NA)-T(NB)),1.)**.33333                          
  639.       GOTO 312                                                                   
  640.    44 NA= MOD(NY1(NZZ),MEGA)/1000                                               
  641.       NB= MOD(NY1(NZZ),1000)                                                    
  642.       KXX= NZZ                                                                  
  643.       IF(KU.EQ.10) GO TO 450                                                    
  644.    45 X= 0.5*(T(NA)+T(NB))                                                      
  645.       CALL TABXX(ZXX,XXX,NTAB,NPRE,KXX)                                         
  646.       Z = ZXX                                                                   
  647.       IXX=IX                                                                    
  648.       NTAB=NXX                                                                  
  649.       NPRE= NTHEAD(NTAB)                                                        
  650.       XXX= X                                                                    
  651.       IF(KU.EQ.5) Z= Z*W                                                        
  652.       IF(IERFL-1)320,312,320                                                    
  653.    47 NA= MOD(NY1(NWW),MEGA)/1000                                               
  654.       NB= MOD(NY1(NWW),1000)                                                    
  655.       KXX= NWW                                                                  
  656.       GO TO 45                                                                  
  657.   450 TA= T(NA)+ TZERO                                                          
  658.       TB = T(NB)+TZERO                                                          
  659.       Z = SIGMA*(TA**2+TB**2)*(TA+TB)                                           
  660.       IF(KU.EQ.6) Z= Z*W                                                        
  661.       GO TO 312                                                                 
  662.   150 GO TO (50,51,52,53,54,55,56,57,58,59)KU                                  
  663.    50 Z = X+W                                                                   
  664.       GO TO 312                                                                 
  665.    51 Z = X-W                                                                   
  666.       GO TO 312                                                                 
  667.    52 Z = X*W                                                                   
  668.       GO TO 312                                                                 
  669.    53 IF(W.NE.0.)GO TO 532                                                      
  670.       WRITE(6,531) IX,NWW                                                       
  671.   531 FORMAT(1H0,31X,'IN OPERATION',I5,'THE VALUE IN ',I5,                      
  672.      1' WAS INVALID'/)                                                          
  673.       Z= X                                                                      
  674.       GO TO 312                                                                 
  675.   532 Z= X/W                                                                    
  676.                                                                                 
  677.       GO TO 312                                                                 
  678.    54 Z=SQRT(ABS(X*W))                                                          
  679.       GO TO 312                                                                 
  680.    55 Z = (X+W)/2.0                                                             
  681.       GO TO 312                                                                 
  682.    56 IF (X .NE. W) GO TO 562                                                   
  683.   561 Z = X                                                                     
  684.       WRITE(6,531) IX,NWW                                                       
  685.       GO TO 312                                                                 
  686.   562 Z = (X-W)/(ALOG(X/W))                                                     
  687.       GO TO 312                                                                 
  688.    57 Z = SQRT(X*X + W*W)                                                       
  689.       GO TO 312                                                                 
  690.    58 Z = 0.0                                                                   
  691.       DENOM = 0.0                                                               
  692.       DO 581 J=NXX,NWW                                                          
  693.       Z = Z + DYTCQ(J)                                                          
  694.   581 DENOM = DENOM + 1.0                                                       
  695.       Z = Z/DENOM                                                               
  696.       GO TO 312                                                                 
  697.    59 JX = MOD(NXX,1000)                                                        
  698.       JW = MOD(NWW,1000)                                                        
  699.       SUMCT = 0.0                                                               
  700.       SUMC = 0.0                                                                
  701.       DO 591 J=JX,JW                                                            
  702.       SUMCT = SUMCT + C(J)*T(J)                                                 
  703.   591 SUMC = SUMC + C(J)                                                        
  704.       IF (SUMC .GT. 0.0) GO TO 594                                              
  705.   592 KEY(IX) = 159                                                             
  706.       WRITE (6,593) JX,JW                                                       
  707.   593 FORMAT (59H IMPOSSIBLE TO TAKE WEIGHTED AVERAGE OF ZERO CAPACITY N
  708.      1ODES,I6, 8H THROUGH,I6)
  709.       GO TO 304                                                                 
  710.   594 Z = SUMCT/SUMC                                                            
  711.       GO TO 312                                                                 
  712.   160 GOTO(60,61,62,63,64,65,66,67,68,69)KU                                    
  713.    60 IF(X.EQ.0..AND.W.EQ.0.)GO TO 561                                          
  714.       Z= X**W                                                                   
  715.       GO TO 312                                                                 
  716.    61 IF(X.EQ.W)GOTO561                                                         
  717.       Z=1./ALOG(X/W)                                                            
  718.       GOTO 312                                                                   
  719.    62 Z = 0.0                                                                   
  720.       DO 620 J=NXX,NWW                                                          
  721.   620 Z=Z+DYTCQ(J)                                                              
  722.       GO TO 312                                                                 
  723.    63 IXX=IX                                                                    
  724.       GO TO 304                                                                 
  725.    64 Z=EXP(X/(W+459.69))                                                       
  726.       GOTO 312                                                                   
  727.    65 Z=.5*(X-W)/GAIN(IX)**2                                                    
  728.       GOTO 312                                                                   
  729.    66 Z=W+X/GAIN(IX)                                                            
  730.       GOTO 312                                                                   
  731.    67 Z=.5*W*(W+2.*X)                                                           
  732.       GOTO 312                                                                   
  733.    68 Z=.5*(X+W)*(X-W)                                                          
  734.       GOTO 312                                                                   
  735.    69 IF(TIME.GT.PRTIM(1)) GO TO 1002                                           
  736.       NCUT=1                                                                    
  737.       TT=X                                                                      
  738.  1002 IF(TT.GT.TIME)GOTO 340                                                     
  739.       GOTO(1004,1005),NCUT                                                      
  740.  1004 TT=TT+W                                                                   
  741.       NCUT=2                                                                    
  742.       Z=0.                                                                      
  743.       GOTO 312                                                                   
  744.  1005 TT=TT+X                                                                   
  745.       NCUT=1                                                                    
  746.       Z=1.                                                                      
  747.       GOTO 312                                                                   
  748.   170 GO TO (70,71,72,73,74,75,76,77,78,201),KU                                 
  749.    70 Z = AMOD(X,W)                                                             
  750.       GO TO 312                                                                 
  751.    71 Z = AMAX1(X,W)                                                            
  752.       GO TO 312                                                                 
  753.    72 Z = AMIN1(X,W)                                                            
  754.       GO TO 312                                                                 
  755.    73 IF (W) 171,340,340                                                        
  756.    74 IF (W) 340,171,340                                                        
  757.    75 IF (W) 340,340,171                                                        
  758.   171 Z = X                                                                     
  759.       GO TO 312                                                                 
  760.    76 IF (TIME .LT. W) GO TO 340                                                
  761.   761 Z = X                                                                     
  762.       GO TO 312                                                                 
  763.    77 IF (X .GE. W) GO TO 772                                                   
  764.   771 Z = 0.0                                                                   
  765.       GO TO 312                                                                 
  766.   772 Z = 1.0                                                                   
  767.       GO TO 312                                                                 
  768.    78 IF (X-W) 772,771,771                                                      
  769.   180 GO TO (80,81,82,83,84,85,86,87,88,89),KU                                  
  770.    80 IF(X.LT.W)GOTO 340                                                         
  771.   801 KEY(IX) = KEY(IX)+100                                                     
  772.   802 NZZZ = MOD(NZZ,1000)                                                      
  773.       NFLAG(NZZZ)=-1                                                            
  774.       GO TO 340                                                                 
  775.    81 IF(X.LT.W)GOTO 340                                                         
  776.   803 KEY(IX)=KEY(IX)+100                                                       
  777.       NZZZ=MOD(NZZ,1000)                                                        
  778.       NFLAG(NZZZ)=1                                                             
  779.       GOTO 340                                                                   
  780.    82 Z=0.                                                                      
  781.       IF(DTIME2.GT.0.)Z=(X-W)/DTIME2                                            
  782.       GOTO 312                                                                   
  783.    83 Z=X*W/(W+X)                                                               
  784.       GO TO 312                                                                 
  785.    84 Z= DYTCQ(NZZ)*X*W                                                         
  786.       GO TO 312                                                                 
  787.    85 IF(X.LE.W) GO TO 340                                                      
  788.       IPFLAG = 1                                                                
  789.       KEY(IX) = 185                                                             
  790.       GO TO 340                                                                 
  791.    86 IF(X-W) 304,831,831                                                       
  792.    87 IF(X-W) 304,832,832                                                       
  793.   831 KEY(IX)=KEY(IX)+100                                                       
  794.   832 DYTCQ(NZZ)=DYTCQ(NZZ)+GAIN(IX)                                            
  795.       GO TO 304                                                                 
  796.    88 NZZZ= MOD(NZZ,1000)                                                       
  797.       KEY(IX)= KEY(IX)+100                                                      
  798.       DO 880 J1= 1,IPHMAX                                                       
  799.       IF(NZZZ.EQ.IPH(J1)) GO TO 882                                             
  800.   880 CONTINUE                                                                  
  801.       WRITE(6,531) IX,NZZZ                                                      
  802.       GO TO 340                                                                 
  803.   882 PHH1(J1)= PHH1(J1)*X                                                      
  804.       GO TO 340                                                                 
  805.    89 GO TO 201                                                                 
  806.   190 GOTO(90,91,92,92,94,95,96,97,98,99),KU                                    
  807.    90 IF(X.LE.W) GO TO 340                                                      
  808.   901 NZZZ=MOD(NZZ,10)                                                          
  809.       WRITE(6,902)(TITLE(M,NZZZ),M=1,17)                                        
  810.   902 FORMAT(11X,17A4)                                                          
  811.       KEY(IX)=100+KEY(IX)                                                       
  812.       GOTO 340                                                                   
  813.    91 NZZZ=MOD(NZZ,100)                                                         
  814.       IF(NZZ.LE.30)CON(NZZZ)=GAIN(IX)*X                                         
  815.       GOTO304                                                                   
  816.    92 JZ=2*MOD(NZZ,1000)                                                        
  817.       IF(IABS(JZ-6).GE.5)GOTO928                                                
  818.       IF(NARITH.GT.0)IPLOT(JZ)=0                                                
  819.       IF(IPLOT(JZ).GE.100) GO TO 340                                            
  820.       IF(KU.EQ.4)GOTO93                                                         
  821.                                                                                 
  822.       IF(IPFLAG.LE.0)GOTO 340                                                    
  823.       IPLOT(JZ)=IPLOT(JZ)+1                                                     
  824.       JPLOT=IPLOT(JZ)                                                           
  825.       PLOT(JPLOT,JZ)=X                                                          
  826.       PLOT(JPLOT,JZ-1)=W                                                        
  827.       GOTO 340                                                                   
  828.   928 WRITE(6,929)JZ                                                            
  829.   929 FORMAT(15H  PLOT VARIABLE,I6,26H IS OUTSIDE RANGE OF ARRAY)               
  830.       KEY(IX)=192                                                               
  831.       GOTO 340                                                                   
  832.    93 IF(ISFLAG.LE.0)GOTO 340                                                    
  833.       IF(IABS(JZ-6).GE.5)GOTO928                                                
  834.       ILOOP =GAIN(IX)+.01                                                       
  835.       DO 934 M=1,ILOOP                                                          
  836.       IF(IPLOT(JZ).GE.100) GO TO 340                                            
  837.       IPLOT(JZ)=1+IPLOT(JZ)                                                     
  838.       JPLOT=IPLOT(JZ)                                                           
  839.       INXX=NXX+M-1                                                              
  840.       INWW=NWW+M-1                                                              
  841.       PLOT(JPLOT,JZ)=DYTCQ(INXX)                                                
  842.   934 PLOT(JPLOT,JZ-1)=DYTCQ(INWW)                                              
  843.       GOTO 340                                                                   
  844.   94   CALL USER1                                                               
  845.        GO TO 312                                                                
  846.   95   CALL USER2                                                               
  847.        GO TO 312                                                                
  848.    96 ABJ=GAIN(IX)                                                              
  849.       IXX= IX                                                                   
  850.       JBA=ABJ+.01                                                               
  851.       NDXX=MOD(JBA,100)                                                         
  852.       NTABXX=JBA/100                                                            
  853.       CALL INTGRT(X,W,NDXX,NTABXX,Z)                                            
  854.       DYTCQ(NZZ)=Z                                                              
  855.       GOTO 340                                                                   
  856.    97 NXXX=MOD(NXX,100)                                                         
  857.       IF(NXXX.LE.30) Z= CON(NXXX)                                               
  858.       GO TO 312                                                                 
  859.    98 IXX= IX                                                                   
  860.        IF(X.GE.W)CALL SUB98                                                     
  861.       GO TO 304                                                                 
  862.    99 IF(X.LE.W) GO TO 340                                                      
  863.   991 IPFLAG = 1.0                                                              
  864.       ISFLAG = 1.0                                                              
  865.       GO TO 340                                                                 
  866.   312 DYTCQ(NZZ) = Z*GAIN(IX)                                                   
  867.        IF(KT.LE.4.AND.NWW.GT.0)DYTCQ(NZZ)=W*DYTCQ(NZZ)                          
  868.   340 IF(NZB1.LE.NZZ) GO TO 304                                                 
  869.   332 NZZ= NZZ + IZ(IX)                                                         
  870.       IF (NZZ .GT. NZB1) GO TO 304                                              
  871.   333 NXX = NXX+NXD                                                             
  872.       NWW = NWW+NWD                                                             
  873.       GO TO 311                                                                 
  874.   304 CONTINUE                                                                  
  875.       TIME2=TIME                                                                
  876.       IF (NARITH .NE. 1) GO TO 309                                              
  877.   308 IMIN = IXMIN                                                              
  878.       IMAX = IXMAX                                                              
  879.       NARITH = 0                                                                
  880.   309 RETURN                                                                    
  881.   201 WRITE (6,202)IX                                                           
  882.   202 FORMAT (1H0,43H NONEXISTENT ARITHMETIC OPERATION INDICATED,I5)  
  883.   320 IERFL = 2                                                                 
  884.       GO TO 309                                                                 
  885.       END                                                                       
  886.