      PROGRAM SELECT2                                                                                                               
C     PROGRAM SELECT2 (IN,       S1,       S2,      INPUT,      OUTPUT, )       B2                                                  
C    1           TAPE1=IN,TAPE11=S1,TAPE12=S2,TAPE5=INPUT,TAPE6=OUTPUT)                                                             
C     -----------------------------------------------------------------         B2                                                  
C                                                                               B2                                                  
C     JUL 03/03 - A.IRWIN,F.MAJAESS (REVISED FOR F90 AND LINUX PLATFORMS)       B2                                                  
C     MAR 24/99 - F .MAJAESS (ENSURE THE DEACTIVATION OF "DTM=2" OPTION IN      B2                                                  
C                             "NEWTIM" IS DOCUMENTED AND CHECKED FOR)           B2                                                  
C     JAN 14/93 - E. CHAN  (CONVERT CODED LEVEL INFO INTO ALTERNATE CODE                                                            
C                           CODE THAT IS MONOTONICALLY INCREASING)                                                                  
C     JAN 29/92 - E. CHAN  (CONVERT HOLLERITH LITERALS TO ASCII)                                                                    
C     JAN 14/85 - F. ZWIERS                                                                                                         
C                                                                               B2                                                  
CSELECT2 - SELECTS UP TO TWO VARIABLES, DOES TIME INTERVAL CHECK        1  2 C  B1                                                  
C                                                                               B3                                                  
CAUTHOR  - F. ZWIERS                                                            B3                                                  
C                                                                               B3                                                  
CPURPOSE - SELECT ALL VARIABLES (OR 1 OR 2 SPECIFIED VARIABLES) BETWEEN         B3                                                  
C          TIMESTEPS T1 AND T2 MAKING SURE THAT FOR EACH VARIABLE,              B3                                                  
C          RECORDS ARE IN CORRECT TIME ORDER.                                   B3                                                  
C          NOTE - SELECT2 SUPPORTS ALL OF THE OFFICIALLY SANCTIONED             B3                                                  
C                 TECHNIQUES FOR MEASURING TIME                                 B3                                                  
C                                                                               B3                                                  
CINPUT FILE...                                                                  B3                                                  
C                                                                               B3                                                  
C      IN = ANY DIAGNOSTIC GRID OR SPEC FILE.                                   B3                                                  
C                                                                               B3                                                  
COUTPUT FILE...                                                                 B3                                                  
C                                                                               B3                                                  
C      S1 = TIME SERIES OF FIELDS FOR FIRST VARIABLE SPECIFIED OR TIME          B3                                                  
C           SERIES OF SETS OF FIELDS.                                           B3                                                  
C      S2 = TIME SERIES OF FIELDS FOR SECOND VARIABLE (IF SPECIFIED).           B3                                                  
C                                                                                                                                   
CINPUT PARAMETERS...                                                                                                                
C                                                                               B5                                                  
C      T1,T2   = TIME INTERVAL                                                  B5                                                  
C      T3      = SAMPLING INTERVAL.                                             B5                                                  
C                T3> 0 ==> TAKE ALL RECORDS WITH TIMES T SUCH THAT              B5                                                  
C                          T1<=T<=T3 AND T-T1=0 (MODULO T3).  THE               B5                                                  
C                          PROGRAM ABORTS IF ANY OF THE REQUESTED               B5                                                  
C                          RECORDS ARE MISSING OR IF THE RECORDS IN             B5                                                  
C                          'IN' ARE OUT OF CORRECT TIME SEQUENCE.               B5                                                  
C                T3<=0 ==> TAKE ALL RECORDS SUCH THAT T1<=T<=T2.                B5                                                  
C                          PRINT WARNINGS IF RECORDS ARE OUT OF                 B5                                                  
C                          SEQUENCE AND XIT WITH XIT NUMBER < -100.             B5                                                  
C      LV1,LV2 = RANGE OF LEVELS.                                               B5                                                  
C      NAME1   = NAME OF FIRST VARIABLE TO SELECT OR 'ALL' (TO                  B5                                                  
C                CREATE TIME SERIES OF SETS).                                   B5                                                  
C      NAME2   = NAME OF SECOND VARIABLE TO SELECT.                             B5                                                  
C      DTM     = FLAG TO INDICATE METHOD OF TIME MEASUREMENT.                   B5                                                  
C              = 0 ==> IBUF(2),T1,T2 AND T3 IN KOUNT UNITS.                     B5                                                  
C              = 1 ==> IBUF(2),T1 AND T2 ARE IN THE FORMAT YYMMDDHH             B5                                                  
C                      AND T3 IS IN HOURS.                                      B5                                                  
C              = 2 ==> IBUF(2),T1 AND T2 ARE IN THE FORMAT YYMMDDHHMM           B5                                                  
C                      AND T3 IS IN MINUTES AND NO LEAP YEAR.                   B5                                                  
C                         >>>>>>>>> DEACTIVATED <<<<<<<<                        B5                                                  
C              = 3 ==> IBUF(2),T1 AND T2 ARE IN THE FORMAT YYMMDDHH             B5                                                  
C                      AND T3 IS IN HOURS. IN THIS CASE LEAP YEARS              B5                                                  
C                      ARE TAKEN INTO ACCOUNT AND YY COUNTED AS YEARS           B5                                                  
C                      SINCE 1900 AD.                                           B5                                                  
C              NOTE - DTM = 0,1 OR 2 DO NOT TAKE LEAP YEARS INTO ACCOUNT        B5                                                  
C                           AND ARE INTENDED FOR USE WITH MODEL OUTPUT.         B5                                                  
C                                                                               B5                                                  
CEXAMPLE OF INPUT CARD...                                                       B5                                                  
C                                                                               B5                                                  
C*SELECT2. STEP         0    999999   72 LEVS  500  500 NAME  PHI       DTM    0B5                                                  
C                                                                               B5                                                  
C WILL CREATE A TIME SERIES OF 500MB GPH FIELDS SAMPLED EVERY 72 TIME STEPS.    B5                                                  
C THE PROGRAM WILL ABORT IF OBSERVATIONS ARE NOT AVAILABLE AT TIME STEPS        B5                                                  
C WHICH ARE MULTIPLES OF 72 OR IF ANY OBSERVATIONS ARE MISSING OR OUT OF        B5                                                  
C TIME SEQUENCE.                                                                B5                                                  
C-------------------------------------------------------------------------------                                                    
C                                                                                                                                   
      IMPLICIT REAL (A-H,O-Z),                                                                                                      
     +INTEGER (I-N)                                                                                                                 
      LOGICAL OK,WARN,ORDER,PUT,TCHECK                                                                                              
      CHARACTER*8 CNIL                                                                                                              
      INTEGER TIME,T,T1,T2,T3,DTM,NIL                                                                                               
      DIMENSION IX(16),IBUF(8),IDAT(65341)                                                                                          
      COMMON/ICOM/IBUF,IDAT                                                                                                         
      COMMON/PREC/WK(12)                                                                                                            
      DATA MAXX/65341/                                                                                                              
