      PROGRAM TIMSUM                                                                                                                
C     PROGRAM TIMSUM (SERA,        SUMA,       OUTPUT,                  )       C2                                                  
C    1         TAPE11=SERA, TAPE12=SUMA, TAPE6=OUTPUT)                                                                              
C     ------------------------------------------------                          C2                                                  
C                                                                               C2                                                  
C     JUL 03/03 - A.IRWIN,F.MAJAESS (REVISED FOR F90 AND LINUX PLATFORMS)       C2                                                  
C     AUG 21/00 - F.MAJAESS (ENSURE FIELD DIMENSION CHECK VERSUS "MAXRSZ")      C2                                                  
C     JAN 29/92 - E. CHAN  (CONVERT HOLLERITH LITERALS TO ASCII)                                                                    
C     JAN 23/91 - G.J. BOER                                                                                                         
C                                                                               C2                                                  
CTIMSUM  - COMPUTES MULTI-LEVEL PARTIAL SUM OVER TIME OF FILE           1  1    C1                                                  
C                                                                               C3                                                  
CAUTHOR  - G.J.BOER FOLLOWING TIMAVG                                            C3                                                  
C                                                                               C3                                                  
CPURPOSE - COMPUTES THE PARTIAL SUM OVER TIME AT EACH POINT OF                  C3                                                  
C          (MULTI-LEVEL) SETS OF DATA HAVING THE SAME SIZE AND TYPE.            C3                                                  
C                                                                               C3                                                  
C          INPUT  X1,X2,X3, .....                                               C3                                                  
C          OUTPUT X1,X1+X2,X1+X2+X3, .....                                      C3                                                  
C          NOTE -  MAXIMUM NUMBER OF LEVELS IS $L$                              C3                                                  
C                                                                               C3                                                  
CINPUT FILE...                                                                  C3                                                  
C                                                                               C3                                                  
C      SERA = SERIES OF MULTI-LEVEL SETS, (DATA MAY BE REAL OR COMPLEX).        C3                                                  
C                                                                               C3                                                  
COUTPUT FILE...                                                                 C3                                                  
C                                                                               C3                                                  
C      SUMA = CONTAINS PARTIAL SUMS OF SETS IN FILE SERA.                       C3                                                  
C---------------------------------------------------------------------------                                                        
C                                                                                                                                   
      IMPLICIT REAL (A-H,O-Z),                                                                                                      
     +INTEGER (I-N)                                                                                                                 
      COMMON/BLANCK/AVG(1852800),F(18528)                                                                                           
                                                                                                                                    
      LOGICAL OK,SPEC                                                                                                               
      INTEGER LEV(100),KBUF(8)                                                                                                      
      COMMON/ICOM/IBUF(8),IDAT(18528)                                                                                               
      DATA MAXX,MAXG,MAXL / 18528,1852800,100/                                                                                      
      DATA MAXRSZ /18528/                                                                                                           
C---------------------------------------------------------------------                                                              
      NF=3                                                                                                                          
      CALL JCLPNT(NF,11,12,6)                                                                                                       
      IF (NF.LT.3) CALL                            XIT('TIMSUM',-1)                                                                 
      REWIND 11                                                                                                                     
      REWIND 12                                                                                                                     
                                                                                                                                    
C     * FIND HOW MANY LEVELS IN ONE SET.                                                                                            
                                                                                                                                    
      CALL FILEV(LEV,NLEV,IBUF,11)                                                                                                  
      IF (NLEV.EQ.0) THEN                                                                                                           
        WRITE(6,6010)                                                                                                               
        CALL                                       XIT('TIMSUM',-2)                                                                 
      ENDIF                                                                                                                         
      IF(NLEV.GT.MAXL) CALL                        XIT('TIMSUM',-3)                                                                 
      NWDS=IBUF(5)*IBUF(6)                                                                                                          
      KIND=IBUF(1)                                                                                                                  
      NAME=IBUF(3)                                                                                                                  
      SPEC=(KIND.EQ.NC4TO8("FOUR").OR.KIND.EQ.NC4TO8("SPEC"))                                                                       
      WRITE(6,6005) (LEV(L),L=1,NLEV)                                                                                               
      IF (SPEC) NWDS=NWDS*2                                                                                                         
      WRITE(6,6025) IBUF                                                                                                            
      DO 100 I=1,8                                                                                                                  
  100 KBUF(I)=IBUF(I)                                                                                                               
      IF (NWDS.GT.MAXRSZ) CALL                     XIT('TIMSUM',-4)                                                                 
