      PROGRAM GGATIM                                                                                                                
C     PROGRAM GGATIM (INFIL,       OUTFIL,       MASK,       INPUT,             H2                                                  
C    1                                                       OUTPUT,    )       H2                                                  
C    2          TAPE1=INFIL, TAPE2=OUTFIL, TAPE3=MASK, TAPE5=INPUT,                                                                 
C    3                                                 TAPE6=OUTPUT)                                                                
C     --------------------------------------------------------------            H2                                                  
C                                                                               H2                                                  
C     NOV 12/10 - F.MAJAESS (INCREASE "IBUF" DIMENSION TO HANDLE "TS" WRITING)  H2                                                  
C     NOV 02/07 - F.MAJAESS (FIX A BUG AFFECTING "IBUF(7)" BY SETTING, AS                                                           
C                            APPROPRIATE, ILAT2/ILON2 EQUAL TO ILAT1/ILON1 WHEN                                                     
C                            NO VALUES ARE SPECIFIED FOR THE FORMER SET AND                                                         
C                            THEY ARE PROVIDED FOR THE LATTER)                                                                      
C     MAR 17/04 - F.MAJAESS (ENSURE CLOSURE OF UNIT 4 BEFORE REMOVING                                                               
C                            "WRKXXXX" FILE VIA A SYSTEM CALL)                                                                      
C     JUL 03/03 - A.IRWIN,F.MAJAESS (REVISED FOR F90 AND LINUX PLATFORMS)                                                           
C     APR 03/03 - F.MAJAESS (EMPLOY CLOSE/OPEN STATEMENTS TO ACCOMPLISH PROPER                                                      
C                            FILE POINTER POSITIONING)                                                                              
C     APR 04/00 - S.KHARIN (USE THE DIMENSIONS OF THE SELECTED BOX IN IBUF(7)                                                       
C                           INSTEAD OF THE DIMENSIONS OF THE GLOBAL GRID).                                                          
C     JAN 21/98 - F.MAJAESS (RESTRICT ALL RECORDS TO THE SAME KIND,NAME,LEVEL,                                                      
C                            "DIMENSIONS" AND KHEM)                                                                                 
C     FEB 22/96 - D. LIU (CONVERSION TO TIME-SERIES LABEL REPLACED BY LBL2T)                                                        
C     APR 26/94 - D. RAMSDEN  (OUTPUT TYPE TIME RATHER THAN GRID/ZONL/SUBA/COEF)                                                    
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     DEC 05/85 - F.ZWIERS, B.DUGAS                                                                                                 
C                                                                               H2                                                  
CGGATIM  - CONVERT GAUSSIAN GRIDS TO A NUMBER OF TIME SERIES            1  1 C  H1                                                  
C                                                                               H3                                                  
CAUTHOR  - F. ZWIERS                                                            H3                                                  
C                                                                               H3                                                  
CPURPOSE - TRANSPOSE A FILE OF GRIDS, ZONAL PROFILES, SUBAREA OR SPECTRAL       H3                                                  
C          ARRAYS TO PRODUCE A FILE OF TIME SERIES OR TO PRODUCE A TIME SERIES  H3                                                  
C          AT A SINGLE POINT IN A GRID, ZONAL PROFILE OR SPECTRAL ARRAY.        H3                                                  
C          NOTE - THIS PROGRAM DOES NO TIME SEQUENCE CHECKING.                  H3                                                  
C                                                                               H3                                                  
CINPUT FILE...                                                                  H3                                                  
C                                                                               H3                                                  
C      INFIL = A TIME SERIES OF GRIDS, ZONAL PROFILES, SUBAREA OR SPECTRAL      H3                                                  
C              ARRAYS FOR A SINGLE VARIABLE ON A SINGLE LEVEL. IT IS ASSUMED    H3                                                  
C                           ---------------      ------------                   H3                                                  
C              THAT INPUT RECORDS ARE ARRANGED IN PROPER TIME SEQUENCE.         H3                                                  
C                                                                               H3                                                  
COUTPUT FILE...                                                                 H3                                                  
C                                                                               H3                                                  
C      OUTFIL =  A FILE OF TIME SERIES (ONE RECORD FOR EACH POINT)              H3                                                  
C                WITH THE STANDARD TIME SERIES LABEL -->                        H3                                                  
C                                                                               H3                                                  
C                     IBOUT(1) = TIME                                           H3                                                  
C                     IBOUT(2) = LOCATION (IN LATLON FORMAT)                    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 ARRAY, KHEM AND DATA TYPE         H3                                                  
C                                (IN THE FORMAT CCCRRRKQ  OR  LRLMTQ)           H3                                                  
C                     IBOUT(8) = PACKING DENSITY                                H3                                                  
C                                                                                                                                   
CINPUT PARAMETERS...                                                                                                                
C                                                                               H5                                                  
C       ILAT1 - LOWER ROW    INDEX NUMBER                                       H5                                                  
C       ILON1 - LEFT  COLUMN INDEX NUMBER                                       H5                                                  
C       ILAT2 - UPPER ROW    INDEX NUMBER                                       H5                                                  
C       ILON2 - RIGHT COLUMN INDEX NUMBER                                       H5                                                  
C       IMASK - MASK FILE CONTROL SWITCH                                        H5                                                  
C                                                                               H5                                                  
C       ILAT1 <= 0        ==> TRANSPOSE THE ENTIRE GRID OR ZONAL PROFILE.       H5                                                  
C       ILAT2 = ILON2 = 0 ==> SELECT THE TIME SERIES AT ROW NUMBER ILAT1        H5                                                  
C                                                AND COLUMN NUMBER ILON1.       H5                                                  
C       ILAT1 = ILAT2   \                                                       H5                                                  
C            AND         >==> SELECT THE TIME SERIES AT ROW NUMBER ILAT1        H5                                                  
C       ILON1 = ILON2   /                        AND COLUMN NUMBER ILON2.       H5                                                  
C                                                                               H5                                                  
C       IMASK .NE. 0      ==> READ A MASK FILE OF 0'S OR 1'S TO EXTRACT         H5                                                  
C                             THE DESIRED TIME SERIES. DISREGARD THE OTHER      H5                                                  
C                             INPUT PARAMETERS ON THIS AND ANY OTHER CARD.      H5                                                  
C                                                                               H5                                                  
C       ANY OTHER VALUES OF ILAT1, ILON1 AND ILAT2, ILON2 INDICATE THAT         H5                                                  
C       TIME SERIES ARE TO BE CONSTRUCTED FOR ALL POINTS CONTAINED IN THE       H5                                                  
C       REGION WHICH HAS POINT (ILAT1, ILON1) AT ITS SOUTH-WEST CORNER          H5                                                  
C       AND HAS (ILAT2, ILON2) AT ITS NORTH-EAST CORNER.                        H5                                                  
C                                                                               H5                                                  
C       NOTE - TO CONSTRUCT TIME SERIES IN A REGION WHICH SPANS THE             H5                                                  
C              GREENWICH MERIDIAN IT IS NECESSARY TO DIVIDE THE REGION          H5                                                  
C              INTO TWO PARTS AND TO SUPPLY TWO GGATIM CARDS.                   H5                                                  
C                                                                               H5                                                  
C            - THE  LARGEST  TIME SERIES  THAT CAN  BE  ACCOMMODATED IS OF      H5                                                  
C              LENGTH $1025TSL$. IF THE 'GGATIM' CARD DESCRIBES A REGION        H5                                                  
C              OR THE WHOLE FIELD AND INFIL CONTAINS MORE THAN $1025TSL$        H5                                                  
C              RECORDS THE  PROGRAM WILL ABORT. IF THE 'GGATIM' CARD            H5                                                  
C              DESCRIBES A SINGLE POINT, A TIME SERIES WILL BE CONSTRUCTED      H5                                                  
C              FROM THE FIRST $1025TSL$ RECORDS IN INFIL AND THE PROGRAM        H5                                                  
C              WILL TERMINATE WITH XIT NUMBER -101.                             H5                                                  
C                                                                               H5                                                  
C            - 'GGATIM' CARDS ARE READ AND EXECUTED ONE AT A TIME UNTIL         H5                                                  
C              INPUT IS EXHAUSTED THEREBY ALLOWING THE USER TO SELECT A         H5                                                  
C              NUMBER OF TIME  SERIES AT VARIOUS  POINTS IN ONE CALL TO         H5                                                  
C              GGATIM.                                                          H5                                                  
C                                                                               H5                                                  
CEXAMPLE OF INPUT CARD...                                                       H5                                                  
C                                                                               H5                                                  
C*GGATIM     24   44   27   47    0                                             H5                                                  
C------------------------------------------------------------------------                                                           
C                                                                                                                                   
                                                                                                                                    
      IMPLICIT REAL (A-H,O-Z),                                                                                                      
     +INTEGER (I-N)                                                                                                                 
      PARAMETER (K025TSLV=10497025*1)                                                                                               
      DIMENSION IBUF(8),JBUF(8),IDAT(K025TSLV)                                                                                      
      DIMENSION IBOUT(8),X(18528),TS(10497025),                                                                                     
     1          XIN(18528),XOUT(18528),                                                                                             
     2          XMSK(18528),MSK(18528)                                                                                              
                                                                                                                                    
      INTEGER  KIND, LEVEL, SIZEX, SIZEY                                                                                            
                                                                                                                                    
      LOGICAL OK,BOX,SPEC,FULL,MASK,STAT                                                                                            
                                                                                                                                    
      COMMON/ICOM/IBUF,IDAT                                                                                                         
                                                                                                                                    
      EQUIVALENCE (XIN (1),TS(    1)),                                                                                              
     1            (XOUT(1),TS(18529)),                                                                                              
     2            (XMSK(1),TS(37057))                                                                                               
      DATA MAXXS/ 18528/, MAXXL /K025TSLV/                                                                                          
      DATA NW   /10497025/,MASK /.FALSE./                                                                                           
                                                                                                                                    