C     DATA NIL/4H    /,NALL/4H ALL/                                                                                                 
      EQUIVALENCE(CNIL,NIL)                                                                                                         
      DATA CNIL/'        '/                                                                                                         
C                                                                                                                                   
C     * COMMON/PREC/ RESERVES SPACE USED BY PUTREC FOR STORING                                                                      
C     * HISTORICAL INFORMATION ABOUT THE SEQUENCE OF RECORDS WHICH                                                                  
C     * PUTREC IS ASKED TO WRITE TO DISK.                                                                                           
C-------------------------------------------------------------------------------                                                    
C     NIL=4H                                                                                                                        
      NALL=NC4TO8(" ALL")                                                                                                           
      NF=5                                                                                                                          
      CALL JCLPNT(NF,1,11,12,5,6)                                                                                                   
      REWIND 1                                                                                                                      
      NF=NF-3                                                                                                                       
      DO 1000 I=11,10+NF                                                                                                            
 1000 REWIND I                                                                                                                      
C                                                                                                                                   
C-----------------------------------------------------------------------------                                                      
C                                                                                                                                   
      READ(5,5010,END=10) T1,T2,T3,LV1,LV2,NAME1,NAME2,DTM                      B4                                                  
      GOTO 20                                                                                                                       
   10 CONTINUE                                                                                                                      
         WRITE(6,6010)                                                                                                              
         CALL                                      XIT('SELECT2',-1)                                                                
   20 CONTINUE                                                                                                                      
      WRITE(6,6020) T1,T2,T3,LV1,LV2,NAME1,NAME2,DTM                                                                                
