        PROGRAM TAP6
C       ROCKETDYNE THERMAL ANALYZER PROGRAM   VERSION TAP-6  AUG.1969           
C       THIS IS THE MAIN CONTROL PROGRAM FOR TAP-6 WHICH WILL SOLVE             
C       PARABOLIC DIFFERENTIAL EQUATIONS USING A THREE TIME LEVEL METHOD        
C       DEVELOPED AT ROCKETDYNE. THIS PROGRAM CAN SOLVE PROBLEMS                
C       INVOLVING 999 TEMPERATURE NODES AND 2999 ADMITTANCES INCLUDING          
C       THE EFFECTS OF ENERGY TRANSPORT THROUGH THE MATERIAL.                   
C                ROCKETDYNE ADVANCED SYSTEMS  DEPT. 589                         
C                THIS IS A REDUCED MEMORY REQUIREMENT DECK                      
C                MODIFIED FOR FLOW NOV.1972                                     
C                 MODIFIED 3/16/82                                              
      INTEGER NY1(3000),NY2(1000),NZA(1000),INXP(1000),INWP(1000)               
     X,NXP(1000),KEY(1000),IZ(1000),IPR(500),IPH(100)                           
     X,NTHEAD(100),NTTAIL(100),NFLAG(1000)                                      
      DIMENSION  ZZ(16000),DYTCQ(11030),Y(3000),T(1000)                         
     X,C(1000)        ,Q(1000)        ,GAIN(1000) ,A(1000),B(1000)              
     X,D(1000),SUMY(1000),SUMYT(1000), TOLD(1000),L(1000)                       
     X,PHT1(100),PHH1(100),PHT2(100),PHH2(100),QCH1(100)                        
     X,QCH2(100),CON(20),PRTIM(10),DELTIM(10),TITLE(17,10),TABL(1000)           
     X,TPROG(2),AA(7)                                                           
       COMMON/I2BYT/NY1,NY2,NZA,NXP,INXP,INWP,KEY,IPR,IPH                       
     X,NTHEAD,NTTAIL,NFLAG,IZ                                                   
      COMMON /LAB1/ PLOT(100,10),IPLOT(10),TMAX(1000)                           
      COMMON /LAB2/DATE(3)                                                      
      COMMON /LAB3/ICASE,XLIM(2),YLIM(2),CT(5),XLAB(5),YLAB(5)                  
      COMMON /LAB4/ SPROG(2)                                                    
      COMMON /LAB5/ TITLE                                                       
        COMMON ZZ                                                               
      EQUIVALENCE (ZZ(001),TIME),         (ZZ(002),Y(1),DYTCQ(1))               
     X,          (ZZ(3002),T(1)),                 (ZZ(4002),C(1))               
     X,          (ZZ(5002),Q(1)),                 (ZZ(6002),D(1) )              
     X,          (ZZ(7002),A(1) ),              (ZZ(8002), B(1) )               
     X,          (ZZ(9002),L(1) ),                (ZZ(10002),GAIN(1) )          
     X,     (ZZ(10001),LYMIN),     (ZZ(10501),LYMAX)                            
     X,          (ZZ(11002),CON(1)),              (ZZ(11010),CON9,SIGMA)        
     X,          (ZZ(11011),CON10,TZERO), (ZZ(11032),PRTIM(1))                  
     X,          (ZZ(11042),DELTIM(1)),           (ZZ(11053),IREAD)             
     X,          (ZZ(11056),NYMIN),               (ZZ(11057),MAX2T)             
     X,          (ZZ(11058),MIN2Y),               (ZZ(11059),MAX2Y)             
      EQUIVALENCE(ZZ(11060),MIN1T),               (ZZ(11061),MAX1T)             
     X,          (ZZ(11062),N2)                                                 
      EQUIVALENCE(ZZ(11069), LFLAG),              (ZZ(11070), IERFL)            
     X,          (ZZ(11071),PRTMX),               (ZZ(11072),DTHETA)            
     X,          (ZZ(11073),RCMIN),               (ZZ(11074), JSAVE)            
     X,          (ZZ(11075),DELTAT),              (ZZ(11076),DTMAX )            
     X,          (ZZ(11077), IMIN),               (ZZ(11078), IMAX )            
     X,          (ZZ(11079), IXMIN),              (ZZ(11080), IXMAX)            
     X,          (ZZ(11081),IPHMAX),              (ZZ(11082),IPRMAX)            
     X,          (ZZ(11083),IPFLAG),              (ZZ(11084),ISFLAG)            
     X,          (ZZ(11085),MAXNOT),              (ZZ(11086),MAXNOY)            
     X,          (ZZ(11087),NARITH),              (ZZ(11088),NCRIT )            
      EQUIVALENCE (ZZ(11089),NTIME),              (ZZ(11090), NT )              
     X,          (ZZ(11091),NTLAST),              (ZZ(11092),NWW)               
     X,          (ZZ(11093),NXX),                 (ZZ(11094),NZZ)               
     X,          (ZZ(11095), W ),                 (ZZ(11096), X )               
     X,          (ZZ(11097), Z ) ,                (ZZ(11098), NTAB)             
     X,          (ZZ(11099),OTIME2),              (ZZ(11100),ODTIME)            
     X,          (ZZ(11101),DTIME),               (ZZ(11102),PHT1(1))           
     X,          (ZZ(11202),PHH1(1)),             (ZZ(11302),PHT2(1))           
     X,          (ZZ(11402),PHH2(1)),             (ZZ(11502),QCH1(1))           
     X,          (ZZ(11602),QCH2(1))                                            
      EQUIVALENCE(ZZ(12002),SUMY(1)),             (ZZ(13002),TOLD(1))           
     X,          (ZZ(14002),SUMYT(1)),            (ZZ(15002),TABL(1))           
      DATA  TPROG/4H TAP,4H-6F /                                                