C-----------------------------------------------------------------------                                                            
                                                                                                                                    
      NFIL = 5                                                                                                                      
      CALL JCLPNT(NFIL,1,2,3,5,6)                                                                                                   
      REWIND 1                                                                                                                      
                                                                                                                                    
C     * CHECK INPUT FILE.                                                                                                           
                                                                                                                                    
      CALL FBUFFIN(1,IBUF,-8,K,LEN)                                                                                                 
      IF (K.GE.0) GOTO 901                                                                                                          
      WRITE(6,6020) IBUF                                                                                                            
                                                                                                                                    
      DO 10 I=1,8                                                                                                                   
        JBUF(I)=IBUF(I)                                                                                                             
  10  CONTINUE                                                                                                                      
                                                                                                                                    
      KIND  = IBUF(1)                                                                                                               
      SPEC  = (KIND .EQ. NC4TO8("SPEC"))                                                                                            
      LEVEL = IBUF(4)                                                                                                               
      SIZEX = IBUF(5)                                                                                                               
      SIZEY = IBUF(6)                                                                                                               
      NCOLS = SIZEX                                                                                                                 
      NROWS = SIZEY                                                                                                                 
      NWDS  = NROWS*NCOLS                                                                                                           
                                                                                                                                    
      IF(SPEC) THEN                                                                                                                 
         NCOLS = NCOLS*2                                                                                                            
         NWDS  = NWDS*2                                                                                                             
      ENDIF                                                                                                                         
                                                                                                                                    
