      PROGRAM TIMDEV                                                                                                                
C     PROGRAM TIMDEV (X,       AVG,       DEV,      OUTPUT,             )       C2                                                  
C    1         TAPE11=X,TAPE12=AVG,TAPE13=DEV,TAPE6=OUTPUT)                     C2                                                  
C     -----------------------------------------------------                     C2                                                  
C                                                                               C2                                                  
C     JUL 03/03 - A.IRWIN,F.MAJAESS (REVISED FOR F90 AND LINUX PLATFORMS)       C2                                                  
C     APR 11/00 - S.KHARIN (SIMPLIFY CODE. RELAX RESTRICTION ON LEVEL NUMBER)   C2                                                  
C     JAN 29/92 - E. CHAN  (CONVERT HOLLERITH LITERALS TO ASCII)                                                                    
C     MAY 24/88 - F.MAJAESS (INCREASE THE DIMENSION TO 75000; T30-16 LEVELS)                                                        
C     MAR 18/88 - F.MAJAESS (REPLACE THE NEED TO USE A SCRATCH DISK                                                                 
C                            FILE BY DOING ONE LEVEL COMPUTATION AT                                                                 
C                            A TIME & REWINDING AVGA FILE)                                                                          
C     OCT 08/85 - B.DUGAS. (LIRE NAME DU FICHIER AVGA AU LIEU DE SERA)                                                              
C     MAY 07/80 - J.D.HENDERSON                                                                                                     
C                                                                               C2                                                  
CTIMDEV  - COMPUTES MULTI-LEVEL TIME DEVIATIONS OF A FILE               2  1    C1                                                  
C                                                                               C3                                                  
CAUTHOR  - J.D.HENDERSON                                                        C3                                                  
C                                                                               C3                                                  
CPURPOSE - COMPUTES THE 2-D TIME DEVIATIONS FOR EACH LEVEL OF A SERIES OF       C3                                                  
C          (MULTI-LEVEL) SETS FROM THE TIME AVERAGE OF THE SERIES.              C3                                                  
C          NOTE - MAXIMUM NUMBER OF LEVELS MAXL(=$L$).                          C3                                                  
C                                                                               C3                                                  
CINPUT FILES...                                                                 C3                                                  
C                                                                               C3                                                  
C         X = SERIES OF MULTI-LEVEL SETS, (DATA MAY BE REAL OR COMPLEX)         C3                                                  
C       AVG = INPUT FILE CONTAINING THE MEAN OF THE SETS IN SERA                C3                                                  
C                                                                               C3                                                  
COUTPUT FILE...                                                                 C3                                                  
C                                                                               C3                                                  
C       DEV = DEVIATIONS FROM THE MEAN                                          C3                                                  
C-----------------------------------------------------------------------------                                                      
C                                                                                                                                   
      IMPLICIT REAL (A-H,O-Z),                                                                                                      
     +INTEGER (I-N)                                                                                                                 
      COMMON/BLANCK/AVG(1852800),X(18528)                                                                                           
                                                                                                                                    
      LOGICAL OK,SPEC                                                                                                               
      INTEGER LEV(100),JBUF(8)                                                                                                      
      COMMON/ICOM/IBUF(8),IDAT(18528)                                                                                               
      DATA MAXX,MAXG,MAXL / 18528,1852800,100 /                                                                                     
      DATA MAXRSZ /18528/                                                                                                           
C---------------------------------------------------------------------                                                              
      NF=4                                                                                                                          
      CALL JCLPNT(NF,11,12,13,6)                                                                                                    
      IF (NF.LT.4) CALL                            XIT('TIMDEV',-1)                                                                 
      REWIND 11                                                                                                                     
      REWIND 12                                                                                                                     
      REWIND 13                                                                                                                     
                                                                                                                                    
C     * FIND THE NUMBER OF LEVELS, TYPE OF DATA, ETC...                                                                             
                                                                                                                                    
      CALL FILEV(LEV,NLEV,IBUF,12)                                                                                                  
      IF (NLEV.EQ.0) THEN                                                                                                           
        WRITE(6,6010)                                                                                                               
        CALL                                       XIT('TIMDEV',-2)                                                                 
      ENDIF                                                                                                                         
      IF (NLEV.GT.MAXL) CALL                       XIT('TIMDEV',-3)                                                                 
      WRITE(6,6020) NLEV,(LEV(L),L=1,NLEV)                                                                                          
      NWDS=IBUF(5)*IBUF(6)                                                                                                          
      KIND=IBUF(1)                                                                                                                  
      NAME=IBUF(3)                                                                                                                  
      SPEC=(KIND.EQ.NC4TO8("FOUR").OR.KIND.EQ.NC4TO8("SPEC"))                                                                       
      IF (SPEC) NWDS=NWDS*2                                                                                                         
      IF (NWDS.GT.MAXRSZ) CALL                     XIT('TIMDEV',-4)                                                                 
      DO I=1,8                                                                                                                      
         JBUF(I)=IBUF(I)                                                                                                            
      ENDDO                                                                                                                         
C                                                                                                                                   
C     * FIND THE MAXIMAL NUMBER OF LEVELS THAT FIT IN AVG                                                                           
C                                                                                                                                   
      NLEVM=MIN(MAXG/NWDS,NLEV)                                                                                                     
      WRITE(6,6030) NLEVM                                                                                                           
      CALL PRTLAB (IBUF)                                                                                                            
