home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 9 / 09.iso / e / e003 / 12.ddi / TAPOUT.FOR < prev   
Encoding:
Text File  |  1988-01-07  |  6.0 KB  |  81 lines
  1. C     SUBROUTINE **TAPOUT**                                                     
  2. C          DATA OUTPUT                                                          
  3.       SUBROUTINE TAPOUT                                                         
  4.       INTEGER NY1(3000),NY2(1000),NZA(1000),INXP(1000),INWP(1000)               
  5.       INTEGER NXP(1000),KEY(1000),IZ(1000),IPR(500),IPH(100)                    
  6.       INTEGER NTHEAD(100),NTTAIL(100),NFLAG(1000),IPROID(10)                    
  7.       DIMENSION  ZZ(16000),DYTCQ(11030),PRTIM(10),DELTIM(10)                    
  8.      X,PROUT(5),LABEL(5),LABEL1(5),PO(8)                                        
  9.        COMMON/I2BYT/NY1,NY2,NZA,NXP,INXP,INWP,KEY,IPR,IPH                       
  10.      X,NTHEAD,NTTAIL,NFLAG,IZ                                                   
  11.       EQUIVALENCE(ZZ(001),TIME),                  (ZZ(002),DYTCQ(1))            
  12.      X,          (ZZ(11073),RCMIN),               (ZZ(11074), JSAVE)            
  13.      X,          (ZZ(11075),DELTAT),              (ZZ(11088),NCRIT)             
  14.      X,   (ZZ(11062),N2),(ZZ(11018),NSAP),(ZZ(11084),ISFLAG)                    
  15.      X,  (ZZ(11085),MAXNOT),(ZZ(11032),PRTIM(1)),(ZZ(11042),DELTIM(1))          
  16.      X,          (ZZ(11082),IPRMAX),              (ZZ(11076),DTDT)              
  17.       COMMON ZZ                                                                 
  18.        DATA IPROID/1HY,1H1,1H2,1HT,1HC,1HQ,1HD,1HA,1HB,1HL/                     
  19.       IF(N2.NE.4) GO TO 7                                                       
  20.     5 WRITE(6,6) TIME,DTDT,JSAVE                                                
  21.     6 FORMAT(1H0/5X,'ITERATION NO.=',F8.0,' GREATEST TEMPERATURE CHANGE         
  22.      1PER ITERATION =',E12.5,' ON NODE NO.',I4)                                 
  23.       GO TO 8                                                                   
  24.     7 WRITE(6,3) TIME,NCRIT,RCMIN,JSAVE,DTDT,DELTAT                             
  25.     3 FORMAT(1H/,9H   TIME =,G11.4,11H CRIT.TIME=,I4,' CRIT.TIME=',G12.5
  26.      1,' DTMAX/DTHETA(',I4,2H)=,G11.4,8H DTHETA=,G11.4/)
  27.   8    IF(NSAP.LE.0)GO TO 15                                                    
  28.         NPRT=3                                                                  
  29.         JPRT=1                                                                  
  30.         IF(TIME.GT.PRTIM(1))GOTO 9                                              
  31.         IPRT=0                                                                  
  32.         DO 99 K=1,10                                                            
  33.         IF(DELTIM(K).GT.0.0)IPRT=IPRT+(PRTIM(K+1)-PRTIM(K))/DELTIM(K)           
  34. 99      CONTINUE                                                                
  35.         IF(N2.EQ.4)IPRT=1                                                       
  36.         WRITE(11,45)NPRT,IPRT,JPRT                                              
  37. 9       WRITE(11,136)TIME
  38. 136     FORMAT(F10.2)
  39.         I=0
  40.        LMAX=AMIN0(8,MAXNOT)                                                     
  41.        IF(N2.EQ.4.AND.ISFLAG.LE.0)GO TO 15                                      
  42. C      DO 10 K=1,MAXNOT                                                         
  43. C      IF(NFLAG(K).GT.-8.AND.NFLAG(K).LT.2)GO TO 10                             
  44. C      I=I+1                                                                    
  45. C
  46. C      IF(I.LT.8.AND.K.LT.MAXNOT)GO TO 10                                       
  47.         WRITE(11,36)(DYTCQ(3000+K),K=1,MAXNOT)
  48. 36      FORMAT(8F10.0)
  49.        LMAX=AMIN0(8,MAXNOT-K)                                                   
  50.        I=0                                                                      
  51.    10  CONTINUE                                                                 
  52.         IF(ISFLAG.GT.0)WRITE(11,40)                                             
  53.   15   L=0                                                                      
  54.         MAXL=5                                                                  
  55.        DO 25 I=1,IPRMAX                                                         
  56.        J1=IPR(I)                                                                
  57.        KP=J1                                                                    
  58.        J2=IPR(I+100)                                                            
  59.        J3=IPR(I+200)                                                            
  60.        DO 23 K=J1,J2,J3                                                         
  61.        LIM=AMAX0(1,(J2-KP)/J3)                                                  
  62.        IF(KP.EQ.J1)LIM=LIM+1                                                    
  63.        IF(I.EQ.IPRMAX)MAXL=AMIN0(5,LIM)                                         
  64.        L=L+1                                                                    
  65.       PROUT(L)= DYTCQ(K)                                                        
  66.         LABEL1(L)=MOD(K,1000)                                                   
  67.        LL=1+K/1000                                                              
  68.        LABEL(L)=IPROID(LL)                                                      
  69.       IF(L.LT.MAXL) GO TO 23                                                    
  70.        KP=K                                                                     
  71. 20     WRITE(6,30)(LABEL(M),LABEL1(M),PROUT(M),M=1,MAXL)                        
  72.       L=0                                                                       
  73.    23  CONTINUE                                                                 
  74.    25 CONTINUE                                                                  
  75. 30     FORMAT(2X,5('(',A1,I3,')=',E12.5))                                       
  76.   35   FORMAT(8F10.0) 
  77.  40    FORMAT(80X)                                                              
  78. 45      FORMAT(3I5)                                                             
  79.       RETURN                                                                    
  80.       END                                                                       
  81.