C------------------------------------------------------------------------                                                           
                                                                                                                                    
  050 CONTINUE                                                                                                                      
                                                                                                                                    
         REWIND 1                                                                                                                   
         READ(5,5010,END=900) ILAT1,ILON1,ILAT2,ILON2,IMASK                     H4                                                  
         WRITE(6,6040) ILAT1,ILON1,ILAT2,ILON2,IMASK                                                                                
         BOX = .TRUE.                                                                                                               
                                                                                                                                    
         IF (IMASK.NE.0)                                       THEN                                                                 
             MASK = .TRUE.                                                                                                          
             REWIND 3                                                                                                               
         END IF                                                                                                                     
                                                                                                                                    
C        * INTERPRET THE GGATIM CARD IF WE ARE NOT USING A MASK.                                                                    
                                                                                                                                    
         IF (.NOT.MASK)                                        THEN                                                                 
                                                                                                                                    
             IF (ILAT1.LE.0)                                   THEN                                                                 
                 ILAT1 = 1                                                                                                          
                 ILAT2 = NROWS                                                                                                      
                 ILON1 = 1                                                                                                          
                 ILON2 = NCOLS                                                                                                      
             END IF                                                                                                                 
                                                                                                                                    
             IF ((ILAT2.EQ.0 .AND. ILON2.EQ.0) .OR.                                                                                 
     1           (ILAT1.EQ.ILAT2 .AND. ILON1.EQ.ILON2) )       THEN                                                                 
                                                                                                                                    
                IF (ILAT2.EQ.0 .AND. ILON2.EQ.0 .AND.                                                                               
     1              ILAT1.NE.0 .AND. ILON1.NE.0        )       THEN                                                                 
                                                                                                                                    
                 ILAT2=ILAT1                                                                                                        
                 ILON2=ILON1                                                                                                        
                                                                                                                                    
                ENDIF                                                                                                               
                                                                                                                                    
                BOX = .FALSE.                                                                                                       
                                                                                                                                    
             END IF                                                                                                                 
                                                                                                                                    
             IF (BOX)                                          THEN                                                                 
                                                                                                                                    
                 IF (ILAT1.GT.ILAT2 .OR. ILON1.GT.ILON2 .OR.                                                                        
     1               ILAT1.LT.1     .OR. ILAT2.GT.NROWS .OR.                                                                        
     2               ILON1.LT.1     .OR. ILON2.GT.NCOLS )      THEN                                                                 
                     WRITE(6,6050)                                                                                                  
                     CALL                          XIT('GGATIM',-1)                                                                 
                 END IF                                                                                                             
                                                                                                                                    
             ELSE                                                                                                                   
                                                                                                                                    
                 IF (ILAT1.LT.1 .OR. ILAT1.GT.NROWS .OR.                                                                            
     1               ILON1.LT.1 .OR. ILON1.GT.NCOLS )          THEN                                                                 
                     WRITE(6,6060)                                                                                                  
                     CALL                          XIT('GGATIM',-2)                                                                 
                 END IF                                                                                                             
             END IF                                                                                                                 
             NSER = (ILON2-ILON1+1)*(ILAT2-ILAT1+1)                                                                                 
                                                                                                                                    