C                                                                               
C                                                                               
      DATA BLANK/4H    /     
C                                                                               
      REWIND 8                                                                  
      NODE=1000                                                                 
        MEGA=1000000                                                            
      CALL CDATEV(DATE)                                                         
      SPROG(1)= TPROG(1)                                                        
      SPROG(2)= TPROG(2)                                                        
C                                                                               
      CALL HEADER                                                               
C     CLEAR CORE LOCATIONS AND EQUATE PROGRAM VARIABLES                         
      DO 102 I=1,9                                                              
  102 XLIM(I)=0.0                                                               
  105 DO 110 I=1,16000                                                          
  110 ZZ(I) = 0.0                                                               
      DO 111 I=1,170                                                            
  111 TITLE(I,1)=BLANK                                                          
      DO 112 I=1,11400                                                          
  112 NY1(I)=0                                                                  
      NSTART = -98                                                              
      IERFL  = 1                                                                
      IMIN   = 1                                                                
      MAXNOY = 0                                                                
      LYMAX = 0                                                                 
      IPHK   = 0                                                                
      IF1=-3                                                                    
      IF2=-2                                                                    
      IF3= 1                                                                    
        IF4=-4                                                                  
      JSTART=1                                                                  
      ICASE=0                                                                   
      ISTART = 0                                                                
      NTLAST = -1                                                               
      NCZERO = 1                                                                
      SIGMA=0.3304E-14                                                          
      TZERO  = 459.69                                                           
      CON(1) = 1.0E35                                                           
      CON(3) = 1.0                                                              
      CON(4)= .001                                                              
      CON17 = 8.                                                                
  115 IERFL = 1                                                                 
      ICASE= ICASE+1                                                            
      CFLAG = 0                                                                 
      ICZERO = 0                                                                
      DELTAT = 0.0                                                              
      ODTIME = 0.0                                                              
      OTIME2 = 0.                                                               
      DTMAX = 0.                                                                
      DTHETA= 0.0                                                               
      DTIME= 0.0                                                                
      ATIME = 0.                                                                
      IF (NSTART+97) 145,135,125                                                
  125 WRITE (6,130)                                                             
      IMIN=1                                                                    
  130 FORMAT (1H1,75H THIS RUN USES THE SAME INITIAL DATA AS THE PREVIOU        
     1S RUN WITH SOME NEW DATA)                                                 
      READ(8)(ZZ(I),I=1,16000)                                                  
      REWIND 8                                                                  
      GO TO 200                                                                 
  135 WRITE (6,140)                                                             
  140 FORMAT (1H1,66H THIS RUN IS A CONTINUATION OF THE PREVIOUS RUN WIT        
     1H SOME NEW DATA)                                                          
      GO TO 200                                                                 
  145 WRITE(6,150) DATE,SPROG                                                   
      IMIN=1                                                                    
      ISTART= 0                                                                 
      IMAX = 0                                                                  
      DO 146 I=1,1010                                                           
  146 PLOT(I,1)= 0.0                                                            
  150 FORMAT(1H1,' ALL NEW INPUT DATA FOR THIS CASE',51X,3A4,1X,2A4)            
