home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 9 / 09.iso / e / e003 / 12.ddi / TAP62.FOR < prev    next >
Encoding:
Text File  |  1988-01-04  |  59.0 KB  |  745 lines
  1. C     SUBROUTINE  **READ**                                                      
  2.       SUBROUTINE READ                                                           
  3.       INTEGER    A                                                              
  4.       DIMENSION  ZZ(16000),I(3),E(2),J(2),K(2),A(7)                             
  5. C                                                                               
  6.       EQUIVALENCE (ZZ(11053),I(1)),                (ZZ(11056),E(1))             
  7.      X,          (ZZ(11058),J(1)),                (ZZ(11060),K(1))              
  8.      X,          (ZZ(11062),A(1) ),               (ZZ(11069),LFLAG)             
  9.      X,          (ZZ(11090),IXX),                 (ZZ(11099),IZ)                
  10.      X,          (I(1),I1),(I(2),I2),(I(3),I3)                                  
  11.      X,          (J(1),J1),(J(2),J2)                                            
  12.       COMMON  ZZ                                                                
  13. C                                                                               
  14.       IF(LFLAG.EQ.1) GO TO 10                                                   
  15.       READ(5,1)AI1,I1,AI2,I2,I3,E,AJ1,J1,AJ2,J2,K,A                             
  16.       GO TO 14                                                                  
  17.    10 READ(5,12)AI1,I1,AI2,I2,I3,IZ,E,AJ1,J1,AJ2,J2,K,A                         
  18.       IF(E(2).EQ.0.)E(2)=1.                                                     
  19.    12 FORMAT(2(A1,I3),I4,I3,F9.0,F12.0,2(A1,I3),2I4,7A4)                        
  20.    14 CONTINUE                                                                  
  21.       I2S= I2                                                                   
  22.       IF(LFLAG.EQ.-1) I3= MAX0(I3,1)                                            
  23.       IF(LFLAG.EQ.1)IZ= MAX0(IZ,1)                                              
  24.       IX= IXX+1                                                                 
  25.       LP=0                                                                      
  26.     1 FORMAT(2(A1,I3),I4,2F12.0,2(A1,I3),2I4,7A4)                               
  27.     2 FORMAT (6X,2(A1,I3,1X),I4,2E15.6,2(1X,A1,I3),2I5,2X,5A4,2X,2A4)           
  28.     9 FORMAT(1X,I4,1X,2(A1,I3,1X),2I4,1PE11.4,E15.6,2(1X,A1,I3),                
  29.      12I5,2X,5A4,2X,2A4)                                                        
  30.       IP=I1                                                                     
  31.       I1 = LINK(AI1,I1)                                                         
  32.       IF(I1.GE.0.AND.LFLAG.EQ.7) GO TO 6                                        
  33.       IF(LFLAG.EQ.1.AND.I1.GE.0) LP=1                                           
  34.       IF(LP.GT.0)WRITE(6,9)IX,AI1,IP,AI2,I2,I3,IZ,E,AJ1,J1,AJ2,J2,K,A           
  35.       IF(LP.LE.0)WRITE(6,2)   AI1,IP,AI2,I2,I3,E,AJ1,J1,AJ2,J2,K,A              
  36.       LP= 0                                                                     
  37.       IF (I1) 6,3,3                                                             
  38.     3 I2 = LINK(AI1,I2)                                                         
  39.       IF(I2.LT.2999)I2= LINK(AI2,I2S)                                           
  40. C     LFLAG = + FOR FUNIN                                                       
  41.       IF (LFLAG) 6,6,4                                                          
  42.     4 J1 = LINK(AJ1,J1)                                                         
  43.       J2 = LINK(AJ2,J2)                                                         
  44.     6 RETURN                                                                    
  45.       END                                                                       
  46.       SUBROUTINE SPILL                                                          
  47.       DIMENSION ZZ(16000),DYTCQ(11030),CL(4,12)                                 
  48.       EQUIVALENCE (ZZ(0002),DYTCQ(1))                                           
  49.      X,          (ZZ(11062),N2)                                                 
  50.       COMMON  ZZ                                                                
  51.       DATA CL(1,1),CL(2,1),CL(3,1),CL(4,1)/4HADMI,4HTTAN,4HCES ,4H    /
  52.      1,    CL(1,2),CL(2,2),CL(3,2),CL(4,2)/4HTEMP,4HERAT,4HURES,4H    /
  53.      2,    CL(1,3),CL(2,3),CL(3,3),CL(4,3)/4HCAPA,4HCITI,4HES  ,4H    /
  54.      3,    CL(1,4),CL(2,4),CL(3,4),CL(4,4)/4HGENE,4HRATI,4HON R,4HATES/
  55.      4,    CL(1,5),CL(2,5),CL(3,5),CL(4,5)/4HCONS,4HTANT,4HS  (,4HD)  /
  56.      5,    CL(1,6),CL(2,6),CL(3,6),CL(4,6)/4HCONS,4HTANT,4HS  (,4HA)  /
  57.      6,    CL(1,7),CL(2,7),CL(3,7),CL(4,7)/4HCONS,4HTANT,4HS  (,4HB)  /
  58.      7,    CL(1,8),CL(2,8),CL(3,8),CL(4,8)/4HINER,4HTL. ,4HVALU,4HES-L/
  59.      8,    CL(1,9),CL(2,9),CL(3,9),CL(4,9)/4H*030,4HGAIN,4HS  (,4HG)  /
  60.      9,CL(1,10),CL(2,10),CL(3,10),CL(4,10)/4HSPEC,4H.CON,4HSTAN,4HTS  /
  61.       MAXSP= 1999                                                               
  62.       ID=1                                                                      
  63.       ISPIL= 0                                                                  
  64.       WRITE (6,36)                                                              
  65.    36 FORMAT (1H1,42X,11H DYTCQ DUMP/) 
  66.     3 ISPIL = ISPIL+1                                                           
  67.       IF(ISPIL.GT.10) GO TO 33                                                  
  68.       MAXSP= MAXSP+ 1000                                                        
  69.       IF(MAXSP.GT.3000)ID= MAXSP-998                                            
  70.       IF(ISPIL.EQ.10)MAXSP=11020                                                
  71.       IF(ISPIL.EQ.10)ID= 11001                                                  
  72.       IF(N2.EQ.4.AND.ISPIL.EQ.8) GO TO 114                                      
  73.    14 WRITE(6,10)   (CL(I,ISPIL),I=1,4)                                         
  74.       GO TO 115                                                                 
  75.   114 WRITE(6,110)                                                              
  76.   110 FORMAT(9H0   LOC. /5X,'NUMBER',10X,'STEADY STATE RESIDUALS')              
  77.   115 CONTINUE                                                                  
  78.    10 FORMAT(9H0   LOC. / 10H    NUMBER,10X, 4A4/)                              
  79.       IZFLG= 0                                                                  
  80.       DTEST= DYTCQ(ID)                                                          
  81.    15 IXL = ID + 9                                                              
  82.       IF (MAXSP-ID) 28,16,16                                                    
  83.    16 IF(DYTCQ(ID).EQ.DTEST)GO TO 20                                            
  84.    17 IF (IZFLG) 18,18,31                                                       
  85.    18 IMOD= ID                                                                  
  86.       IF(ISPIL.GT.1)IMOD= MOD(ID,1000)                                          
  87.       WRITE (6,19) IMOD,(DYTCQ(IX),IX=ID,IXL)                                   
  88.    19 FORMAT(1H ,2X,I4,2X,1P10E10.3)
  89.       ID = IXL+1                                                                
  90.       DTEST= DYTCQ(ID)                                                          
  91.       GO TO 15                                                                  
  92.    20 IZ = ID+1                                                                 
  93.    21 IF(DYTCQ(IZ).NE.DTEST) GO TO 17                                           
  94.    22 IF (IZ-IXL) 23,24,24                                                      
  95.    23 IZ = IZ+1                                                                 
  96.       GO TO 21                                                                  
  97.    24 IF (IZFLG) 25,25,26                                                       
  98.    25 IZFLG = ID                                                                
  99.    26 ID = IXL+1                                                                
  100.       GO TO 15                                                                  
  101.    28 IF (IZFLG) 3,3,29                                                         
  102.    29 JMOD = MOD(IZFLG,1000)                                                    
  103.       LMOD = MOD(MAXSP,1000)                                                    
  104.       IF(ISPIL.EQ.1) JMOD=IZFLG                                                 
  105.       IF(ISPIL.EQ.1) LMOD= MAXSP                                                
  106.       WRITE(6,32)JMOD,LMOD,DTEST                                                
  107.       GO TO 3                                                                   
  108.    31 IZE= IXL-10                                                               
  109.       JMOD = MOD(IZFLG,1000)                                                    
  110.       KMOD = MOD(IZE,1000)                                                      
  111.       IF(ISPIL.EQ.1) JMOD= IZFLG                                                
  112.       IF(ISPIL.EQ.1) KMOD= IZE                                                  
  113.       WRITE(6,32) JMOD,KMOD,DTEST                                               
  114.    32 FORMAT(1H0,34X,'LOCATIONS ',I4,' THROUGH ',I4,' EQUAL ',1PE12.5 /)        
  115.       IZFLG = 0                                                                 
  116.       GO TO 18                                                                  
  117.    33 RETURN                                                                    
  118.       END                                                                       
  119. C     SUBROUTINE **LATENT**                                                     
  120.       SUBROUTINE LATENT(NTEST)                                                  
  121.       INTEGER NY1(3000),NY2(1000),NZA(1000),INXP(1000),INWP(1000)               
  122.      X, NXP(1000),KEY(1000),IPR(500),IPH(100),NTHEAD(100),NTTAIL(100)           
  123.      X,NFLAG(1000),IZ(1000)                                                     
  124.       DIMENSION  ZZ(16000),T(1000),TOLD(1000),C(1000)                           
  125.      X,PHT1(100),PHH1(100),PHT2(100),PHH2(100),QCH1(100),QCH2(100)              
  126.      X,Q(999)       ,SUMY(999),SUMYT(999)                                       
  127.         COMMON ZZ                                                               
  128.        COMMON/I2BYT/NY1,NY2,NZA,NXP,INXP,INWP,KEY,IPR,IPH                       
  129.      X,NTHEAD,NTTAIL,NFLAG,IZ                                                   
  130.       EQUIVALENCE(ZZ(3002),T(1)),(ZZ(01),TIME),   (ZZ(4002),C(1))               
  131.      X,          (ZZ(11102),PHT1(1)),             (ZZ(11072),DTHETA)            
  132.      X,          (ZZ(11081),IPHMAX),              (ZZ(11082),IPRMAX)            
  133.      X,          (ZZ(11202),PHH1(1) ),            (ZZ(11302),PHT2(1) )          
  134.      X,          (ZZ(11402),PHH2(1) ),            (ZZ(11502),QCH1(1) )          
  135.      X,          (ZZ(11602),QCH2(1) )                                           
  136.      X,          (ZZ(5002),Q(1)),                 (ZZ(11100),ODTIME)            
  137.      X,          (ZZ(12002),SUMY(1)),             (ZZ(13002),TOLD(1))           
  138.      X,          (ZZ(14002),SUMYT(1)),            (ZZ(11083),IPFLAG)            
  139.      X,          (ZZ(11062),NT),                  (ZZ(11005),CON4)              
  140.       DATA COOL,HEAT/4HCOOL,4HHEAT/                                             
  141.     1 DO 90 I =1,IPHMAX                                                         
  142.         K = IPH(I)                                                              
  143.       IF(NFLAG(K).NE.1) GO TO 90                                                
  144.       IF(NTEST.EQ.1) GO TO 200                                                  
  145.       IF(PHH1(I).EQ.0.) GO TO 90                                                
  146.     2   N2 = 1                                                                  
  147.       DT= T(K)-TOLD(K)                                                          
  148.         IF (DT) 6,90,7                                                          
  149.     6 A = COOL                                                                  
  150.          TXS = T(K) -PHT2(I)                                                    
  151.       TXSP = TOLD(K)- PHT2(I)                                                   
  152.          N3 = 2                                                                 
  153.          GO TO 10                                                               
  154.     7 A = HEAT                                                                  
  155.          TXS = T(K) -PHT1(I)                                                    
  156.       TXSP = TOLD(K)- PHT1(I)                                                   
  157.          N3 =1                                                                  
  158.    10   TEST = TXS*TXSP                                                         
  159.         IF (TEST) 11,11,80                                                      
  160.    11   GO TO (12,13),N3                                                        
  161.    12    QCH = QCH1(I)                                                          
  162.          PHT = PHT1(I)                                                          
  163.          PHH = PHH1(I)                                                          
  164.          GO TO 14                                                               
  165.    13    QCH = QCH2(I)                                                          
  166.          PHT = PHT2(I)                                                          
  167.          PHH = PHH2(I)                                                          
  168.    14   IF(TEST) 15,16,80                                                       
  169.    15 TIMEP = TIME - DTHETA*(TXS/DT)                                            
  170.       WRITE (6,100) K,N3,A,TIMEP,PHT                                            
  171.   100 FORMAT (7H0  NODE,I4, 14H, PHASE CHANGE,I2,2H, ,A4,20HING BEGINS A        
  172.      1T TIME =,F8.2,8H, TEMP =,F8.2)                                            
  173.    16   QCH = QCH + C(K)*TXS                                                    
  174.         IF (DT) 18,90,17                                                        
  175.    17    IF (QCH -PHH) 19,20,20                                                 
  176.    18    IF (QCH) 21,21,19                                                      
  177.    19     T(K)= PHT                                                             
  178.           N2  = 2                                                               
  179.           GO TO 79                                                              
  180.    20     DTP = (QCH -PHH)/C(K)                                                 
  181.           QCH = PHH                                                             
  182.           GO TO 78                                                              
  183.    21     DTP =(QCH)/C(K)                                                       
  184.           QCH =0.0                                                              
  185.    78 TIMEP = TIME - DTHETA*(DTP/DT)                                            
  186.          T(K)  = PHT + DTP                                                      
  187.       WRITE (6,101) K,N3,A,TIMEP,PHT,QCH                                        
  188.   101 FORMAT (7H0  NODE,I4,14H, PHASE CHANGE,I2,2H, ,A4,20HING ENDS   AT        
  189.      1 TIME =,F8.2,8H, TEMP =,F8.2, 22H, INTEGRATED HEATING =,E11.4)            
  190.    79 IF (N3 .EQ. 2) GO TO 62                                                   
  191.    61     QCH1(I) =QCH                                                          
  192.           GO TO 80                                                              
  193.    62     QCH2(I) =QCH                                                          
  194.    80 IF (N2 .EQ. 2) GO TO 90                                                   
  195.    81 IF (N3 .EQ. 2) GO TO 83                                                   
  196.    82     TXS = T(K) -PHT2(I)                                                   
  197.       TXSP = TOLD(K)- PHT2(I)                                                   
  198.           N3  = 2                                                               
  199.           GO TO 84                                                              
  200.    83     TXS = T(K) -PHT1(I)                                                   
  201.       TXSP = TOLD(K)- PHT1(I)                                                   
  202.            N3 = 1                                                               
  203.    84      N2 = 2                                                               
  204.            GO TO 10                                                             
  205.   200 IF(PHH1(I).NE.0.) GO TO 90                                                
  206.       TNEW= PHT1(I)                                                             
  207.       TEST3= ABS(T(K)-TNEW)                                                     
  208.       DTT= DTHETA+ODTIME                                                        
  209.       IF(TEST3.LT.CON4) GO TO 90                                                
  210.       TR= 1.+ ODTIME/DTHETA                                                     
  211.       DENOM= TR*C(K)+ODTIME*SUMY(K)                                             
  212.       TNEW2=(TR*C(K)*T(K)+DTT*SUMYT(K)-DTHETA*TOLD(K)*SUMY(K))/DENOM            
  213.       TEST3 =(TNEW2- TNEW)*(TNEW-T(K))                                          
  214.                                                                                 
  215.       IF(TEST3.LE.0.) GO TO 90                                                  
  216.       DEN=TOLD(K)* SUMY(K)-SUMYT(K)                                             
  217.       B1=C(K)*(TNEW-T(K))-ODTIME*(SUMYT(K)-TNEW*SUMY(K))                        
  218.       B1= B1/DEN                                                                
  219.       C1= ODTIME*C(K)*(TNEW-T(K))/DEN                                           
  220.       TEST2= B1**2-4.*C1                                                        
  221.       IF(TEST2.LT.0.) GO TO 90                                                  
  222.       TSQRT= SQRT(TEST2)                                                        
  223.       DTIME = 0.                                                                
  224.       TG1= .5*(TSQRT-B1)                                                        
  225.       TG2=-.5*(B1+TSQRT)                                                        
  226.       IF(TG1.GT.0..AND.TG1.LT.DTHETA)DTIME = TG1                                
  227.       IF(TG2.GT.0..AND.TG2.LT.DTHETA)DTIME = AMAX1(TG2,DTIME)                   
  228.       IF(NT.EQ.2) DTIME =C(K)*(TNEW-T(K))/(SUMYT(K)-T(K)*SUMY(K))               
  229.       IF(DTIME.LE.0..OR.DTIME.GT.DTHETA) GO TO 90                               
  230.       TIME= TIME -DTHETA + DTIME                                                
  231.       DTHETA = DTIME                                                            
  232.       WRITE(6,210) K,TNEW,TIME                                                  
  233.   210 FORMAT(7H0  NODE,I4,' REACHED A VALUE OF ',G12.5,' AT TIME=',             
  234.      1G12.5)                                                                    
  235.       IPFLAG= 1                                                                 
  236.    90 CONTINUE                                                                  
  237.       RETURN                                                                    
  238.       END                                                                       
  239. C     FUNCTION  **LINK**                                                        
  240. C                                                                               
  241. C THIS FUNCTION IDENTIFIES THE TYPE 0F INFORMATION READ IN - D,Y,T,C,Q          
  242. C                                                                               
  243.       FUNCTION LINK(LA,LB)                                                      
  244.       DIMENSION ITEST(13)                                                       
  245. C THE INPUT DATA PREFIXES D,Y,T,C,Q ARECONVERTED TO NUMERICAL PREFIXES          
  246. C 0,1,2,3,4 FOR THE PROGRAM                                                     
  247. C                                                                               
  248.       DATA ITEST/1H*,1HY,1H0,1H ,1H1,1H2,1HT,1HC,1HQ,1HD,1HA,1HB,1HL/           
  249. C                                                                               
  250.       LAB=0                                                                     
  251.       DO 1 I=1,13                                                               
  252.       KTEST = ITEST(I)                                                          
  253.       IF(LA.EQ.KTEST)GO TO(4,5,5,5,5,5,6,8,9,15,13,14,16),I                     
  254.     1 CONTINUE                                                                  
  255.       CALL ERROR                                                                
  256.       GO TO 10                                                                  
  257. C     PREFIX IS AN * (CONTROL CARD)                                             
  258.     4 LAB = -LB                                                                 
  259.       GO TO 10                                                                  
  260. C     PREFIX IS Y,0, ,1,OR2 (ADMITTANCE VALUES)                                 
  261.     5 LAB = LB                                                                  
  262.       IF(I.GT.4)LAB=LAB+1000*(I-4)                                              
  263.       GO TO 10                                                                  
  264. C     PREFIX IS  T (TEMPERATURES) OR P (PRESSURES)                              
  265.     6 LAB= 3000+ LB                                                             
  266.       GO TO 10                                                                  
  267. C PREFIX IS C (CAPACITANCE)                                                     
  268.     8 LAB= 4000+ LB                                                             
  269.       GO TO 10                                                                  
  270. C PREFIX IS Q (HEAT GENERATION RATE)                                            
  271.     9 LAB= 5000+ LB                                                             
  272.       GO TO 10                                                                  
  273. C     PREFIX IS A  CONSTANTS FOR CALCULATION                                    
  274.    13 LAB=7000 + LB                                                             
  275.       GO TO 10                                                                  
  276. C     PREFIX IS B  CONSTANTS FOR CALCULATIONS                                   
  277.    14 LAB=8000 + LB                                                             
  278.       GO TO 10                                                                  
  279. C     PREFIX IS D  DUMMY CONSTANTS FOR CALCULATIONS                             
  280.    15 LAB=6000 + LB                                                             
  281.       GO TO 10                                                                  
  282. C     PREFIX IS U (MAXIMUM TEMPERATURES)                                        
  283.    16 LAB= 9000 + LB                                                            
  284.    10 LINK = LAB                                                                
  285.       RETURN                                                                    
  286.       END                                                                       
  287. C     SUBROUTINE **TABXX**                                                      
  288. C     THIS SUBROUTINE USES LINEAR INTERPOLATION IN EVALUATING TABLE             
  289. C     FUNCTIONS                                                                 
  290.       SUBROUTINE TABXX(Z,X,NTAB,NPRE,KX)                                        
  291.       INTEGER NY1(3000),NY2(1000),NZA(1000),INXP(1000),INWP(1000)               
  292.      X, NXP(1000),KEY(1000),IPR(500),IPH(100),NTHEAD(100),NTTAIL(100)           
  293.      X,NFLAG(1000),IZ(1000),NPREX(100)                                          
  294.       DIMENSION  ZZ(16000),TABL(1000)                                           
  295.        COMMON/I2BYT/NY1,NY2,NZA,NXP,INXP,INWP,KEY,IPR,IPH                       
  296.      X,NTHEAD,NTTAIL,NFLAG,IZ                                                   
  297.       EQUIVALENCE(ZZ(11069), LFLAG),              (ZZ(11070), IERFL)            
  298.      X,          (ZZ(001),TIME),                  (ZZ(15002),TABL(1))           
  299.      X,          (ZZ(11087),NARITH),              (ZZ(11090),IXX)               
  300.       COMMON ZZ                                                                 
  301.       NTH=NTHEAD(NTAB)                                                          
  302.       NTT=NTTAIL(NTAB)                                                          
  303.       IF(LFLAG.GE.10) GO TO 20                                                  
  304.       DO 25  J=1,100                                                            
  305.    25 NPREX(J)= NTHEAD(J)                                                       
  306.       LFLAG = 10                                                                
  307.    20 NT = NPREX(NTAB)                                                          
  308.       IF (X-TABL(NT)) 7,1,2                                                     
  309.     1 Z = TABL(NT+1)                                                            
  310.       GO TO 16                                                                  
  311.     2 IF (NT-NTT) 3,12,12                                                       
  312.     3 IF (X-TABL(NT+2))6,4,5                                                    
  313.     4 NT=NT+2                                                                   
  314.       GO TO 1                                                                   
  315.     5 NT=NT+2                                                                   
  316.       GO TO 2                                                                   
  317.     6 SLOPE=(TABL(NT+3)-TABL(NT+1))/(TABL(NT+2)-TABL(NT))                       
  318.       Z = TABL(NT+1)+SLOPE*(X-TABL(NT))                                         
  319.       GO TO 16                                                                  
  320.     7 IF (NT-NTH) 12,12,8                                                       
  321.     8 IF (X-TABL(NT-2)) 10,9,11                                                 
  322.     9 NT = NT-2                                                                 
  323.       GO TO 1                                                                   
  324.    10 NT = NT-2                                                                 
  325.       GO TO 7                                                                   
  326.    11 SLOPE=(TABL(NT+1)-TABL(NT-1))/(TABL(NT)-TABL(NT-2))                       
  327.       Z = TABL(NT+1)-SLOPE*(TABL(NT)-X)                                         
  328.       GO TO 16                                                                  
  329.    12 IERFL=0                                                                   
  330.       IF (KX) 13,17,13                                                          
  331.    17 WRITE(6,18)IXX,X,NTAB                                                     
  332.    18 FORMAT(1H0,12HIN OPERATION,I4,1H,,E12.5,'LIES OUTSIDE LIMITS OF ',
  333.      X'TABLE ',I4)
  334.        GO TO 16
  335.    13 WRITE(6,14)IXX,KX,X,NTAB                                                  
  336.    14 FORMAT(1H0,12HIN OPERATION,I4,1H,,I6,1H=,E12.5, 
  337.      129H LIES OUTSIDE LIMITS OF TABLE,I4)  
  338.    16 NPREX(NTAB) = NT                                                          
  339.       RETURN                                                                    
  340.       END                                                                       
  341. C     SUBROUTINE TO INTEGRATE BETWEEN VALUES IN A TABLE TO OBTAIN A             
  342. C       MEAN VALUE                                                              
  343.       SUBROUTINE INTGRT(XMIN,XMAX,NDX,NTAB,Z)                                   
  344. C                                                                               
  345.       DIMENSION  A(100),X(100)                                                  
  346.       INTEGER NY1(3000),NY2(1000),NZA(1000),INXP(1000),INWP(1000)               
  347.      X, NXP(1000),KEY(1000),IPR(500),IPH(100),NTHEAD(100),NTTAIL(100)           
  348.      X,NFLAG(1000),IZ(1000)                                                     
  349.        COMMON/I2BYT/NY1,NY2,NZA,NXP,INXP,INWP,KEY,IPR,IPH                       
  350.      X,NTHEAD,NTTAIL,NFLAG,IZ                                                   
  351. C                                                                               
  352.    10 ANDX = NDX                                                                
  353.       K = NDX + 1                                                               
  354.       NPREV = NTHEAD(NTAB)                                                      
  355. C                                                                               
  356.    20 DELTAX = (XMAX-XMIN)/ANDX                                                 
  357.       X(1) = XMIN                                                               
  358.       DO 30 I=2,K                                                               
  359.       X(I) = X(I-1) + DELTAX                                                    
  360.    30 CONTINUE                                                                  
  361. C                                                                               
  362.       DO 50 I1=1,K                                                              
  363.       KX = 30000 + I1                                                           
  364.       XX = X(I1)                                                                
  365.       CALL TABXX(V,XX,NTAB,NPREV,KX)                                            
  366.       A(I1) = V                                                                 
  367.    50 CONTINUE                                                                  
  368. C                                                                               
  369.       SUMA = 0.0                                                                
  370.       DO 100 I2=2,K                                                             
  371.       DELA =((A(I2)+A(I2-1))/2.0) * DELTAX                                      
  372.       SUMA = SUMA + DELA                                                        
  373.   100 CONTINUE                                                                  
  374. C                                                                               
  375.       Z = SUMA/(XMAX-XMIN)                                                      
  376.       RETURN                                                                    
  377.       END                                                                       
  378. C     SUBROUTINE  **HEADER**                                                    
  379.       SUBROUTINE HEADER                                                         
  380.       COMMON /LAB4/SPROG(2)                                                     
  381.       COMMON /LAB2/DATE(3)                                                      
  382.    10 WRITE (6,20)                                                              
  383.    20 FORMAT(1H1/1H-/1H-,36X,35HROCKETDYNE THERMAL ANALYZER PROGRAM) 
  384.       WRITE(6,30)SPROG                                                          
  385.    30 FORMAT(1H0,41X,2A4,' AUGUST,1969' )                                       
  386.       WRITE(6,40)                                                               
  387. 40     FORMAT(1H0,38X,'MODIFIED FOR U.S.C.SAP USERS GROUP 5/30/79')             
  388.       WRITE(6,60)                                                               
  389.    60 FORMAT(1H0,//19X,'THIS PROGRAM USES A THREE TIME LEVEL INTEGRATION        
  390.      1 METHOD. THE THREE'/19X,'LEVEL METHOD CAN BE USED BY SETTIN               
  391.      2G CON(12)=1.')                                                            
  392.       WRITE(6,70) DATE                                                          
  393.    70 FORMAT(1H0,//41X,'THIS RUN WAS MADE ON ',3A4 )                            
  394.       RETURN                                                                    
  395.       END                                                                       
  396. C     SUBROUTINE  **BIVAR**                                                     
  397. C           BIVARIATE TABLES                                                    
  398.       SUBROUTINE BIVAR                                                          
  399.       INTEGER NY1(3000),NY2(1000),NZA(1000),INXP(1000),INWP(1000)               
  400.      X, NXP(1000),KEY(1000),IPR(500),IPH(100),NTHEAD(100),NTTAIL(100)           
  401.      X,NFLAG(1000),IZ(1000)                                                     
  402.        COMMON/I2BYT/NY1,NY2,NZA,NXP,INXP,INWP,KEY,IPR,IPH                       
  403.      X,NTHEAD,NTTAIL,NFLAG,IZ                                                   
  404.       DIMENSION  ZZ(16000),TABL(1000)                                           
  405.       COMMON ZZ                                                                 
  406.       EQUIVALENCE(ZZ(001),TIME),                  (ZZ(15002),TABL(1))           
  407.       EQUIVALENCE(ZZ(11069), LFLAG),              (ZZ(11070), IERFL)            
  408.      X,          (ZZ(11091),NTLAST),              (ZZ(11092),NWW)               
  409.      X,          (ZZ(11093),NXX),                 (ZZ(11094),NZZ)               
  410.      X,          (ZZ(11095), W ),                 (ZZ(11096), X )               
  411.      X,          (ZZ(11097), Z ) ,                (ZZ(11098), NTAB)             
  412.       DATA  ITDTAG/4HTIME/                                                      
  413.       XX= X                                                                     
  414.     1 NTABB = NTAB                                                              
  415.       NTH = NTHEAD(NTABB)                                                       
  416.       NTT = (NTTAIL(NTABB))-1                                                   
  417.       IERFL = 1                                                                 
  418.     2 IF (W-TABL(NTH)) 16,13,3                                                  
  419.     3 IF (W-TABL(NTT))4,14,16                                                   
  420.     4 NT = NTH+2                                                                
  421.       DO 6 I=NT,NTT,2                                                           
  422.     5 IF(W-TABL(I))7,50,6                                                       
  423.     6 CONTINUE                                                                  
  424.    50 NT = I                                                                    
  425.       GO TO 15                                                                  
  426.     7 NT=I                                                                      
  427.       ASSIGN 10 TO IBV                                                          
  428.       NTAB2 = TABL(NT-1)+0.1                                                    
  429.       W2 = TABL(NT-2)                                                           
  430.       W1 = TABL(NT)                                                             
  431.     8 NTAB = TABL(NT+1)+0.1                                                     
  432.       IF (NTHEAD(NTAB)) 31,31,29                                                
  433.    29 IX=IXX                                                                    
  434.       NN = NTHEAD(NTAB)                                                         
  435.       CALL TABXX(ZX,XX,NTAB,NN,NWW)                                             
  436.       Z = ZX                                                                    
  437.       IF(IERFL.EQ.0)  IERFL = 2                                                 
  438.       GO TO (9,27), IERFL                                                       
  439.     9 GO TO IBV,(28,10)                                                         
  440.    10 Z1 = Z                                                                    
  441.       NTAB = NTAB2                                                              
  442.       IF (NTHEAD(NTAB)) 31,31,30                                                
  443.    30 IX=IXX                                                                    
  444.       NN = NTHEAD(NTAB)                                                         
  445.       CALL TABXX(ZX,XX,NTAB,NN,NWW)                                             
  446.       Z = ZX                                                                    
  447.       IF(IERFL.EQ.0)  IERFL = 2                                                 
  448.       IF (IERFL-1)12,12,27                                                      
  449.    12 Z = ((Z1-Z)*(W-W2)/(W1-W2))+Z                                             
  450.       GO TO 28                                                                  
  451.    13 NT=NTH                                                                    
  452.    15 ASSIGN 28 TO IBV                                                          
  453.       GO TO 8                                                                   
  454.    14 NT=NTT                                                                    
  455.       GO TO 15                                                                  
  456.    16 IF (NWW) 19,25,19                                                         
  457.   19   ITDTAG=NWW                                                               
  458.   25   ITDVTG=NZZ                                                               
  459.       WRITE (6,18) ITDVTG, ITDTAG, ITDTAG, W, NTAB                              
  460.    18 FORMAT ('0',2X,'***IN THE EVALUATION OF ',A4,', AS A FUNCTION OF '        
  461.      1,A4,', ',A4,' =',1E12.5,', WHICH EXCEEDS LIMITS OF TABLE',I3,'**')        
  462.       GO TO 27                                                                  
  463.    31 WRITE (6,32) NTAB                                                         
  464.    32 FORMAT (29H0 A NONEXISTENT TABLE, NUMBER,I3, 17H, HAS BEEN CALLED)
  465.    27 IERF = 2                                                                  
  466.       ISFLAG = 1                                                                
  467.    28 RETURN                                                                    
  468.       END                                                                       
  469. C     SUBROUTINE  **SETUP**                                                     
  470. C           **** MODIFIED FEB 1968****                                          
  471.       SUBROUTINE SETUP(JSTART)                                                  
  472.       DIMENSION ZZ(16000),Q(1000),Y(3000),T(1000),C(1000),CON(20)               
  473.      X,PHT1(100),PHT2(100),QCH1(100),PHH1(100),QCH2(100),PHH2(100)              
  474.      X,PRTIM(10),IP(3000),DYTCQ(1)                                              
  475.         INTEGER NY1(3000),NY2(1000),NZA(1000),INXP(1000),INWP(1000)             
  476.       INTEGER NXP(1000),KEY(1000),NFLAG(1000),IZ(1000),IPR(500),IPH(100)        
  477.        INTEGER NTHEAD(100),NTTAIL(100)                                          
  478.        COMMON /I2BYT/NY1,NY2,NZA,NXP,INXP,INWP,KEY,IPR,IPH                      
  479.      X,NTHEAD,NTTAIL,NFLAG,IZ                                                   
  480.       COMMON /LAB1/ PLOT(100,10),IPLOT(10),TMAX(1000)                           
  481.       COMMON /LAB2/DATE(2)                                                      
  482.       EQUIVALENCE (ZZ(001),TIME),                 (ZZ(002),Y(1),DYTCQ(1)        
  483.      X) ,        (ZZ(3002),T(1)) ,                (ZZ(4002),C(1))               
  484.      X,          (ZZ(5002),Q(1))                                                
  485.      X,      (ZZ(10001),LYMIN),     (ZZ(10501),LYMAX)                           
  486.      X,          (ZZ(11002),CON(1)),              (ZZ(11010),CON9,SIGMA)        
  487.      X,          (ZZ(11011),CON10,TZERO),         (ZZ(11032),PRTIM(1))          
  488.       EQUIVALENCE(ZZ(11069), LFLAG),              (ZZ(11070), IERFL)            
  489.      X,          (ZZ(11071),PRTMX),               (ZZ(11072),DTHETA)            
  490.      X,          (ZZ(11073),RCMIN),               (ZZ(11074), JSAVE)            
  491.      X,          (ZZ(11075),DELTAT),              (ZZ(11076),DTMAX )            
  492.      X,          (ZZ(11077), IMIN),               (ZZ(11078), IMAX )            
  493.      X,          (ZZ(11079), IXMIN),              (ZZ(11080), IXMAX)            
  494.      X,          (ZZ(11081),IPHMAX),              (ZZ(11082),IPRMAX)            
  495.      X,          (ZZ(11083),IPFLAG),              (ZZ(11084),ISFLAG)            
  496.      X,          (ZZ(11085),MAXNOT),              (ZZ(11086),MAXNOY)            
  497.      X,          (ZZ(11087),NARITH),              (ZZ(11088),NCRIT )            
  498.       EQUIVALENCE (ZZ(11089),NTIME),              (ZZ(11090), NT )              
  499.      X,          (ZZ(11091),NTLAST),              (ZZ(11092),NWW)               
  500.      X,          (ZZ(11093),NXX),                 (ZZ(11094),NZZ)               
  501.      X,          (ZZ(11095), W ),                 (ZZ(11096), X )               
  502.      X,          (ZZ(11097), Z ) ,                (ZZ(11098), NTAB)             
  503.      X,          (ZZ(11099),CFLAG),               (ZZ(11100),ODTIME)            
  504.      X,          (ZZ(11101),DTIME ),              (ZZ(11102),PHT1(1) )          
  505.      X,          (ZZ(11202),PHH1(1) ),            (ZZ(11302),PHT2(1) )          
  506.      X,          (ZZ(11402),PHH2(1) ),            (ZZ(11502),QCH1(1) )          
  507.      X,          (ZZ(11602),QCH2(1) )                                           
  508.      X,          (ZZ(12002),IP(1)),     (ZZ(11056),NYMIN)                       
  509.       COMMON ZZ                                                                 
  510. C     SET LATENT HEAT DATA                                                      
  511.   200 DO 206 I = 1,IPHMAX                                                       
  512.         K = IPH(I)                                                              
  513.         IF(T(K) -PHT1(I)) 201,203,202                                           
  514.   201   QCH1(I) = 0.0                                                           
  515.         GO TO 203                                                               
  516.   202   QCH1(I) = PHH1(I)                                                       
  517.   203   IF (T(K) -PHT2(I)) 204,206,205                                          
  518.   204     QCH2(I) =0.0                                                          
  519.           GO TO 206                                                             
  520.   205     QCH2(I) = PHH2(I)                                                     
  521.   206     CONTINUE                                                              
  522.   310 IF((JSTART.EQ.0).AND.(CON(11).NE.0.)) GO TO 750                           
  523.       LIMY=1                                                                    
  524.         MEGA=1000000                                                            
  525.       JLIMY=1                                                                   
  526.       DO 350 J=1,MAXNOY                                                         
  527.   350 IP(J)=0                                                                   
  528.   410 WRITE (6,420)                                                             
  529.   420 FORMAT(1H1,36X,28HSUMMARY OF NODE CONNECTIONS //
  530.      1,'  NODE  INITIAL   NODE  CAPACITY    GENERATION              NODE
  531.      2  NODE   CONNECTOR        INITIAL '/
  532.      3,'    NO    VALUE    FLAG                 RATE                  NO'
  533.      4 FLAG    NUMBER         ADMITTANCE '//)
  534.   500 DO 690 J1=1,MAXNOT                                                        
  535.       IF(NFLAG(J1).EQ.0) GO TO 690                                              
  536.       DO 570 J2=LIMY,MAXNOY                                                     
  537.       JT=NY1(J2)/MEGA                                                           
  538.       IF(IP(J2).GE.2)GO TO 570                                                  
  539.       IF(JT.GT.0)IP(J2)=2                                                       
  540.       JL= MOD(NY1(J2),MEGA)/1000                                                
  541.       JM= MOD(NY1(J2),1000)                                                     
  542.       IF(JL.EQ.J1.OR.JM.EQ.J1)GO TO 580                                         
  543.   570 CONTINUE                                                                  
  544.       GO TO 690                                                                 
  545.   580 LMIN=J2+1                                                                 
  546.       JT=MOD(NY1(J2),MEGA)/1000                                                 
  547.       IF(JT.EQ.J1)JT=MOD(NY1(J2),1000)                                          
  548.       WRITE(6,610)J1,T(J1),NFLAG(J1),C(J1),Q(J1),JT,NFLAG(JT),J2,Y(J2)          
  549.       IP(J2)=IP(J2)+1                                                           
  550.   610 FORMAT(1H ,I5,1X,E12.4,I4,2E12.4,12X,2I5,5X,I6,7X,1PE12.4)    
  551.       DO 630 L2=LMIN,MAXNOY                                                     
  552.       JT= NY1(L2)/MEGA                                                          
  553.       IF(IP(L2).GE.2)GO TO 630                                                  
  554.       IF(JT.GT.0)IP(L2)=0                                                       
  555.       JT1=MOD(NY1(L2),MEGA)/1000                                                
  556.       JT2= MOD(NY1(L2),1000)                                                    
  557.       IF(J1.EQ.JT1.OR.J1.EQ.JT2)IP(L2)=IP(L2)+1                                 
  558.       IF(JT1.EQ.J1) WRITE(6,620)JT2,NFLAG(JT2),L2,Y(L2)                         
  559.       IF(JT2.EQ.J1) WRITE(6,620)JT1,NFLAG(JT1),L2,Y(L2)                         
  560.   620 FORMAT(60X,I4,I5,5X,I6,7X,1PE12.4)                                        
  561.   630 CONTINUE                                                                  
  562.       DO 650 L2=LIMY,MAXNOY                                                     
  563.       IF(IP(L2).LT.2)GO TO 660                                                  
  564.   650 JLIMY= L2                                                                 
  565.   660 LIMY=JLIMY                                                                
  566.   690 CONTINUE                                                                  
  567.   700 IF(LYMAX.LE.0)GO TO 750                                                   
  568.       WRITE(6,800)                                                              
  569.         IF(NYMIN.LE.0)WRITE(6,820)                                              
  570.         IF(NYMIN.GT.0)WRITE(6,810)                                              
  571.        WRITE(6,830)                                                             
  572.   800 FORMAT(1H1,36X,'SUMMARY OF FLOW NODE CONNECTORS '/)                       
  573. 810     FORMAT(1H0/                                                             
  574.      1'  CONNECTOR      INITIAL        DOWNSTREAM    NODE      INITIAL          
  575.      2  UPSTREAM    NODE      INITIAL')                                         
  576. 820     FORMAT(1H0/                                                             
  577.      1'  CONNECTOR       INITIAL       UPSTREAM     NODE        INITIAL         
  578.      2  DOWNSTREAM   NODE  INITIAL')                                            
  579. 830     FORMAT(1H0/                                                             
  580.      1'   NUMBER         VALUE           NODE        FLAG       VALUE           
  581.      4  NODE        FLAG       VALUE '//)                                       
  582.       DO 850 J1=1,LYMAX                                                         
  583.       J2=NY2(J1)                                                                
  584.       IF(J2.EQ.0) GO TO 850                                                     
  585.       JT1= MOD(NY1(J2),MEGA)/1000                                               
  586.       JT2= MOD(NY1(J2),1000)                                                    
  587.       WRITE(6,860)J2,Y(J2),JT1,NFLAG(JT1),T(JT1),JT2,NFLAG(JT2),T(JT2)          
  588.   850 CONTINUE                                                                  
  589.   860 FORMAT(1H ,I8,4X,1PE12.4,2X,2I11,6X,G12.4,I4,I11,6X,G12.4)                
  590.   750 JSTART = 0                                                                
  591.       RETURN                                                                    
  592.       END                                                                       
  593. C     SUBROUTINE  **TIMER**                                                     
  594.       SUBROUTINE TIMER                                                          
  595.       INTEGER NY1(3000),NY2(1000),NZA(1000),INXP(1000),INWP(1000)               
  596.       INTEGER NXP(1000),KEY(1000),NFLAG(1000),IZ(1000),IPR(500),IPH(100)        
  597.      X,NTHEAD(100),NTTAIL(100)                                                  
  598.       DIMENSION  ZZ(16000),DYTCQ(11030),Y(3000),T(1000)                         
  599.      X,C(1000)        ,Q(1000)        ,GAIN(1000) ,A(1000),B(1000)              
  600.      X,D(1000),SUMY(1000),SUMYT(1000), TOLD(1000),L(1000)                       
  601.      X,PHT1(100),PHH1(100),PHT2(100),PHH2(100),QCH1(100)                        
  602.      X,QCH2(100),CON(20),PRTIM(10),DELTIM(10),TITLE(17,10),TABL(1000)           
  603.      X,TPROG(2),AA(7)                                                           
  604.        COMMON/I2BYT/NY1,NY2,NZA,NXP,INXP,INWP,KEY,IPR,IPH                       
  605.      X,NTHEAD,NTTAIL,NFLAG,IZ                                                   
  606.       EQUIVALENCE (ZZ(001),TIME),         (ZZ(002),Y(1),DYTCQ(1))               
  607.      X,          (ZZ(3002),T(1)),                 (ZZ(4002),C(1))               
  608.      X,          (ZZ(5002),Q(1)),                 (ZZ(6002),D(1) )              
  609.      X,          (ZZ(7002),A(1) ),              (ZZ(8002), B(1) )               
  610.      X,          (ZZ(9002),L(1) ),                (ZZ(10002),GAIN(1) )          
  611.      X,          (ZZ(11002),CON(1)),              (ZZ(11010),CON9,SIGMA)        
  612.      X,          (ZZ(11011),CON10,TZERO), (ZZ(11032),PRTIM(1))                  
  613.      X,          (ZZ(11042),DELTIM(1)),           (ZZ(11053),IREAD)             
  614.       EQUIVALENCE(ZZ(11060),MIN1T),               (ZZ(11061),MAX1T)             
  615.      X,          (ZZ(11062),N2)                                                 
  616.       EQUIVALENCE(ZZ(11069), LFLAG),              (ZZ(11070), IERFL)            
  617.      X,          (ZZ(11071),PRTMX),               (ZZ(11072),DTHETA)            
  618.      X,          (ZZ(11073),RCMIN),               (ZZ(11074), JSAVE)            
  619.      X,          (ZZ(11075),DELTAT),              (ZZ(11076),DTMAX )            
  620.      X,          (ZZ(11077), IMIN),               (ZZ(11078), IMAX )            
  621.      X,          (ZZ(11079), IXMIN),              (ZZ(11080), IXMAX)            
  622.      X,          (ZZ(11081),IPHMAX),              (ZZ(11082),IPRMAX)            
  623.      X,          (ZZ(11083),IPFLAG),              (ZZ(11084),ISFLAG)            
  624.      X,          (ZZ(11085),MAXNOT),              (ZZ(11086),MAXNOY)            
  625.      X,          (ZZ(11087),NARITH),              (ZZ(11088),NCRIT )            
  626.       EQUIVALENCE (ZZ(11089),NTIME),              (ZZ(11090), NT )              
  627.      X,          (ZZ(11091),NTLAST),              (ZZ(11092),NWW)               
  628.      X,          (ZZ(11093),NXX),                 (ZZ(11094),NZZ)               
  629.      X,          (ZZ(11095), W ),                 (ZZ(11096), X )               
  630.      X,          (ZZ(11097), Z ) ,                (ZZ(11098), NTAB)             
  631.      X,          (ZZ(11099),OTIME2),              (ZZ(11100),ODTIME)            
  632.      X,          (ZZ(11101),DTIME),               (ZZ(11102),PHT1(1))           
  633.      X,          (ZZ(11202),PHH1(1)),             (ZZ(11302),PHT2(1))           
  634.      X,          (ZZ(11402),PHH2(1)),             (ZZ(11502),QCH1(1))           
  635.      X,          (ZZ(11602),QCH2(1))                                            
  636.       EQUIVALENCE(ZZ(12002),SUMY(1)),             (ZZ(13002),TOLD(1))           
  637.      X,          (ZZ(14002),SUMYT(1)),            (ZZ(15002),TABL(1))           
  638.       COMMON  ZZ                                                                
  639.       IF(IERFL.EQ.2) GO TO 50                                                   
  640.         RC=1.E36                                                                
  641.       IF(TIME.EQ.PRTIM(1))POTIME=PRTIM(1)                                       
  642.       IF(N2.EQ.4) GO TO 100                                                     
  643.       IF(DELTAT.LE.0.)DELTAT=DELTIM(1)                                          
  644.       MINDO= MIN1T                                                              
  645.       MAXDO= MAX1T                                                              
  646.       ITEST= 10                                                                 
  647.       IF(CON(14).GT.0.)ITEST= CON(14)                                           
  648.       RCMIN= 1.0E36                                                             
  649.       TTEST=0.1                                                                 
  650.       IF(CON(8).GT.0.0)TTEST=CON(8)                                             
  651.       ICOUNT= 0                                                                 
  652.       DO 10  J= MIN1T,MAX1T                                                     
  653.       IF(SUMY(J).LE.0.) GO TO 10                                                
  654.         IF(NFLAG(J).LT.1)GO TO 10                                               
  655.       IF(C(J).GT.0.) RC= C(J)/SUMY(J)                                           
  656.     7 IF(RC.GE.RCMIN) GO TO 10                                                  
  657.       NCRIT = J                                                                 
  658.       RCMIN= AMIN1(RC,RCMIN)                                                    
  659.    10 CONTINUE                                                                  
  660.       DELTAT= RCMIN*CON(3)                                                      
  661.       GO TO 30                                                                  
  662.    15 CONTINUE                                                                  
  663.       IF(IPFLAG.LE.0.AND.ICOUNT.LE.ITEST) GO TO 30                              
  664.       DELTAT = 2.*AMAX1(RCMIN,DELTAT)                                           
  665.       ICOUNT= 0                                                                 
  666.       DTT= ODTIME+DELTAT                                                        
  667.       RCMIN= 1.0E36                                                             
  668.       TR= 1.+ ODTIME/DELTAT                                                     
  669.       DO 20 J = MINDO,MAXDO                                                     
  670.         IF(NFLAG(J).LT.1)GO TO 20                                               
  671.       IF(SUMY(J).LE.0.) GO TO 20                                                
  672.       IF(C(J).LE.0.) GO TO 16                                                   
  673.       RC = C(J)/SUMY(J)                                                         
  674.       IF(RC.LT.RCMIN)NCRIT= J                                                   
  675.    16 CONTINUE                                                                  
  676.       RCMIN= AMIN1(RC,RCMIN)                                                    
  677.    17 CONTINUE                                                                  
  678.       DENOM=TR*C(J)+ODTIME*SUMY(J)                                              
  679.       TNEW=TR*C(J)*T(J)+DTT*SUMYT(J)-DELTAT*SUMY(J)*TOLD(J)                     
  680.    18 TNEW = TNEW/DENOM                                                         
  681.       DENOM=C(J)+ODTIME*SUMY(J)                                                 
  682.       TDUM=(DTT*SUMYT(J)-TOLD(J)*(DELTAT*SUMY(J)-C(J)))/DENOM                   
  683.       ERTMP=ABS(TDUM-TNEW)*(1.+DELTAT/RC)                                       
  684.       ERTMP=ERTMP*(1.+DELTAT/RC)/TR                                             
  685.       IF(ERTMP.LE.TTEST) GO TO 20                                               
  686.       EMAX=0.5*RCMIN*CON(3)                                                     
  687.       IF(DELTAT.LT.EMAX)GO TO 20                                                
  688.       DELTAT= DELTAT/2.                                                         
  689.       DTT= ODTIME + DELTAT                                                      
  690.       TR= 1.+ ODTIME/DELTAT                                                     
  691.       GO TO 17                                                                  
  692.    20 CONTINUE                                                                  
  693.    25 CONTINUE                                                                  
  694.    30 ICOUNT = ICOUNT + 1                                                       
  695.       COMP = POTIME -TIME                                                       
  696.       IF(COMP.LE.0.)COMP= DELTIM(NTIME)                                         
  697.       IC= COMP/DELTAT                                                           
  698.       IF(IC.LT.1) IC=1                                                          
  699.       DIC= IC                                                                   
  700.       DELTAT = COMP/DIC                                                         
  701.       IF(N2.EQ.2.AND.DELTAT.GT.RCMIN)DELTAT= COMP/(DIC+1)                       
  702.       DELTAT= AMIN1(CON(1),DELTAT)                                              
  703.    40 IF(DELTAT.LT.CON(2)) IERFL=2                                              
  704.       IF(IERFL.LT.2) GO TO 100                                                  
  705.       WRITE(6,41)DELTAT,CON(2)                                                  
  706.    41 FORMAT(1H ,10X,'DELTAT=',E12.4,' AND IS LESS THAN THE MINIMUM VALUE       
  707.      1 ALLOWED (',E12.4,'),RUN TERMINATED')                                     
  708.    50 RETURN                                                                    
  709.   100 IF(IPFLAG.NE.1) GO TO 140                                                 
  710.       IPFLAG= 0                                                                 
  711.       IF(TIME.LT.POTIME) GO TO 140                                              
  712.       POTIME= POTIME + DELTIM(NTIME)                                            
  713.       CHECK= PRTIM(NTIME+1)-0.001*DELTIM(NTIME)                                 
  714.       IF(POTIME.LT.CHECK) GO TO 140                                             
  715.       NTIME=NTIME+1                                                             
  716.                                                                                 
  717.       POTIME= PRTIM(NTIME)                                                      
  718.       IF(DELTIM(NTIME).LE.0.) DELTIM(NTIME)= DELTIM(NTIME-1)                    
  719.   140 TIMEX = TIME + DELTAT                                                     
  720.       TEST= POTIME - 0.10*DELTAT                                                
  721.       IF(TIMEX.LT.TEST) GO TO 150                                               
  722.       DELTAT=  POTIME - TIME                                                    
  723.       TIMEX= POTIME                                                             
  724.       IPFLAG=1                                                                  
  725.   150 DTHETA = DELTAT                                                           
  726.       TIME= TIMEX                                                               
  727.       IF(TIME.GE.PRTMX)ISFLAG=1                                                 
  728.       RETURN                                                                    
  729.       END                                                                       
  730.         SUBROUTINE DUMMY                                                        
  731.        COMMON/LAB2/PDATE(3),CPU                                                 
  732.        ENTRY ERF                                                                
  733.        ENTRY ERFC                                                               
  734.        ENTRY TIMEV(TIME2)                                                       
  735.        RETURN                                                                   
  736.        ENTRY COUNTV                                                             
  737.        RETURN                                                                   
  738.        ENTRY SUB98                                                              
  739.        ENTRY USER1                                                              
  740.        ENTRY USER2                                                              
  741.        ENTRY CDATEV(DATE)
  742.        ENTRY PLOTPT                                                             
  743.        RETURN                                                                   
  744.        END                                                                      
  745.