C        * OR READ THE MASK FILE IF WE NEED ONE.                                                                                    
                                                                                                                                    
         ELSE                                                                                                                       
                                                                                                                                    
             CALL GETFLD2 (3,XMSK,KIND,-1,NC4TO8("MASK"),LEVEL,                                                                     
     +                                           IBUF,MAXXS,OK)                                                                     
                                                                                                                                    
             IF (.NOT.OK          .OR.                                                                                              
     1          (IBUF(5).NE.SIZEX .OR. IBUF(6).NE.SIZEY))                                                                           
     2           CALL                              XIT('GGATIM',-3)                                                                 
                                                                                                                                    
             NSER = 0                                                                                                               
             DO 100 I=1,NWDS                                                                                                        
                 IF (XMSK(I).NE.0.E0)                            THEN                                                               
                     NSER      = NSER+1                                                                                             
                     MSK(NSER) = I                                                                                                  
                 END IF                                                                                                             
  100        CONTINUE                                                                                                               
                                                                                                                                    
         END IF                                                                                                                     
                                                                                                                                    
         IF (NSER.EQ.NWDS)                                    THEN                                                                  
             FULL = .TRUE.                                                                                                          
         ELSE                                                                                                                       
             FULL = .FALSE.                                                                                                         
             IF (.NOT.MASK) THEN                                                                                                    
                IBUF(5)=(ILON2-ILON1+1)                                                                                             
                IBUF(6)=(ILAT2-ILAT1+1)                                                                                             
             ELSE                                                                                                                   
                IBUF(5)=NSER                                                                                                        
                IBUF(6)=1                                                                                                           
             ENDIF                                                                                                                  
         END IF                                                                                                                     
         CALL LBL2T(IBUF, IBOUT)                                                                                                    
C-----------------------------------------------------------------------                                                            
                                                                                                                                    