C                                                                               
C     INPUT                                                                     
C                                                                               
  200 CALL COUNTV                                                               
      IF(ICASE.GT.1)WRITE(6,210)(TITLE(J,1),J=1,15),ICASE,SPROG,DATE            
  210 FORMAT(1H /,1X,15A4,'  CASE NO.',I4,2X,2A4,1X,2A4)                        
      CALL TAPIN(ISTART,NSTART)                                                 
      IF(CON(15).GT.0.)IMIN=1                                                   
                                                                                
      IF(CON(5).GT.0.0.AND.CON(5).LT.1.0)CON17=CON(5)*8.0                       
      IRAD = CON(16)                                                            
      ICON12 = CON(12)                                                          
      CALL TIMEV(TIME2)                                                         
      WRITE(6,806)DATE,TIME2                                                    
      IF (IERFL-2) 220,105,999                                                  
  220 IF(JSTART.EQ.1)GO TO 230                                                  
      IF(NSTART.NE.-96) GO TO 240                                               
  230 WRITE(8)(ZZ(I),I=1,16000)                                                 
      REWIND 8                                                                  
  240 TIME= PRTIM(1)                                                            
      NTIME= 1                                                                  
      IPFLAG = 1                                                                
      ISFLAG = 0                                                                
      NARITH = 1                                                                
      IXMIN = 499                                                               
      IXMAX = 0                                                                 
      TZERO = ABS(TZERO)                                                        
      WRITE(6,242) IMAX,IMIN                                                    
  242 FORMAT(1H ,19X,'THE INITIAL *030 DO LOOP RANGE IS IMAX=',I4,              
     1'IMIN=',I4)                                                               
      CALL ARITH                                                                
      N2=1                                                                      
      MINZC = 999                                                               
      MAXZC = 1                                                                 
      MINZY= 2999                                                               
      MAXZY = 1                                                                 
      MAX1T= 1                                                                  
      MIN1T= 999                                                                
      MIN1Y = 2999                                                              
      MAX1Y = 1                                                                 
      MIN3T=999                                                                 
      MAX3T=1                                                                   
      N2= 1+ICON12                                                              
      IF(CON(5).GT.0.) N2= 4                                                    
      ICFLAG = 0                                                                
      IF(N2.EQ.4) DELTAT = 1.                                                   
