      PROGRAM TIMAGG                                                                                                                
C     PROGRAM TIMAGG (INFIL,       OUTFIL,       OUTPUT,                )       H2                                                  
C    1          TAPE1=INFIL, TAPE2=OUTFIL, TAPE6=OUTPUT)                                                                            
C     --------------------------------------------------                        H2                                                  
C                                                                               H2                                                  
C     JUL 03/03 - A.IRWIN,F.MAJAESS (REVISED FOR F90 AND LINUX PLATFORMS)       H2                                                  
C     AUG 22/00 - F.MAJAESS (INSURE THE CORRECT I/O BUFFER DIMENSIONS PASSED TO                                                     
C                            THE I/O ROUTINES)                                                                                      
C     JAN 03/97 - D. LIU (LSR PASSED AS ARGUMENT TO SUBROUTINE T2LBL)                                                               
C     FEB 22/96 - D. LIU (CONVERSION OF TIME-SERIES LABEL REPLACED BY T2LBL)                                                        
C     MAY 03/94 - F.MAJAESS (REVISE FOR TRUNCATIONS > 99)                                                                           
C     APR 26/94 - D. RAMSDEN  (INPUT TYPE TIME RATHER THAN GRID/ZONL/SUBA/COEF)                                                     
C     JUN 07/93 - E. CHAN  (ADD EXTRA PRINTOUT AND ARRAY LSR FOR SPEC OPTION)                                                       
C     APR 16/93 - F. ZWIERS (SIMPLIFY LOGIC, ELIMINATE TEMPORARY FILES)                                                             
C     JUL 22/92 - E. CHAN  (REPLACE UNFORMATTED I/O WITH I/O ROUTINES)                                                              
C     JAN 29/92 - E. CHAN  (CONVERT HOLLERITH LITERALS TO ASCII, REPLACE                                                            
C                           BUFFERED I/O, REPLACE CALL ASSIGN WITH OPEN,                                                            
C                           AND REPLACE CALL RELEASE WITH A CALL SYSTEM                                                             
C                           TO REMOVE THE FILE)                                                                                     
C     SEP 03/85 - B.DUGAS                                                                                                           
C                                                                               H2                                                  
CTIMAGG  - GO FROM A FILE OF TIME SERIES TO A TIME SERIES OF ARRAYS.    1  1    H1                                                  
C                                                                               H3                                                  
CAUTHOR  - B. DUGAS                                                             H3                                                  
C                                                                               H3                                                  
CPURPOSE - TRANSPOSE A FILE OF TIME SERIES AT SINGLE POINTS (OR SINGLE          H3                                                  
C          COEFFICIENTS)  TO PRODUCE A FILE OF GRIDS, ZONAL PROFILES            H3                                                  
C          OR SUBAREA (OR SPECTRAL ARRAYS...).                                  H3                                                  
C          NOTE - TWO TIME SERIES ARE NEEDED TO REPRODUCE A SPECTRAL            H3                                                  
C                 COEFFICIENT, ONE FOR THE REAL AND ONE FOR THE IMAGINARY       H3                                                  
C                 PART OF IT. THE INPUT TIME SERIES ARE ALL SUPPOSED TO         H3                                                  
C                 BE VALID FOR THE SAME CONSECUTVE TIME FRAMES.                 H3                                                  
C                 THE TIME SERIES PROCESSED UP TO "NW" WORDS AT A TIME.         H3                                                  
C                                                                               H3                                                  
CINPUT FILE...                                                                  H3                                                  
C                                                                               H3                                                  
C      INFIL  = A FILE OF TIME SERIES (ONE RECORD FOR EACH POINT) WITH A        H3                                                  
C               STANDARD TIME SERIES LABEL:                                     H3                                                  
C                                                                               H3                                                  
C                  IBOUT(1) = TIME                                              H3                                                  
C                  IBOUT(2) = LOCATION IN LATLON FORMAT OR LINEAR POSITION      H3                                                  
C                             IN THE ORIGINAL SPECTRAL ARRAY.                   H3                                                  
C                  IBOUT(3) = NAME                                              H3                                                  
C                  IBOUT(4) = LEVEL                                             H3                                                  
C                  IBOUT(5) = LENGTH OF SERIES.                                 H3                                                  
C                  IBOUT(6) = 1                                                 H3                                                  
C                  IBOUT(7) = DIMENSION OF GRID, KHEM AND KIND OF DATA          H3                                                  
C                             (IN THE FORMAT CCCRRRKQ OR LRLMTQ)                H3                                                  
C                             WHERE Q IS IKIND                                  H3                                                  
C                  IBOUT(8) = PACKING DENSITY                                   H3                                                  
C                                                                               H3                                                  
COUTPUT FILE...                                                                 H3                                                  
C                                                                               H3                                                  
C      OUTFIL = A TIME SERIES OF GRID, ZONAL, SUBAREA OR SPECTRAL PROFILES FOR  H3                                                  
C               A SINGLE VARIABLE ON A  SINGLE LEVEL. THE FIRST VALUE IN        H3                                                  
C                 ===============       ============                            H3                                                  
C               ANY TIME SERIES  FROM INFIL  IS VALID  AT TIME VALUE  0,        H3                                                  
C               THE SECOND IS  VALID AT TIME  VALUE ONE AND SO ON TO THE        H3                                                  
C               END OF INFIL.                                                   H3                                                  
C               THE TYPE OF DATA IS DECODED FROM THE INPUT IBOUT(7) WHERE       H3                                                  
C               IKIND=Q=1 IS GRID, Q=2 IS ZONL, Q=9 IS SUBA AND Q=3 IS SPEC     H3                                                  
C----------------------------------------------------------------------------                                                       
C                                                                                                                                   
C     SET THE OUTPUT FIELD ACCUMULATION ARRAY ("X") SIZE IN "NW".                                                                   
      IMPLICIT REAL (A-H,O-Z),                                                                                                      
     +INTEGER (I-N)                                                                                                                 
      PARAMETER (NW=8000000)                                                                                                        
                                                                                                                                    
      INTEGER   BASE,LSR(2,66)                                                                                                      
      DIMENSION TS(18528),X(NW)                                                                                                     
      LOGICAL   OK                                                                                                                  
      COMMON/ICOM/ IBUF(8),IDAT(18528)                                                                                              
      COMMON/JCOM/ IBOUT(8),IDOUT(18528)                                                                                            
      DATA      MAXT/18528/, MAXX/18528/                                                                                            
