      PROGRAM WINDOW                                                                                                                
C     PROGRAM WINDOW (GIN,       GOUT,       INPUT,       OUTPUT,       )       D2                                                  
C    1          TAPE5=GIN, TAPE2=GOUT, TAPE5=INPUT, TAPE6=OUTPUT)                                                                   
C     -----------------------------------------------------------               D2                                                  
C                                                                               D2                                                  
C     JAN 04/10 - S. KHARIN (ADD OPTION FOR PROPAGING SUPERLABELS)              D2                                                  
C     JUL 03/03 - A.IRWIN,F.MAJAESS (REVISED FOR F90 AND LINUX PLATFORMS)                                                           
C     MAY 15/00 - S. KHARIN (ADD PROCESSING "TIME" DATA TYPE RECORDS)                                                               
C     MAR 09/99 - S. KHARIN (ADD CASE I1>I2 AND PARAMS NOCYCL,LZERO,SPVAL).                                                         
C     JAN 29/92 - E. CHAN  (CONVERT HOLLERITH LITERALS TO ASCII)                                                                    
C     JAN 30/87 - R.LAPRISE.                                                                                                        
C                                                                               D2                                                  
CWINDOW  - EXTRACTS WINDOWS OF A GRID FILE                              1  1 C GD1                                                  
C                                                                               D3                                                  
CAUTHOR  - R. LAPRISE                                                           D3                                                  
C                                                                               D3                                                  
CPURPOSE - EXTRACT WINDOWS OF GRID OR ZONL FILE GIN AND PUT THEM                D3                                                  
C          IN FILE GOUT.                                                        D3                                                  
C          NOTE - FOR ZONALLY AVERAGED FIELD(S), I1 AND I2 BELOW                D3                                                  
C                 REFER TO LATITUDINAL GRID INDEX.                              D3                                                  
C                                                                               D3                                                  
CINPUT FILE...                                                                  D3                                                  
C                                                                               D3                                                  
C      GIN  = ANY CCRN FILE FROM WHICH WINDOW IS TO BE TAKEN                    D3                                                  
C                                                                               D3                                                  
COUTPUT FILE...                                                                 D3                                                  
C                                                                               D3                                                  
C      GOUT = CCRN FORMAT FILE CONTAINING WINDOW OF INPUT FILE                  D3                                                  
C                                                                                                                                   
CINPUT PARAMETERS...                                                                                                                
C                                                                               D5                                                  
C      I1 - LEFT  GRID INDEX OF WINDOW                                          D5                                                  
C      I2 - RIGHT GRID INDEX OF WINDOW                                          D5                                                  
C      J1 - LOWER GRID INDEX OF WINDOW                                          D5                                                  
C      J2 - UPPER GRID INDEX OF WINDOW                                          D5                                                  
C      NOCYCL = 0 GLOBAL GRID CONTAINS AN EXTRA CYCLIC LONGITUDE,               D5                                                  
C                 OTHERWISE IT DOES NOT.                                        D5                                                  
C                 THIS PARAMETERS IS RELEVANT ONLY FOR I1 > I2.                 D5                                                  
C      LZERO  = 0 SELECT WINDOW,                                                D5                                                  
C                 OTHERWISE PUT SPECIAL VALUE SPVAL AT ALL GRID POINTS          D5                                                  
C                 SURROUNDING THE WINDOW. THE GRID REMAINS GLOBAL.              D5                                                  
C      SPVAL  =   SPECIAL VALUE TO USE, IF LZERO != 0.                          D5                                                  
C                 IGNORED, IF LZERO=0                                           D5                                                  
C      ISLBL = 1 PROPAGATE SUPERLABELS FROM INPUT FILE INTO OUTPUT FILE.        D5                                                  
C                OTHERWISE DO NOT OUTPUT THEM.                                  D5                                                  
C                                                                               D5                                                  
C      NOTE - IF I1>I2, THE WINDOW IS DEFINED AS [I1,...,NLON-1,1,...,I2],      D5                                                  
C                       IF NOCYCL=0                                             D5                                                  
C                       AND AS [I1,...,NLON,1,...,I2], OTHERWISE.               D5                                                  
C                                                                               D5                                                  
C                                                                               D5                                                  
CEXAMPLE OF INPUT CARD...                                                       D5                                                  
C                                                                               D5                                                  
C*WINDOW      1   96   25   48                                                  D5                                                  
C (SELECT WINDOW)                                                               D5                                                  
C                                                                               D5                                                  
C*WINDOW     49   48   25   48                                                  D5                                                  
C (SELECT WINDOW AROUND THE GREENWICH. ASSUME THERE IS CYCLIC MERIDIAN)         D5                                                  
C                                                                               D5                                                  
C*WINDOW     49   48   25   48    1                                             D5                                                  
C (SELECT WINDOW AROUND THE GREENWICH. ASSUME THERE IS NO CYCLIC MERIDIAN)      D5                                                  
C                                                                               D5                                                  
C*WINDOW      1   96   25   48         1                                        D5                                                  
C (ZERO OUT AROUND WINDOW)                                                      D5                                                  
C                                                                               D5                                                  
C*WINDOW      1   96   25   48         1    1.E+38                              D5                                                  
C (PUT SPECIAL VALUE AROUND WINDOW)                                             D5                                                  
C                                                                               D5                                                  
C*WINDOW      1   96   25   48                        1                         D5                                                  
C (SELECT WINDOW AND PROPAGATE SUPERLABELS)                                     D5                                                  
C                                                                               D5                                                  
C-----------------------------------------------------------------------------                                                      
C                                                                                                                                   
      IMPLICIT REAL (A-H,O-Z),                                                                                                      
     +INTEGER (I-N)                                                                                                                 
      LOGICAL OK                                                                                                                    
      COMMON /BLANCK/ G(65341)                                                                                                      
      COMMON /ICOM/ IBUF(8),DAT(65341)                                                                                              