C     PREPARE FOR ZEROTH ITERATION                                              
      IF(LYMAX.LE.LYMIN) GO TO 244                                              
      DO 243 JJ=1,LYMAX                                                         
      J=NY2(JJ)                                                                 
        J1=MOD(NY1(J),MEGA)/NODE                                                
      J2= MOD(NY1(J),NODE)                                                      
      IF(NFLAG(J1).NE.IF1.AND.NFLAG(J2).NE.IF1) GO TO 243                       
      MIN3T= MIN0(J1,J2,MIN3T)                                                  
      MAX3T= MAX0(J1,J2,MAX3T)                                                  
  243 CONTINUE                                                                  
        J=NY2(1)                                                                
        J1=MOD(NY1(J),MEGA)/NODE                                                
        NYMIN=LYMAX                                                             
        IF(NFLAG(J1).EQ.-1)NYMIN=0                                              
  244 CONTINUE                                                                  
      DO 250 JJ=1,MAXNOY                                                        
      IF(NY1(JJ).LE.0) GO TO 250                                                
      JT= NY1(JJ)/MEGA                                                          
      IF(JT.GT.0) GO TO 250                                                     
       J1=MOD(NY1(JJ),MEGA)/NODE                                                
      J2= MOD(NY1(JJ),NODE)                                                     
        IF(NFLAG(J1).GE.1.OR.NFLAG(J2).GE.1)MAX1Y=MAX0(MAX1Y,JJ)                
        IF(NFLAG(J1).GE.1.OR.NFLAG(J2).GE.1)MIN1Y=MIN0(MIN1Y,JJ)                
      IF(NFLAG(J1).NE.IF4.AND.NFLAG(J2).NE.IF4) GO TO 250                       
      MAXZY= MAX0(JJ,MAXZY)                                                     
      MINZY= MIN0(JJ,MINZY)                                                     
      ICZERO = 1                                                                
  250 CONTINUE                                                                  
      CALL SETUP(JSTART)                                                        
      IF(IERFL.GT.1) GO TO 830                                                  
      DO 260 J=1,999                                                            
      IF(NFLAG(J).EQ.0) GO TO 260                                               
      IF(N2.NE.4)TMAX(J)= AMAX1(TMAX(J),T(J))                                   
      IF(NFLAG(J).EQ.IF4)MAXZC=MAX0(MAXZC,J)                                    
      IF(NFLAG(J).EQ.IF4)MINZC=MIN0(MINZC,J)                                    
        IF(NFLAG(J).GE.1)MIN1T=MIN0(J,MIN1T)                                    
        IF(NFLAG(J).GE.1)MAX1T=MAX0(J,MAX1T)                                    
  260 TOLD(J)= T(J)                                                             
      WRITE(6,262) IMAX,IMIN                                                    
  262 FORMAT(1H ,19X,'THE *030 DO LOOP RANGE IS IMAX=',I4,',IMIN=',I4)          
      WRITE(6,265)                                                              
  265 FORMAT(20X,'THE DO LOOP RANGES FOR THIS PROBLEM ARE AS FOLLOWS'/          
     120X,      '  NFLAG       MIN Y      MAXY       MINT       MAXT ' )        
      WRITE(6,270)IF3,MIN1Y,MAX1Y,MIN1T,MAX1T                                   
      IF(ICZERO.EQ.1)WRITE(6,270)IF4,MINZY,MAXZY,MINZC,MAXZC                    
      IF(MIN3T.LT.MAX3T)WRITE(6,270)IF1,NY2(1),NY2(LYMAX),MIN3T,MAX3T           
  270 FORMAT(20X,5(3X,I5,3X))                                                   
      CALL TIMEV(TIME2)                                                         
      WRITE(6,806) DATE,TIME2                                                   
      WRITE(6,275)                                                              
  275 FORMAT(1H1,'  INITIAL CONDITIONS FOR THIS RUN')                           
      GO TO 310                                                                 
  300 CONTINUE                                                                  
      CALL ARITH                                                                
      ATIME= TIME + CON(13)                                                     
C                                                                               
C                RELAXATION OF CONNECTED ZERO CAPACITANCE NODES                 
C                                                                               
C                CALCULATION OF SUMY AND SUMYT                                  
C                                                                               
  310 IF(IPFLAG.GT.0)CALL TAPOUT                                                
      DO 311 J=1,MAXNOT                                                         
      SUMY(J) = 0.                                                              
  311 SUMYT(J)= Q(J)                                                            
  312 DTMAX2= 0.                                                                
      DTMAX = 0.                                                                
      IF(ICZERO.LE.0) GO TO 340                                                 
      DO 325 J= MINZY,MAXZY                                                     
       JT=NY1(J)/MEGA                                                           
      IF(JT.GT.0.OR.Y(J).LE.0.0) GO TO 325                                      
      J1= MOD(NY1(J),MEGA)/NODE                                                 
      J2= MOD(NY1(J),NODE)                                                      
      IF(NFLAG(J1).NE.IF4.AND.NFLAG(J2).NE.IF4)GO TO 325                        
      YJ= Y(J)                                                                  
      IF(CON(16).LE.0.) GO TO 315                                               
      IF(IRAD.EQ.2.AND.NFLAG(J1).NE.IF4)GO TO 315                               
      IF(IRAD.EQ.2.AND.NFLAG(J2).NE.IF4)GO TO 315                               
      TJ1= T(J1)+CON10                                                          
      TJ2= T(J2)+CON10                                                          
      TCO= CON9*(TJ1**2+TJ2**2)*(TJ1+TJ2)                                       
      YJ= TCO*YJ                                                                
  315 IF(NFLAG(J1).NE.IF4)GO TO 320                                             
      SUMY(J1)=SUMY(J1)+YJ                                                      
        SUMYT(J1)=SUMYT(J1)+YJ*T(J2)                                            
  320 IF(NFLAG(J2).NE.IF4)GO TO 325                                             
      SUMY(J2)=SUMY(J2)+ YJ                                                     
      SUMYT(J2)=SUMYT(J2)+YJ*T(J1)                                              
  325 CONTINUE                                                                  