C-----------------------------------------------------------------------                                                            
                                                                                                                                    
      NF = 3                                                                                                                        
      CALL JCLPNT(NF,1,2,6)                                                                                                         
      REWIND 1                                                                                                                      
      REWIND 2                                                                                                                      
C                                                                                                                                   
C     * CHECK THE INPUT FILE                                                                                                        
C                                                                                                                                   
      CALL GETFLD2(1,TS,-1,-1,-1,-1,IBUF,MAXT,OK)                                                                                   
      IF (.NOT.OK) THEN                                                                                                             
         CALL                                      XIT('TIMAGG',-2)                                                                 
      ENDIF                                                                                                                         
      WRITE(6,6010)                                                                                                                 
      CALL PRTLAB (IBUF)                                                                                                            
                                                                                                                                    
      REWIND 1                                                                                                                      
C                                                                                                                                   
      CALL T2LBL(IBUF, IBOUT, LSR)                                                                                                  
      IF (IBOUT(1) .EQ. NC4TO8("SPEC")) THEN                                                                                        
          NCOLS    = IBOUT(5)*2                                                                                                     
      ELSE                                                                                                                          
          NCOLS    = IBOUT(5)                                                                                                       
      ENDIF                                                                                                                         
      NROWS        = IBOUT(6)                                                                                                       
      NWDS         = NROWS*NCOLS                                                                                                    
                                                                                                                                    
      LENGTH = IBUF(5)                                                                                                              
      WRITE (6,6020) LENGTH                                                                                                         
      WRITE (6,6030) NWDS                                                                                                           
                                                                                                                                    
C     * TIME SERIES WILL BE PROCESSED A MAXIMUM OF NBLOCK WORDS AT A                                                                
C     * TIME.                                                                                                                       
                                                                                                                                    
      NBLOCK = NW/NWDS                                                                                                              
      WRITE (6,6040) NBLOCK                                                                                                         
                                                                                                                                    
      IF (NBLOCK.EQ.0) THEN                                                                                                         
          CALL                                     XIT('TIMAGG',-3)                                                                 
      ENDIF                                                                                                                         
                                                                                                                                    