C                                                                                                                                   
C     * CHECK SELECT2 CARD                                                                                                          
C     * DTM=2 IS DEACTIVATED IN NEWTIM.                                                                                             
C                                                                                                                                   
      IF(DTM.LT.0 .OR. DTM.GT.3 .OR. DTM.EQ.2 )THEN                                                                                 
         WRITE(6,6030)                                                                                                              
         CALL                                      XIT('SELECT2',-2)                                                                
      ENDIF                                                                                                                         
      IT1=T1                                                                                                                        
      IT2=T2                                                                                                                        
      T1=NEWTIM(IT1,DTM,OK)                                                                                                         
      IF(.NOT.OK) CALL                             XIT('SELECT2',-3)                                                                
      T2=NEWTIM(IT2,DTM,OK)                                                                                                         
      IF(.NOT.OK) CALL                             XIT('SELECT2',-4)                                                                
      TCHECK=(T3.GT.0)                                                                                                              
      IF(T1.GT.T2 .OR. (TCHECK. AND. T2-T1.LT.T3) )THEN                                                                             
         WRITE(6,6040)                                                                                                              
         CALL                                      XIT('SELECT2',-5)                                                                
      ENDIF                                                                                                                         
C                                                                                                                                   
C     * CONVERT CODED LEVELS INTO ALTERNATE CODE THAT IS MONOTONICALLY                                                              
C     * INCREASING.                                                                                                                 
C                                                                                                                                   
      LEV1=LV1                                                                                                                      
      LEV2=LV2                                                                                                                      
      CALL LVACODE(LV1,LV1,1)                                                                                                       
      CALL LVACODE(LV2,LV2,1)                                                                                                       
C                                                                                                                                   
      IF(LV1.GT.LV2)THEN                                                                                                            
         WRITE(6,6050)                                                                                                              
         CALL                                      XIT('SELECT2',-6)                                                                
      ENDIF                                                                                                                         
C                                                                                                                                   
C     * SET UP COMMON/PREC/ FOR THE UTILITY ROUTINE USED TO OUTPUT RECORDS.                                                         
C     * THIS INCLUDES DETERMINING THE NUMBER OF RECORDS PER TIME STEP FOR                                                           
C     * EACH VARIABLE (OR FOR 'ALL') WHICH HAVE LEVELS BETWEEN LV1                                                                  
C     * AND LV2 INCLUSIVE.                                                                                                          
C                                                                                                                                   
      CALL PSETUP(1,NAME1,NAME2,LEV1,LEV2)                                                                                          
C                                                                                                                                   
C-----------------------------------------------------------------------------                                                      
C                                                                                                                                   
C                                                                                                                                   
C     * NREC = NUMBER OF RECORDS READ                                                                                               
C     * NREC1 = NUMBER OF RECORDS WRITTEN TO UNIT 11                                                                                
C     * NREC2 = NUMBER OF RECORDS WRITTEN TO UNIT 12                                                                                
C     * IX = HOLDS LABELS OF THE TWO RECORDS MOST RECENTLY READ                                                                     
C     * WARN = A FLAG WHICH INDICATES WHETHER OR NOT WARNINGS HAVE                                                                  
C     *        BEEN ISSUED                                                                                                          
C                                                                                                                                   
      NREC=0                                                                                                                        
      NREC1=0                                                                                                                       
      NREC2=0                                                                                                                       
      WARN=.FALSE.                                                                                                                  
      DO 30 I=1,16                                                                                                                  
         IX(I)=0                                                                                                                    
   30 CONTINUE                                                                                                                      
      IX(1)=NIL                                                                                                                     
      IX(3)=NIL                                                                                                                     
      IX(9)=NIL                                                                                                                     
      IX(11)=NIL                                                                                                                    
C                                                                                                                                   
C     * MAIN LOOP                                                                                                                   
C                                                                                                                                   
  100 CONTINUE                                                                                                                      
C                                                                                                                                   
C        * GET A RECORD                                                                                                             
C                                                                                                                                   
         CALL RECGET(1,-1,-1,-1,-1,IBUF,MAXX,OK)                                                                                    
         IF(.NOT.OK)THEN                                                                                                            
C                                                                                                                                   
C           * OUT OF DATA SO ALL DONE                                                                                               
C                                                                                                                                   
            IF(NREC.GT.0)THEN                                                                                                       
               WRITE(6,6060) NREC,NREC1,NREC2                                                                                       
               NRECS=NREC1+NREC2                                                                                                    
               IF(NRECS.EQ.0) CALL                 XIT('SELECT2',-7)                                                                
               IF(WARN) CALL                       XIT('SELECT2',-101)                                                              
               CALL                                XIT('SELECT2',0)                                                                 
            ELSE                                                                                                                    
               WRITE(6,6070)                                                                                                        
               CALL                                XIT('SELECT2',-8)                                                                
            ENDIF                                                                                                                   
         ENDIF                                                                                                                      
         TIME=NEWTIM(IBUF(2),DTM,OK)                                                                                                
         IF(.NOT.OK) CALL                          XIT('SELECT2',-9)                                                                
         CALL LVACODE(L,IBUF(4),1)                                                                                                  