C                                                                               
C                CALCULATION OF CONNECTED ZERO CAPACITANCE NODE TEMP.           
C                                                                               
      DO 335 J= MINZC,MAXZC                                                     
      IF(NFLAG(J).NE.IF4) GO TO 335                                             
      IF(SUMY(J).LE.0.) GO TO 335                                               
      TNEW= SUMYT(J)/SUMY(J)+(T(J)-TOLD(J))/CON17                               
      DTMAX2= AMAX1(DTMAX2,ABS(TNEW-T(J)))                                      
      TOLD(J)=T(J)                                                              
      T(J)=TNEW                                                                 
      SUMY(J)= 0.                                                               
      SUMYT(J)= Q(J)                                                            
  335 CONTINUE                                                                  
      IF(DTMAX2.GT.CON(4))GO TO 312                                             
  340 CONTINUE                                                                  
C                                                                               
C                CALCULATION OF SUMY AND SUMYT FOR INTEGRATION OF T             
C                                                                               
        DO 350 J=1,MAXNOY                                                       
      JT= NY1(J)/MEGA                                                           
      IF(JT.GT.0.OR.Y(J).LE.0.0) GO TO 350                                      
      J1= MOD(NY1(J),MEGA)/NODE                                                 
      J2= MOD(NY1(J),NODE)                                                      
      YJ= Y(J)                                                                  
      IF(IRAD   .NE.1 ) GO TO 345                                               
      IF(NFLAG(J1).NE.IF4.AND.NFLAG(J2).NE.IF4) GO TO 345                       
      TJ1= T(J1) +CON10                                                         
      TJ2= T(J2)+CON10                                                          
      TCO= CON9*(TJ1**2+TJ2**2)*(TJ1+TJ2)                                       
      YJ= TCO*YJ                                                                
  345 CONTINUE                                                                  
      IF(NFLAG(J1).EQ.0.OR.NFLAG(J1).EQ.-1) GO TO 346                           
      IF(NFLAG(J1).EQ.IF4)GO TO 346                                             
      SUMY(J1)=SUMY(J1)+ YJ                                                     
      SUMYT(J1)= SUMYT(J1)+ YJ*T(J2)                                            
  346 IF(NFLAG(J2).EQ.0.OR.NFLAG(J2).EQ.-1) GO TO 347                           
      IF(NFLAG(J2).EQ.IF4)GO TO 347                                             
      SUMY(J2)=SUMY(J2)+ YJ                                                     
      SUMYT(J2)=SUMYT(J2)+YJ*T(J1)                                              
  347 CONTINUE                                                                  
  350 CONTINUE                                                                  
      IF(LYMAX.LE.LYMIN) GO TO 361                                              
C                                                                               
C                ADDITION OF FIRST DERIVATIVE TERMS TO SUMYT                    
C                                                                               
      DO 360 JJ=1,LYMAX                                                         
      J=NY2(JJ)                                                                 
      IF(J.LE.0.OR.Y(J).EQ.0.) GO TO 360                                        
      JP= J                                                                     
      IF(JJ.GT.1) JP= NY2(JJ-1)                                                 
      J1= MOD(NY1(J),MEGA)/NODE                                                 
      JTP= MOD(NY1(JP),NODE)                                                    
      J2= MOD(NY1(JJ),NODE)                                                     
      YJ= .5*Y(J)                                                               
       IF(NFLAG(J).LT.1)GO TO 360                                               
      IF(JTP.NE.J1.OR.NFLAG(J2).EQ.-1) GO TO 355                                
      JTP= MOD(NY1(JP),MEGA)/NODE                                               
      TERM=-YJ*(T(JTP)-T(J2))                                                   
      SUMYT(J1)= SUMYT(J1)+ TERM                                                
      GO TO 360                                                                 
  355 SUMYT(J1)= SUMYT(J1)+YJ*T(J2)                                             
      SUMY(J1)= SUMY(J1)+YJ                                                     
  360 CONTINUE                                                                  
  361 CONTINUE                                                                  
      CALL TIMER                                                                
      IF(IPHMAX.GT.0) CALL LATENT(1)                                            
      DTIME= DTHETA                                                             