C                                                                                                                                   
      DATA MAXDAT/65341/, SMALL/1.E-12/                                                                                             
C---------------------------------------------------------------------                                                              
      NFIL=4                                                                                                                        
      CALL JCLPNT(NFIL,1,2,5,6)                                                                                                     
      REWIND 1                                                                                                                      
      REWIND 2                                                                                                                      
C                                                                                                                                   
C     * READ-IN WINDOW BOUNDARIES.                                                                                                  
C                                                                                                                                   
      READ(5,5000,END=901)I1,I2,J1,J2,NOCYCL,LZERO,SPVAL,ISPVL                  D4                                                  
      WRITE(6,6000)I1,I2,J1,J2,NOCYCL,LZERO,SPVAL,ISPVL                                                                             
      NCYCL=0                                                                                                                       
      IF (NOCYCL.EQ.0) NCYCL=1                                                                                                      
C                                                                                                                                   
C     * READ-IN GRIDS.                                                                                                              
C                                                                                                                                   
      NR=0                                                                                                                          
  100 CALL GETFLD2(1,G,-1,-1,-1,-1,IBUF,MAXDAT,OK)                                                                                  
      IF(NR.EQ.0) CALL PRTLAB(IBUF)                                                                                                 
      IF(.NOT.OK)THEN                                                                                                               
         CALL PRTLAB(IBUF)                                                                                                          
         WRITE(6,6002)NR                                                                                                            
         IF(NR.EQ.0) CALL                          XIT('WINDOW',-1)                                                                 
         CALL                                      XIT('WINDOW',0)                                                                  
      ENDIF                                                                                                                         
C                                                                                                                                   
C     * WRITE OUT SUPERLABELS                                                                                                       
C                                                                                                                                   
      IF(IBUF(1).EQ.NC4TO8("LABL") .OR.                                                                                             
     1   IBUF(1).EQ.NC4TO8("CHAR")) THEN                                                                                            
        IF(ISPVL.EQ.1)THEN                                                                                                          
          GOTO 410                                                                                                                  
        ELSE                                                                                                                        
          GOTO 100                                                                                                                  
        ENDIF                                                                                                                       
      ENDIF                                                                                                                         
C                                                                                                                                   
C     * CHECK OTHER RECORD TYPES                                                                                                    
C                                                                                                                                   
      IF(IBUF(1).NE.NC4TO8("GRID") .AND.                                                                                            
     1   IBUF(1).NE.NC4TO8("ZONL") .AND.                                                                                            
     2   IBUF(1).NE.NC4TO8("TIME")      ) CALL     XIT('WINDOW',-2)                                                                 
C                                                                                                                                   
C     * EXTRACT WINDOW.                                                                                                             
C                                                                                                                                   
      LON=IBUF(5)                                                                                                                   
      LAT=IBUF(6)                                                                                                                   
      NWDS=LAT*LON                                                                                                                  
      LON1=MIN(LON,MAX(  1,I1))                                                                                                     
      LAT1=MIN(LAT,MAX(  1,J1))                                                                                                     
      LON2=MAX(  1,MIN(LON,I2))                                                                                                     
      LAT2=MAX(  1,MIN(LAT,J2))                                                                                                     
C                                                                                                                                   
C     * INITIALIZE DAT TO SPVAL, IF LZERO.NE.0                                                                                      
C                                                                                                                                   
      IF (LZERO.NE.0) THEN                                                                                                          
         DO 200 IJ=1,NWDS                                                                                                           
            DAT(IJ)=SPVAL                                                                                                           
 200     CONTINUE                                                                                                                   
      ENDIF                                                                                                                         
C                                                                                                                                   
C     * CASE 1: I1 <= I2                                                                                                            
C                                                                                                                                   
      IF (LON1.LE.LON2) THEN                                                                                                        
         IF (LZERO.EQ.0) THEN                                                                                                       