C                                                                                                                                   
C     * DO ONLY CASE WHERE ONE SET FITS INTO ACCUMULATOR                                                                            
C                                                                                                                                   
      IF (NWDS*NLEV.GT.MAXG) CALL                  XIT('TIMSUM',-5)                                                                 
C                                                                                                                                   
C     * READ IN THE FIRST SET AND THEN OUTPUT.                                                                                      
C     * STOP IF THE FILE IS EMPTY.                                                                                                  
C                                                                                                                                   
      DO 910 L=1,NLEV                                                                                                               
         IW=(L-1)*NWDS+1                                                                                                            
         CALL GETFLD2(11,AVG(IW),-1,-1,-1,LEV(L),IBUF,MAXX,OK)                                                                      
         IF (.NOT.OK) CALL                         XIT('TIMSUM',-6)                                                                 
C                                                                                                                                   
         CALL PUTFLD2(12,AVG(IW),IBUF,MAXX)                                                                                         
C                                                                                                                                   
  910 CONTINUE                                                                                                                      
C                                                                                                                                   
C                                                                                                                                   
C     * TIMESTEP AND LEVEL LOOPS.                                                                                                   
                                                                                                                                    
      NSETS=1                                                                                                                       
      NRECS=NLEV                                                                                                                    
  920 DO 940 L=1,NLEV                                                                                                               
                                                                                                                                    
C     * GET THE NEXT FIELD FROM FILE 11 AND CHECK THE LABEL.                                                                        
                                                                                                                                    
      CALL GETFLD2(11,F,KIND,-1,NAME,LEV(L),IBUF,MAXX,OK)                                                                           
      IF(.NOT.OK) THEN                                                                                                              
        IF(L.EQ.1) GO TO 950                                                                                                        
        WRITE(6,6015) NAME,LEV(L)                                                                                                   
        CALL                                       XIT('TIMSUM',-7)                                                                 
      ENDIF                                                                                                                         
      CALL CMPLBL(0,IBUF,0,KBUF,OK)                                                                                                 
      IF (.NOT.OK) THEN                                                                                                             
        WRITE(6,6025) KBUF,IBUF                                                                                                     
        CALL                                       XIT('TIMSUM',-8)                                                                 
      ENDIF                                                                                                                         
      IW=(L-1)*NWDS                                                                                                                 
      DO 930 I=1,NWDS                                                                                                               
  930 AVG(IW+I)=AVG(IW+I)+F(I)                                                                                                      
                                                                                                                                    
C     * OUTPUT ACCUMULATED VALUES                                                                                                   
                                                                                                                                    
         IW=(L-1)*NWDS+1                                                                                                            
         CALL PUTFLD2(12,AVG(IW),IBUF,MAXX)                                                                                         
                                                                                                                                    
      NRECS=NRECS+1                                                                                                                 
  940 CONTINUE                                                                                                                      
      NSETS=NSETS+1                                                                                                                 
      GO TO 920                                                                                                                     
                                                                                                                                    
C     * STOP IF THE LAST SET IS NOT COMPLETE.                                                                                       
                                                                                                                                    
  950 WRITE(6,6030) NSETS,NAME                                                                                                      
      NR=NSETS*NLEV                                                                                                                 
      IF (NR.NE.NRECS) THEN                                                                                                         
        WRITE(6,6035) NR,NRECS                                                                                                      
        CALL                                       XIT('TIMSUM',-9)                                                                 
      ENDIF                                                                                                                         
                                                                                                                                    
                                                                                                                                    
C     * CLEANUP AND EXIT.                                                                                                           
                                                                                                                                    
      WRITE(6,6025) IBUF                                                                                                            
      CALL                                         XIT('TIMSUM',0)                                                                  
                                                                                                                                    
C---------------------------------------------------------------------                                                              
 6005 FORMAT('0LEVELS =',20I5/(9X,20I5))                                                                                            
 6010 FORMAT('0..TIMSUM INPUT FILE IS EMPTY')                                                                                       
 6015 FORMAT('0..TIMSUM INPUT ERROR - NAME,L=',2X,A4,I5)                                                                            
 6025 FORMAT(' ',A4,I10,2X,A4,I10,4I6)                                                                                              
 6030 FORMAT('0TIMSUM READ',I5,'  SETS OF  ',A4/)                                                                                   
 6035 FORMAT('0..LAST SET INCOMPLETE. NR,NRECS=',2I6)                                                                               
 6040 FORMAT('0..TIMSUM ERROR IN LEVEL ',I5,' WHERE ',I6,                                                                           
     1       ' RECORDS ARE READ (EXPECT ',I6,' RECORDS).')                                                                          
      END                                                                                                                           