C        * MAIN IF BLOCK                                                                                                            
                                                                                                                                    
         IF (BOX)                                              THEN                                                                 
                                                                                                                                    
C            * ASSIGN WORK FILE.                                                                                                    
                                                                                                                                    
             INQUIRE(4,OPENED=STAT)                                                                                                 
             IF (STAT) THEN                                                                                                         
              CLOSE(45)                                                                                                             
             ENDIF                                                                                                                  
             OPEN(4,FILE='WRKXXXX',FORM='UNFORMATTED')                                                                              
             REWIND 4                                                                                                               
                                                                                                                                    
C            * TRANSPOSE A REGION.                                                                                                  
C            *-------------------------------------------------------------                                                         
C            *                                                                                                                      
                                                                                                                                    
C            * DETERMINE THE LENGTH OF THE SERIES, UNPACK AND                                                                       
C            * GATHER THEM IN FILE WRKXXXX.                                                                                         
                                                                                                                                    
             LEN = 0                                                                                                                
  200        CONTINUE                                                                                                               
                 CALL GETFLD2(1,XIN,-1,-1,-1,-1,IBUF,MAXXS,OK)                                                                      
                                                                                                                                    
                 IF (OK)                                       THEN                                                                 
                                                                                                                                    
                    IF (IBUF(1).NE.JBUF(1).OR.IBUF(3).NE.JBUF(3)                                                                    
     1               .OR.IBUF(4).NE.JBUF(4).OR.IBUF(5).NE.JBUF(5)                                                                   
     2               .OR.IBUF(6).NE.JBUF(6).OR.IBUF(7).NE.JBUF(7))                                                                  
     3                                                         THEN                                                                 
                      WRITE(6,6070)IBUF,JBUF                                                                                        
                      CALL                         XIT('GGATIM',-4)                                                                 
                    ENDIF                                                                                                           
                                                                                                                                    
                                                                                                                                    
                     LEN = LEN+1                                                                                                    
                     IF (.NOT.FULL)                            THEN                                                                 
                                                                                                                                    
                         IF (.NOT.MASK)                        THEN                                                                 
                                                                                                                                    
                             DO 250 J=ILAT1,ILAT2                                                                                   
                                 IJ1 = (ILON2-ILON1+1)*(J-ILAT1)                                                                    
     1                               - ILON1+1                                                                                      
                                 IJ2 = NCOLS*(J-1)                                                                                  
                                 DO 250 I=ILON1,ILON2                                                                               
                                     XOUT(IJ1+I) = XIN(IJ2+I)                                                                       
  250                        CONTINUE                                                                                               
                                                                                                                                    
                         ELSE                                                                                                       
                                                                                                                                    
                             DO 300 J=1,NSER                                                                                        
                                 XOUT(J) = XIN(MSK(J))                                                                              
  300                        CONTINUE                                                                                               
                                                                                                                                    
                         END IF                                                                                                     
                                                                                                                                    
                         WRITE (4) (XOUT(I),I=1,NSER)                                                                               
                                                                                                                                    
                     ELSE                                                                                                           
                                                                                                                                    
                         WRITE (4) (XIN(I),I=1,NSER)                                                                                
                                                                                                                                    
                     END IF                                                                                                         
                                                                                                                                    
                     GOTO 200                                                                                                       
                                                                                                                                    
                 END IF                                                                                                             
                                                                                                                                    
  350        WRITE(6,6070) IBUF                                                                                                     
             WRITE(6,6080) LEN                                                                                                      
                                                                                                                                    
C            * DETERMINE THE NUMBER OF TIME SERIES (NS) WHICH CAN BE                                                                
C            * STORED IN MEMORY SIMULTANEOUSLY.                                                                                     
                                                                                                                                    
             NS = NW/LEN                                                                                                            
             WRITE(6,6090) NS                                                                                                       
             IBOUT(5) = LEN                                                                                                         
                                                                                                                                    
             IF (NS.EQ.0)                                      THEN                                                                 
                 WRITE(6,6100) LEN,NW                                                                                               
                 CALL                              XIT('GGATIM',-5)                                                                 
             END IF                                                                                                                 
                                                                                                                                    
             IF (.NOT.MASK)                                    THEN                                                                 
                 NRBOX  = ILAT2-ILAT1+1                                                                                             
                 NCBOX  = ILON2-ILON1+1                                                                                             
             END IF                                                                                                                 
                                                                                                                                    
             NBLOCK = NSER/NS                                                                                                       
             IF (NBLOCK*NS.LT.NSER) NBLOCK = NBLOCK+1                                                                               
                                                                                                                                    