C                                                                                                                                   
C     * SELECT WINDOW                                                                                                               
C                                                                                                                                   
            IJ=0                                                                                                                    
            DO 300 J=LAT1,LAT2                                                                                                      
               IFULLG0=(J-1)*LON                                                                                                    
               DO 305 I=LON1,LON2                                                                                                   
                  IJ=IJ+1                                                                                                           
                  IFULLG=IFULLG0+I                                                                                                  
                  DAT(IJ)=G(IFULLG)                                                                                                 
 305           CONTINUE                                                                                                             
 300        CONTINUE                                                                                                                
         ELSE                                                                                                                       
C                                                                                                                                   
C     * PUT SPVAL AROUND WINDOW                                                                                                     
C                                                                                                                                   
            DO 310 J=LAT1,LAT2                                                                                                      
               IFULLG0=(J-1)*LON                                                                                                    
               DO 315 I=LON1,LON2                                                                                                   
                  IFULLG=IFULLG0+I                                                                                                  
                  DAT(IFULLG)=G(IFULLG)                                                                                             
 315           CONTINUE                                                                                                             
 310        CONTINUE                                                                                                                
         ENDIF                                                                                                                      
C                                                                                                                                   
C     * CASE 2: I1 > I2                                                                                                             
C                                                                                                                                   
      ELSE                                                                                                                          
         IF (LZERO.EQ.0) THEN                                                                                                       
C                                                                                                                                   
C     * SELECT WINDOW                                                                                                               
C                                                                                                                                   
            IJ=0                                                                                                                    
            DO 320 J=LAT1,LAT2                                                                                                      
               IFULLG0=(J-1)*LON                                                                                                    
               DO 325 I=LON1,LON-NCYCL                                                                                              
                  IJ=IJ+1                                                                                                           
                  IFULLG=IFULLG0+I                                                                                                  
                  DAT(IJ)=G(IFULLG)                                                                                                 
 325           CONTINUE                                                                                                             
               DO 330 I=1,LON2                                                                                                      
                  IJ=IJ+1                                                                                                           
                  IFULLG=IFULLG0+I                                                                                                  
                  DAT(IJ)=G(IFULLG)                                                                                                 
 330           CONTINUE                                                                                                             
 320        CONTINUE                                                                                                                
         ELSE                                                                                                                       
C                                                                                                                                   
C     * PUT SPVAL AROUND WINDOW                                                                                                     
C                                                                                                                                   
            DO 360 J=LAT1,LAT2                                                                                                      
               IFULLG0=(J-1)*LON                                                                                                    
               DO 365 I=LON1,LON-NCYCL                                                                                              
                  IFULLG=IFULLG0+I                                                                                                  
                  DAT(IFULLG)=G(IFULLG)                                                                                             
 365           CONTINUE                                                                                                             
               DO 370 I=1,LON2                                                                                                      
                  IFULLG=IFULLG0+I                                                                                                  
                  DAT(IFULLG)=G(IFULLG)                                                                                             
 370           CONTINUE                                                                                                             
 360        CONTINUE                                                                                                                
         ENDIF                                                                                                                      
      ENDIF                                                                                                                         
C                                                                                                                                   
C     * CALCULATE DIMENSIONS OF WINDOW                                                                                              
C                                                                                                                                   
      IF (LZERO .EQ. 0) THEN                                                                                                        
         IF (LON1.LE.LON2) THEN                                                                                                     
            IBUF(5)=LON2-LON1+1                                                                                                     
         ELSE                                                                                                                       
            IBUF(5)=LON-LON1+LON2+1-NCYCL                                                                                           
         ENDIF                                                                                                                      
         IBUF(6)=LAT2-LAT1+1                                                                                                        
         NWDS=IBUF(5)*IBUF(6)                                                                                                       
      ENDIF                                                                                                                         
C                                                                                                                                   
      DO 400 IND=1,NWDS                                                                                                             
 400  G(IND)=DAT(IND)                                                                                                               
C                                                                                                                                   
C     * CHANGE PACKING DENSITY TO 1 IF SPVAL=1.E+38                                                                                 
C                                                                                                                                   
      IF (ABS(SPVAL-1.E+38).LT.SMALL) IBUF(8)=1                                                                                     
C                                                                                                                                   
C     * SAVE OUTPUT GRID.                                                                                                           
C                                                                                                                                   
 410  CALL PUTFLD2(2,G,IBUF,MAXDAT)                                                                                                 
                                                                                                                                    
      NR=NR+1                                                                                                                       
      GO TO 100                                                                                                                     
C                                                                                                                                   
C     * E.O.F. ON INPUT                                                                                                             
C                                                                                                                                   
  901 CALL                                         XIT('WINDOW',-3)                                                                 
C-------------------------------------------------------------------------                                                          
 5000 FORMAT(10X,6I5,E10.0,I5)                                                  D4                                                  
 6000 FORMAT(' I1,I2=',I6,',',I6,'    J1,J2=',I6,',',I6,                                                                            
     1     ' NOCYCL=',I5, ' LZERO=',I5, ' SPVAL=',1P1E12.5,' ISPVL=',I5)                                                            
 6002 FORMAT(I10,' RECORDS PROCESSED')                                                                                              
      END                                                                                                                           