C                                                                                                                                   
C                                                                                                                                   
         IF(TIME.GT.T2)THEN                                                                                                         
C                                                                                                                                   
C           * ALL DONE                                                                                                              
C                                                                                                                                   
            WRITE(6,6060) NREC,NREC1,NREC2                                                                                          
            NRECS=NREC1+NREC2                                                                                                       
            IF(NRECS.EQ.0) CALL                    XIT('SELECT2',-10)                                                               
            IF(WARN) CALL                          XIT('SELECT2',-102)                                                              
            CALL                                   XIT('SELECT2',0)                                                                 
         ENDIF                                                                                                                      
         NREC=NREC+1                                                                                                                
C                                                                                                                                   
C        * ARE WE INTERESTED IN THE RECORD? -- IF NOT, GET ANOTHER                                                                  
C                                                                                                                                   
         IF(TIME.LT.T1 .OR. L.LT.LV1 .OR. L.GT.LV2) GOTO 100                                                                        
C                                                                                                                                   
C        * PROCESS THE RECORD IF ITS A FIELD WE WANT                                                                                
C        * FIRST SAVE THE LABEL                                                                                                     
C                                                                                                                                   
         DO 110 I=1,8                                                                                                               
            IX(I)=IX(I+8)                                                                                                           
            IX(I+8)=IBUF(I)                                                                                                         
  110    CONTINUE                                                                                                                   
         IF(IBUF(3).EQ.NAME1 .OR. NAME1.EQ.NALL)THEN                                                                                
            CALL PUTREC(11,TIME,T1,T3,1,ORDER,PUT)                                                                                  
            IF(.NOT.ORDER)THEN                                                                                                      
               WRITE(6,6080)                                                                                                        
               WRITE(6,6090) (IX(I),I=1,16)                                                                                         
               WARN=.TRUE.                                                                                                          
               IF(TCHECK) CALL                     XIT('SELECT2',-11)                                                               
            ENDIF                                                                                                                   
            IF(PUT) NREC1=NREC1+1                                                                                                   
            GOTO 100                                                                                                                
         ELSEIF(IBUF(3).EQ.NAME2)THEN                                                                                               
            CALL PUTREC(12,TIME,T1,T3,2,ORDER,PUT)                                                                                  
            IF(.NOT.ORDER)THEN                                                                                                      
               WRITE(6,6080)                                                                                                        
               WRITE(6,6090) (IX(I),I=1,16)                                                                                         
               WARN=.TRUE.                                                                                                          
               IF(TCHECK) CALL                     XIT('SELECT2',-12)                                                               
            ENDIF                                                                                                                   
            IF(PUT) NREC2=NREC2+1                                                                                                   
            GOTO 100                                                                                                                
         ENDIF                                                                                                                      
         GOTO 100                                                                                                                   
C                                                                                                                                   
C-----------------------------------------------------------------------------                                                      
C                                                                                                                                   
 5010 FORMAT(15X,2I10,I5,5X,2I5,5X,2(1X,A4),5X,I5)                              B4                                                  
 6010 FORMAT('0INPUT EMPTY.')                                                                                                       
 6020 FORMAT('0SELECT2    STEP',2I10,I5,' LEVS',2I5,' NAME',2(1X,A4),                                                               
     1       '  DTM',I5)                                                                                                            
 6030 FORMAT('0DTM SEPCIFIED INCORRECTLY.')                                                                                         
 6040 FORMAT('0T1,T2, AND/OR T3 SPECIFIED INCORRECTLY.')                                                                            
 6050 FORMAT('0LEVELS SPECIFIED INCORRECTLY.')                                                                                      
 6060 FORMAT('0RECORDS IN =',I6,'  RECORDS OUT =',4I6)                                                                              
 6070 FORMAT('0IN IS EMPTY.')                                                                                                       
 6080 FORMAT('0RECORDS FOUND OUT OF SEQUENCE.')                                                                                     
 6090 FORMAT(1X,A4,I10,1X,A4,5I10)                                                                                                  
      END                                                                                                                           
