      PROGRAM GSPLIT                                                                                                                
C     PROGRAM GSPLIT (IN,       S1,       S2,       S3,      OUTPUT,    )       B2                                                  
C    1          TAPE1=IN,TAPE11=S1,TAPE12=S2,TAPE13=S3,TAPE6=OUTPUT)                                                                
C     --------------------------------------------------------------            B2                                                  
C                                                                               B2                                                  
C     JUL 03/03 - A.IRWIN,F.MAJAESS (REVISED FOR F90 AND LINUX PLATFORMS)       B2                                                  
C     APR 19/99 - M. LAZARE.                                                    B2                                                  
C                                                                               B2                                                  
CGSPLIT  - SPLITS UP A "GS" FILE INTO TWO OR 3 SUB-SETS                 1  3    B1                                                  
C                                                                               B3                                                  
CAUTHOR  - M.LAZARE                                                             B3                                                  
C                                                                               B3                                                  
CPURPOSE - SPLITS UP A MODEL "GS" FILE INTO SUBSETS, TO AID IN                  B3                                                  
C          IMPROVING DIAGNOSTICS THROUGHPUT. ALL TRACER VARIABLES               B3                                                  
C          (THESE ARE ASSUMED TO START WITH "X") ARE SAVED INTO                 B3                                                  
C          ONE FILE (IF THEY EXIST); SINGLE-LEVEL VARIABLES (THOSE              B3                                                  
C          RECORDS HAVING IBUF(4)={0,1}) ARE STORED IN ANOTHER                  B3                                                  
C          AND THE REST ARE STORED IN A THIRD.                                  B3                                                  
C          NOTE - STEP NUMBERS IN FILE IN ARE ASSUMED TO BE INCREASING.         B3                                                  
C                                                                               B3                                                  
CINPUT FILE...                                                                  B3                                                  
C                                                                               B3                                                  
C      IN = FILE CONTAINING GRID FIELDS TO BE SPLIT UP.                         B3                                                  
C                                                                               B3                                                  
COUTPUT FILES...                                                                B3                                                  
C                                                                               B3                                                  
C      S1 = VARIABLES NOT BELONGING TO ONE OF THE NEXT 2 SPECIAL CASES          B3                                                  
C      S2 = VARIABLES HAVING IBUF(4)={0,1} (I.E. ONE-LEVEL FIELDS)              B3                                                  
C      S3 = TRACER VARIABLES (THOSE STARTING WITH "X" IN IBUF(3))               B3                                                  
C----------------------------------------------------------------------------                                                       
C                                                                                                                                   
C     SET THE DIMENSION "MAXTMP" OF THE ARRAYS USED FOR IDENTIFING SINGLE                                                           
C     VERSUS MULTI-LEVEL FIELDS.                                                                                                    
C                                                                                                                                   
      IMPLICIT REAL (A-H,O-Z),                                                                                                      
     +INTEGER (I-N)                                                                                                                 
      PARAMETER ( MAXTMP = 1000)                                                                                                    
                                                                                                                                    
      LOGICAL OK                                                                                                                    
      INTEGER INAM1(MAXTMP),IVAL1(MAXTMP)                                                                                           
      CHARACTER*4 NAM                                                                                                               
C                                                                                                                                   
      COMMON/ICOM/IBUF(8),IDAT(65341)                                                                                               
      DATA MAXX/65341/                                                                                                              
C---------------------------------------------------------------------                                                              
      NF=5                                                                                                                          
      CALL JCLPNT(NF,1,11,12,13,6)                                                                                                  
      REWIND 1                                                                                                                      
      DO 110 N=11,13                                                                                                                
  110 REWIND N                                                                                                                      
C                                                                                                                                   
C     * FIRST SCAN COMPLETE INPUT FILE AND DETERMINE ARRAY OF                                                                       
C     * (CHARACTER) VARIABLE NAMES WHICH ARE MULTI-LEVEL AND                                                                        
C     * WHICH HAVE A LEVEL OF 1 MB (I.E. IBUF(4)=1). THIS IS                                                                        
C     * DONE IN ORDER TO STORE VARIABLES OF THIS TYPE TO THE                                                                        
C     * PROPER OUTPUT FILE, I.E THE "GENERAL" ONE AS OPPOSED                                                                        
C     * TO THE "ONE-LEVEL" ONE.                                                                                                     
C                                                                                                                                   
      NREC=0                                                                                                                        
      I1=0                                                                                                                          
  140 CALL RECGET(1, -1,-1,-1,-1, IBUF,MAXX,OK)                                                                                     
      IF (.NOT.OK) THEN                                                                                                             
        IF (NREC.EQ.0) THEN                                                                                                         
         WRITE(6,6060)                                                                                                              
         CALL                                      XIT('GSPLIT',-1)                                                                 
        ELSE                                                                                                                        
         GO TO 145                                                                                                                  
        ENDIF                                                                                                                       
      ENDIF                                                                                                                         
                                                                                                                                    
      NREC=NREC+1                                                                                                                   
C                                                                                                                                   
C     * SEARCH PREVIOUS MEMBERS OF INAM1 TO SEE IF THIS                                                                             
C     * VARIABLE NAME IS ALREADY STORED:                                                                                            
C     *   IF IT ISN'T, ADD IT TO THE LIST (IVAL1=1).                                                                                
C     *   IF IT IS ALREADY STORED WITH IVAL1=1 BUT THE                                                                              
C     *      LEVEL IS NOT 1MB, SET IVAL1=-1.                                                                                        
C                                                                                                                                   
      INEW=1                                                                                                                        
      IF(I1.GT.0) THEN                                                                                                              
        DO 142 N=1,I1                                                                                                               
          IF(IBUF(3).EQ.INAM1(N)) THEN                                                                                              
            IF(IBUF(4).EQ.1) THEN                                                                                                   
              INEW=0                                                                                                                
            ELSE                                                                                                                    
              INEW=-1*N                                                                                                             
            ENDIF                                                                                                                   
          ENDIF                                                                                                                     
  142   CONTINUE                                                                                                                    
      ENDIF                                                                                                                         