C-----------------------------------------------------------------------                                                            
                                                                                                                                    
C     * EXTRACT NBLOCK WORDS FROM THE TIME SERIES ON EACH PASS.                                                                     
                                                                                                                                    
C     * N1 IS THE STARTING ADDRESS OF THE BLOCK OF WORDS                                                                            
C     * N2 IS THE ENDING ADDRESS OF THE BLOCK OF WORDS                                                                              
C     * CURRENT PASS WILL GENERATE RECORDS N1 TO N2 OF THE OUTPUT FILE.                                                             
C     *                                                                                                                             
C     * TO MAXIMIZE I/O EFFICIENCY, SHOULD DIMENSION ARRAY X LARGE ENOUGH                                                           
C     * SO THAT ONLY A SINGLE PASS THROUGH THE INPUT FILE IS REQUIRED.                                                              
                                                                                                                                    
      N1=1                                                                                                                          
                                                                                                                                    
  100 CONTINUE                                                                                                                      
                                                                                                                                    
         N2 = MIN (N1+NBLOCK-1,LENGTH)                                                                                              
                                                                                                                                    
C        * EXTRACT RECORDS N1 THROUGH N2                                                                                            
                                                                                                                                    
         DO 200 I=1,NWDS                                                                                                            
            CALL GETFLD2(1,TS,-1,-1,-1,-1,IBUF,MAXT,OK)                                                                             
            IF(.NOT.OK)THEN                                                                                                         
               CALL                                XIT('TIMAGG',-4)                                                                 
            ENDIF                                                                                                                   
C           * SCATTER THE TIME SERIES INTO THE BLOCK OF RECORDS                                                                     
            DO 150 J=N1,N2                                                                                                          
               X((J-N1)*NWDS+I)=TS(J)                                                                                               
  150       CONTINUE                                                                                                                
  200    CONTINUE                                                                                                                   
                                                                                                                                    
C        * OUTPUT THE RECORDS                                                                                                       
                                                                                                                                    
         DO 300 J=N1,N2                                                                                                             
            BASE=(J-N1)*NWDS+1                                                                                                      
            IBOUT(2)=J                                                                                                              
            CALL PUTFLD2(2,X(BASE),IBOUT,MAXX)                                                                                      
  300    CONTINUE                                                                                                                   
                                                                                                                                    
C        * SET UP FOR THE NEXT PASS                                                                                                 
                                                                                                                                    
         IF(N2.EQ.LENGTH)THEN                                                                                                       
C          * DONE                                                                                                                   
           WRITE(6,6050)                                                                                                            
           CALL PRTLAB (IBUF)                                                                                                       
           WRITE(6,6060)                                                                                                            
           CALL PRTLAB (IBOUT)                                                                                                      
           CALL                                    XIT('TIMAGG', 0)                                                                 
         ELSE                                                                                                                       
C          * DO NEXT BLOCK                                                                                                          
           N1 = N2+1                                                                                                                
           REWIND 1                                                                                                                 
           GOTO 100                                                                                                                 
         ENDIF                                                                                                                      
                                                                                                                                    
 1000 CONTINUE                                                                                                                      
                                                                                                                                    
C-----------------------------------------------------------------------                                                            
                                                                                                                                    
 6010 FORMAT('0FIRST RECORD OF THE INPUT FILE:')                                                                                    
 6020 FORMAT('0TIME SERIES ARE OF LENGTH ',I10,'.')                                                                                 
 6030 FORMAT('0INPUT FILE CONTAINS ',I10,' TIME SERIES.')                                                                           
 6040 FORMAT('0EACH TIME SERIES WILL BE PROCESSED A MAXIMUM OF ',                                                                   
     1       I10,' WORDS AT A TIME.')                                                                                               
 6050 FORMAT('0LAST RECORD OF THE INPUT FILE:')                                                                                     
 6060 FORMAT('0LAST RECORD CONVERTED TO:')                                                                                          
                                                                                                                                    
C-----------------------------------------------------------------------                                                            
                                                                                                                                    
      END                                                                                                                           