C                                                                                                                                   
C     * READ TIME AVERAGE IN ADVANCE, IF IT FITS IN AVG                                                                             
C                                                                                                                                   
      IF (NLEVM.EQ.NLEV) THEN                                                                                                       
         DO L=1,NLEV                                                                                                                
            IW=(L-1)*NWDS+1                                                                                                         
            CALL GETFLD2(12,AVG(IW),KIND,-1,NAME,LEV(L),IBUF,MAXX,OK)                                                               
            IF (.NOT.OK) THEN                                                                                                       
               CALL PRTLAB (IBUF)                                                                                                   
               WRITE(6,6050) IBUF(3),LEV(L)                                                                                         
               CALL                                XIT('TIMDEV',-5)                                                                 
            ENDIF                                                                                                                   
         ENDDO                                                                                                                      
      ENDIF                                                                                                                         
C                                                                                                                                   
C     * TIMESTEP AND LEVEL LOOPS.                                                                                                   
C                                                                                                                                   
      NSETS=0                                                                                                                       
 200  CONTINUE                                                                                                                      
      DO L=1,NLEV                                                                                                                   
C                                                                                                                                   
C     * READ TIME AVERAGE EVERY TIME STEP, IF IT DOES NOT FIT IN AVG                                                                
C                                                                                                                                   
         IW=(L-1)*NWDS                                                                                                              
         IF (NLEVM.LT.NLEV) THEN                                                                                                    
            IF (L.EQ.1) REWIND 12                                                                                                   
            IW=0                                                                                                                    
            CALL GETFLD2(12,AVG,KIND,-1,NAME,LEV(L),IBUF,MAXX,OK)                                                                   
            IF (.NOT.OK) THEN                                                                                                       
C                                                                                                                                   
C     * SET IS NOT COMPLETE. ABORT.                                                                                                 
C                                                                                                                                   
               CALL PRTLAB (IBUF)                                                                                                   
               WRITE(6,6050) NAME,LEV(L)                                                                                            
               CALL                                XIT('TIMDEV',-6)                                                                 
            ENDIF                                                                                                                   
         ENDIF                                                                                                                      
C                                                                                                                                   
C     * GET THE NEXT FIELD FROM FILE 11 AND CHECK THE LABEL.                                                                        
C                                                                                                                                   
         CALL GETFLD2(11,X,KIND,-1,NAME,LEV(L),IBUF,MAXX,OK)                                                                        
         IF (.NOT.OK) THEN                                                                                                          
            IF (L.EQ.1) GO TO 300                                                                                                   
C                                                                                                                                   
C     * SET IN FILE 11 IS NOT COMPLETE. ABORT.                                                                                      
C                                                                                                                                   
            CALL PRTLAB (IBUF)                                                                                                      
            WRITE(6,6030) NAME,LEV(L)                                                                                               
            CALL                                   XIT('TIMDEV',-7)                                                                 
         ENDIF                                                                                                                      
         CALL CMPLBL(0,IBUF,0,JBUF,OK)                                                                                              
         IF (.NOT.OK) THEN                                                                                                          
            CALL PRTLAB (IBUF)                                                                                                      
            CALL PRTLAB (JBUF)                                                                                                      
            CALL                                   XIT('TIMDEV',-8)                                                                 
         ENDIF                                                                                                                      
         IF (NSETS.EQ.0) CALL PRTLAB (IBUF)                                                                                         
C                                                                                                                                   
C        * CALCULATE THE TIME DEVIATIONS OF THE CURRENT FIELD.                                                                      
C        * WRITE THIS DEVIATION TO FILE 13.                                                                                         
C                                                                                                                                   
         DO I=1,NWDS                                                                                                                
            X(I)=X(I)-AVG(IW+I)                                                                                                     
         ENDDO                                                                                                                      
         CALL PUTFLD2(13,X,IBUF,MAXX)                                                                                               
      ENDDO                                                                                                                         
      NSETS=NSETS+1                                                                                                                 
      GO TO 200                                                                                                                     
C                                                                                                                                   
C     * STOP WHEN END-OF-FILE IS ENCOUNTERED ON FILE 11.                                                                            
C                                                                                                                                   
 300  CONTINUE                                                                                                                      
      IF (NSETS.EQ.0) THEN                                                                                                          
         WRITE(6,6055)                                                                                                              
         CALL                                      XIT('TIMDEV',-9)                                                                 
      ENDIF                                                                                                                         
C                                                                                                                                   
C     * NORMAL EXIT.                                                                                                                
C                                                                                                                                   
      WRITE(6,6060) NSETS,NAME                                                                                                      
      CALL PRTLAB (IBUF)                                                                                                            
      CALL                                         XIT('TIMDEV',0)                                                                  
                                                                                                                                    
C---------------------------------------------------------------------                                                              
 6010 FORMAT('0..TIMDEV INPUT FILE IS EMPTY')                                                                                       
 6020 FORMAT('0NLEVS =',I5/'0LEVELS = ',15I6/100(10X,15I6/))                                                                        
 6030 FORMAT(' ',I5,' LEVELS CAN BE KEPT IN MEMORY.')                                                                               
 6050 FORMAT('0..TIMDEV INPUT ERROR - NAME,L=',2X,A4,I5)                                                                            
 6055 FORMAT('0..TIMDEV TIME SERIES NAMES INCORRECT OR FILE EMPTY')                                                                 
 6060 FORMAT('0TIMDEV PROCESSED',I10,' SETS OF ',A4)                                                                                
      END                                                                                                                           