C  FLOW NODE CALCULATIONS                                                       
      DO 420 JJ=1,LYMAX                                                         
        IF(NYMIN.EQ.0)GO TO 380                                                 
      K=LYMAX+1-JJ                                                              
      J=NY2(K)                                                                  
      J1= MOD(NY1(J),MEGA)/NODE                                                 
      J2=MOD(NY1(J),NODE)                                                       
        GO TO 385                                                               
380   J=NY2(JJ)                                                                 
        J2=MOD(NY1(J),MEGA)/NODE                                                
        J1=MOD(NY1(J),NODE)                                                     
385     IF(NFLAG(J1).NE.IF1)GO TO 420                                           
       DT=1.                                                                    
      TOLD(J1)=T(J1)                                                            
        IF(C(J1).GT.0.0)DT=Y(J)*DTIME/C(J1)                                     
        CJ=AMAX1(0.0,C(J1)*(1.-DT))                                             
        IF(N2.EQ.4)CJ=0.0                                                       
  400 DENOM=SUMY(J1)+CJ/DTIME +Y(J)                                             
      IF(DENOM.LE.0.0)GO TO 420                                                 
        IF(DT.GE.1.)TDUM=TOLD(J2)/DT+(DT-1.)*T(J2)/DT                           
        IF(DT.LT.1.)TDUM=DT*TOLD(J2)+(1.-DT)*TOLD(J1)                           
      T(J1)=(SUMYT(J1)+CJ*TDUM/DTIME +Y(J)*TDUM)/DENOM                          
  420 CONTINUE                                                                  
C                                                                               
450     GO TO (500,1000,1000,605),N2                                            
C                                                                               
C     RELAX ALL FINITE CAPACITY NODES                                           
C                NEWTON INTEGRATION METHOD (FORWARD DIFFERENCE)                 
C                                                                               
  500 CONTINUE                                                                  
      DO 540 J=MIN1T,MAX1T                                                      
        IF(NFLAG(J).LT.1)GO TO 540                                              
  510 IF(C(J).GT.0.) GO TO 530                                                  
  520 IF(SUMY(J).GT.0.0)T(J)=SUMYT(J)/SUMY(J)                                   
      GO TO 540                                                                 
  530 TNEW=DTIME* SUMYT(J)/C(J)+(1.-DTIME*SUMY(J)/C(J))*T(J)                    
      DT= ABS(TNEW-T(J))                                                        
      TOLD(J)= T(J)                                                             
      T(J)= TNEW                                                                
      TMAX(J)=AMAX1(TMAX(J),T(J))                                               
      IF(DT.LE.DTMAX)GO TO 540                                                  
      DTMAX = DT                                                                
      JSAVE = J                                                                 
  540 CONTINUE                                                                  
      ODTIME= DTIME                                                             
  545 CONTINUE                                                                  
  560 GO TO (700,830),IERFL                                                     
  605 CONTINUE                                                                  
C                                                                               
C     STEADY-STATE                                                              
C                                                                               
  610 DO 650 J= MIN1T,MAX1T                                                     
  620  IF(NFLAG(J).GE.1.AND.SUMY(J).GT.0.0)GO TO 630                            
      GO TO 650                                                                 
  630 DT= SUMYT(J)/SUMY(J)-T(J)+(T(J)-TOLD(J))/CON17                            
      IF(CON(5).LE.1.) GO TO 631                                                
      DTO = T(J)-TOLD(J)                                                        
      IF((DTO*DT).GT.0.0)DT=SUMYT(J)/SUMY(J) -TOLD(J)                           
  631 CONTINUE                                                                  
      TOLD(J)= T(J)                                                             
      T(J)     = T(J)+DT                                                        
      TMAX(J)= DT                                                               
      DT= ABS(DT)                                                               
      IF (DT .LE. DTMAX) GO TO 650                                              
  640 DTMAX  = DT                                                               
      JSAVE  = J                                                                
  650 CONTINUE                                                                  