C                                                                                                                                   
      IF(INEW.EQ.1) THEN                                                                                                            
                                                                                                                                    
        I1=I1+1                                                                                                                     
C                                                                                                                                   
C       * ABORT IF NUMBER OF MULTI-LEVEL FIELDS HAVING IBUF(4)=1                                                                    
C       * EXCEEDS PROGRAM-DEFINED MAXIMUM.                                                                                          
C                                                                                                                                   
        IF(I1.GT.MAXTMP)  CALL                     XIT('GSPLIT',-2)                                                                 
                                                                                                                                    
        INAM1(I1)=IBUF(3)                                                                                                           
        IVAL1(I1)=1                                                                                                                 
                                                                                                                                    
      ELSE IF(INEW.LT.0) THEN                                                                                                       
        IABSNEW=ABS(INEW)                                                                                                           
        IVAL1(IABSNEW)=-1                                                                                                           
      ENDIF                                                                                                                         
                                                                                                                                    
      GO TO 140                                                                                                                     
C                                                                                                                                   
C     * READ ONE RECORD FROM FILE 1 AND STORE APPROPRIATELY.                                                                        
C     * STOP AT EOF.                                                                                                                
C                                                                                                                                   
  145 NREC=0                                                                                                                        
      NREC1=0                                                                                                                       
      NREC2=0                                                                                                                       
      NREC3=0                                                                                                                       
      REWIND 1                                                                                                                      
C                                                                                                                                   
  150 CALL RECGET(1, -1,-1,-1,-1, IBUF,MAXX,OK)                                                                                     
      NRECS=NREC1+NREC2+NREC3                                                                                                       
      IF (.NOT.OK) THEN                                                                                                             
        IF(NRECS.EQ.0) CALL                        XIT('GSPLIT',-3)                                                                 
        WRITE(6,6040) NREC,NREC1,NREC2,NREC3                                                                                        
        CALL                                       XIT('GSPLIT', 0)                                                                 
      ENDIF                                                                                                                         
      NREC=NREC+1                                                                                                                   
C                                                                                                                                   
C     * CONVERT HOLLERITH IBUF(3) TO ASCII AND CHECK IF FIRST                                                                       
C     * CHARACTER IS "X". IF IT IS, ASSIGN RECORD TO TRACER                                                                         
C     * FILE (UNIT 13). OTHERWISE CHECK IBUF(4) AND IF IT                                                                           
C     * IS {0,1}, ASSIGN RECORD TO ONE-LEVEL FIELD FILE (UNIT 12)                                                                   
C     * (NOTE: SPECIAL CARE MUST BE TAKEN TO ENSURE THAT THIS                                                                       
C     * IS NOT ACTUALLY ETA=1MB!!! - THIS IS DONE BY CHECKING THE                                                                   
C     * VALUE IN "INAM1"). REMAINING RECORDS ARE ASSIGNED TO FINAL                                                                  
C     * FILE (UNIT 11).                                                                                                             
C                                                                                                                                   
      WRITE(NAM,'(A4)') IBUF(3)                                                                                                     
C                                                                                                                                   
      IF (NAM(1:1).EQ.'X') THEN                                                                                                     
         CALL RECPUT(13,IBUF)                                                                                                       
         NREC3=NREC3+1                                                                                                              
         IF(NREC3.EQ.1) WRITE(6,6035) IBUF                                                                                          
         GO TO 150                                                                                                                  
      ENDIF                                                                                                                         
C                                                                                                                                   
      IF(IBUF(4).EQ.0 .OR. IBUF(4).EQ.1) THEN                                                                                       
        IF(I1.GT.0) THEN                                                                                                            
          DO 155 N=1,I1                                                                                                             
            IF(IBUF(3).EQ.INAM1(N) .AND. IVAL1(N).EQ.-1) GO TO 160                                                                  
  155     CONTINUE                                                                                                                  
        ENDIF                                                                                                                       
C                                                                                                                                   
        CALL RECPUT(12,IBUF)                                                                                                        
        NREC2=NREC2+1                                                                                                               
        IF(NREC2.EQ.1) WRITE(6,6030) IBUF                                                                                           
        GO TO 150                                                                                                                   
      ENDIF                                                                                                                         
C                                                                                                                                   
  160 CALL RECPUT(11,IBUF)                                                                                                          
      NREC1=NREC1+1                                                                                                                 
      IF(NREC1.EQ.1) WRITE(6,6025) IBUF                                                                                             
      GO TO 150                                                                                                                     
C---------------------------------------------------------------------                                                              
 6010 FORMAT('0THERE ARE ',I8,' VARIABLES HAVING IBUF(4)=1')                                                                        
 6025 FORMAT('0TO UNIT 11: ',A4,I10,2X,A4,I10,4I8)                                                                                  
 6030 FORMAT('0TO UNIT 12: ',A4,I10,2X,A4,I10,4I8)                                                                                  
 6035 FORMAT('0TO UNIT 13: ',A4,I10,2X,A4,I10,4I8)                                                                                  
 6040 FORMAT('0RECORDS IN =',I7,'  RECORDS OUT =',3I7)                                                                              
 6060 FORMAT('0..GSPLIT INPUT FILE IS EMPTY')                                                                                       
      END                                                                                                                           