C            * CONSTRUCT TIME SERIES NS AT A TIME.                                                                                  
                                                                                                                                    
             DO 600 I=1,NBLOCK                                                                                                      
                                                                                                                                    
                 CLOSE (4)                                                                                                          
                 OPEN(4,FILE='WRKXXXX',FORM='UNFORMATTED')                                                                          
                 REWIND 4                                                                                                           
                 K1 = (I-1)*NS+1                                                                                                    
                 K2 = MIN(I*NS,NSER)                                                                                                
                                                                                                                                    
                 DO 450 J=1,LEN                                                                                                     
                                                                                                                                    
                     NSERMX=NSER                                                                                                    
                     READ (4) (X(K),K=1,NSERMX)                                                                                     
                                                                                                                                    
                     IJ = J-K1*LEN                                                                                                  
                     DO 400 K=K1,K2                                                                                                 
                         TS(K*LEN+IJ) = X(K)                                                                                        
  400                CONTINUE                                                                                                       
                                                                                                                                    
  450            CONTINUE                                                                                                           
                                                                                                                                    
C                * MOVE THIS BLOCK TO DISK.                                                                                         
                                                                                                                                    
                 DO 550 K=K1,K2                                                                                                     
                                                                                                                                    
                     IF (.NOT.MASK)                            THEN                                                                 
                         IRBOX = (K-1)/NCBOX + 1                                                                                    
                         ICBOX =  K - (IRBOX-1)*NCBOX                                                                               
                         IROW  =  IRBOX + ILAT1 - 1                                                                                 
                         ICOL  =  ICBOX + ILON1 - 1                                                                                 
                     ELSE                                                                                                           
                         IROW  = (MSK(K)-1)/NCOLS + 1                                                                               
                         ICOL  =  MSK(K)-(IROW-1)*NCOLS                                                                             
                     END IF                                                                                                         
                                                                                                                                    
                     IF (SPEC)                                 THEN                                                                 
                         IBOUT(2) = ICOL                                                                                            
                     ELSE                                                                                                           
                         IBOUT(2) = 1000*IROW + ICOL                                                                                
                     END IF                                                                                                         
                     DO 500 L=1,8                                                                                                   
                         IBUF(L) = IBOUT(L)                                                                                         
 500                 CONTINUE                                                                                                       
                                                                                                                                    
                     IADD = (K-K1)*LEN + 1                                                                                          
                     CALL PUTFLD2(2,TS(IADD),IBUF,MAXXL)                                                                            
                                                                                                                                    
 550             CONTINUE                                                                                                           
                                                                                                                                    
 600         CONTINUE                                                                                                               
             CLOSE (4)                                                                                                              
             CALL SYSTEM('\rm -f WRKXXXX')                                                                                          
                                                                                                                                    
         ELSE                                                                                                                       
                                                                                                                                    
C            * PICK OUT A TIME SERIES AT A SINGLE POINT                                                                             
C            *---------------------------------------------------------                                                             
                                                                                                                                    
             LEN  = 0                                                                                                               
             IADD = (ILAT1-1)*NCOLS + ILON1                                                                                         
  650        CONTINUE                                                                                                               
                                                                                                                                    
                 CALL GETFLD2(1,X,-1,0,0,0,IBUF,MAXXS,OK)                                                                           
                                                                                                                                    
                 IF (OK)                                       THEN                                                                 
                                                                                                                                    
                    IF (IBUF(1).NE.JBUF(1).OR.IBUF(3).NE.JBUF(3)                                                                    
     1               .OR.IBUF(4).NE.JBUF(4).OR.IBUF(5).NE.JBUF(5)                                                                   
     2               .OR.IBUF(6).NE.JBUF(6).OR.IBUF(7).NE.JBUF(7))                                                                  
     3                                                         THEN                                                                 
                      WRITE(6,6070)IBUF,JBUF                                                                                        
                      CALL                         XIT('GGATIM',-6)                                                                 
                    ENDIF                                                                                                           
                                                                                                                                    
                                                                                                                                    
                     LEN     = LEN+1                                                                                                
                     TS(LEN) = X(IADD)                                                                                              
                                                                                                                                    
                     IF (LEN.EQ.NW)                            THEN                                                                 
                         WRITE(6,6110) NW                                                                                           
                         CALL                      XIT('GGATIM',-7)                                                                 
                     END IF                                                                                                         
                                                                                                                                    
                     GOTO 650                                                                                                       
                                                                                                                                    
                 END IF                                                                                                             
                                                                                                                                    