C     TEST FOR PRINT-OUT SIGNAL                                                 
  700 IF(IERFL.GT.1) GO TO 830                                                  
      IF(IPHMAX.GT.0) CALL LATENT(2)                                            
      IF(ISFLAG.GT.0) GO TO 770                                                 
      DTMAX= DTMAX/DTHETA                                                       
      IF(DTMAX.LT.CON(4)) GO TO 740                                             
      IF(IPFLAG.GT.0) GO TO 300                                                 
      IF(TIME.LT.ATIME) GO TO 310                                               
  710 GO TO 300                                                                 
  740 ICFLAG = ICFLAG+1                                                         
      IF(ICFLAG.LT.2) GO TO 300                                                 
  750 WRITE (6,760) DTMAX, CON(4)                                               
  760 FORMAT (30H0 GREATEST TEMPERATURE CHANGE ,E12.5, 36H IS LESS THAN      
     1CONVERGENCE TEST VALUE,E12.5)                                             
      ICFLAG = 0                                                                
  770 ISFLAG=1                                                                  
      CALL ARITH                                                                
  780 CALL TAPOUT                                                               
C     TEST FOR PLOTTING                                                         
  800 ISFP1=0                                                                   
  804 CONTINUE                                                                  
        IF(CON(6).GT.0.0)CALLSPILL                                              
      DO 805 J=1,10                                                             
  805 ISFP1=ISFP1+IPLOT(J)                                                      
      IF(ISFP1.GT.0)CALL PLOTPT                                                 
C     TEST FOR FINAL DUMP SIGNAL                                                
  820 NS     = NSTART+100                                                       
      CALL TIMEV(TIME2)                                                         
      WRITE(6,806) DATE,TIME2                                                   
  806 FORMAT(1H0,31X,3A4,'   ELAPSED TIME= ',F12.3,' SECONDS ')                
      GO TO (860,105,115,115),NS                                                
  830 WRITE (6,840)                                                             
  840 FORMAT (52H0 THIS RUN HAS BEEN DISCONTINUED, FINAL VALUES ARE -)          
      CALL TAPOUT                                                               
      GO TO 800                                                                 
  860 CONTINUE                                                                  
  999 CALL EXIT
      STOP                                                                      
C                                                                               
                                                                                
C      THREE TIME LEVEL INTEGRATION METHOD                                      
C                                                                               
 1000 CONTINUE                                                                  
      IF(ODTIME.LE.0.) ODTIME= DTIME                                            
      TR= 1.+ ODTIME/DTIME                                                      
 1015 DTT= ODTIME + DTIME                                                       
      DO 1040 J= MIN1T,MAX1T                                                    
        IF(NFLAG(J).LT.1) GO TO 1040                                            
      IF(SUMY(J).LE.0.) GO TO 1040                                              
 1017 CONTINUE                                                                  
      TNEW=TR*C(J)*T(J)+DTT*SUMYT(J)-DTIME*SUMY(J)*TOLD(J)                      
      DENOM = TR*C(J)+ODTIME*SUMY(J)                                            
        IF(N2.GT.2)GOTO 1020                                                    
        IF(C(J).GT.0.0)GOTO 1025                                                
        T(J)=SUMYT(J)/SUMY(J)                                                   
1020    TNEW=TNEW+2.*L(J)*(DTT*T(J)/DTIME-TOLD(J))/ODTIME                       
                                                                                
        RC=AMIN1(RCMIN,SQRT(L(J)/SUMY(J))/2.)                                   
1025   TOLD(J)=T(J)                                                             
        T(J)=TNEW/DENOM                                                         
      DT= ABS(T(J)-TOLD(J))                                                     
      TMAX(J)=AMAX1(TMAX(J),T(J))                                               
      IF(DT.LE.DTMAX)GO TO 1040                                                 
      DTMAX= DT                                                                 
      JSAVE = J                                                                 
 1040 CONTINUE                                                                  
      OTIME2=ODTIME                                                             
      ODTIME = DTIME                                                            
 1050 GO TO 700                                                                 
      END                                                                       