C            * WRITE THE TIME SERIES TO DISK                                                                                        
                                                                                                                                    
             NSER=1                                                                                                                 
             WRITE(6,6070) IBUF                                                                                                     
                                                                                                                                    
             IF (SPEC)                                         THEN                                                                 
                 IBOUT(2) = ILON1                                                                                                   
             ELSE                                                                                                                   
                 IBOUT(2) = 1000*ILAT1 + ILON1                                                                                      
             END IF                                                                                                                 
                                                                                                                                    
             IBOUT(5) = LEN                                                                                                         
             DO 700 I=1,8                                                                                                           
                 IBUF(I) = IBOUT(I)                                                                                                 
  700        CONTINUE                                                                                                               
                                                                                                                                    
             CALL PUTFLD2(2,TS,IBUF,MAXXL)                                                                                          
                                                                                                                                    
         END IF                                                                                                                     
                                                                                                                                    
                                                                                                                                    
         WRITE(6,6120) NSER                                                                                                         
                                                                                                                                    
C        * IF WE ARE NOT USING A MASK GO GET ANOTHER GGATIM CARD.                                                                   
                                                                                                                                    
         IF (.NOT.MASK) GOTO 050                                                                                                    
C-----------------------------------------------------------------------------                                                      
                                                                                                                                    
C     * END OF PROCESSING.                                                                                                          
                                                                                                                                    
  900 CALL                                         XIT('GGATIM',0)                                                                  
                                                                                                                                    
  901 WRITE(6,6010)                                                                                                                 
      CALL                                         XIT('GGATIM',-8)                                                                 
C-----------------------------------------------------------------------                                                            
                                                                                                                                    
 5010 FORMAT(10X,5I5)                                                           H4                                                  
 6010 FORMAT('0GGATIM EMPTY INPUT FILE.')                                                                                           
 6020 FORMAT('0FIRST RECORD OF THE INPUT FILE:'/                                                                                    
     1          1X,A4,I10,1X,A4,5I10/)                                                                                              
 6040 FORMAT('0GGATIM    ',5I5)                                                                                                     
 6050 FORMAT('0REGION SPECIFIED INCORRECTLY.')                                                                                      
 6060 FORMAT('0POINT SPECIFIED INCORRECTLY.')                                                                                       
 6070 FORMAT(1X,A4,I10,1X,A4,5I10)                                                                                                  
 6080 FORMAT('0INPUT FILE CONTAINS ',I10,' RECORDS.')                                                                               
 6090 FORMAT('0TIME SERIES WILL BE PROCESSED IN BLOCKS OF ',                                                                        
     1       I8,' TIME SERIES.')                                                                                                    
 6100 FORMAT('0SELECTED TIME SERIES IS OF LENGTH ',I7,                                                                              
     1       ' OBSERVATIONS.'/' MAXIMUM LENGTH WHICH CAN BE',                                                                       
     2       ' ACCOMMODATED BY GGATIM IS ',I7,                                                                                      
     3       ' OBSERVATIONS.')                                                                                                      
 6110 FORMAT('0INPUT FILE CONTAINS MORE THAN',I7,' RECORDS.')                                                                       
 6120 FORMAT('0PRODUCED ',I5,' TIME SERIES.')                                                                                       
                                                                                                                                    
C-----------------------------------------------------------------------                                                            
                                                                                                                                    
      END                                                                                                                           
