      PROGRAM BOXL2HR                                                                                                               
C     PROGRAM BOXL2HR (LOWRES,       HIRES,       INPUT,       OUTPUT,  )       I2                                                  
C    1           TAPE1=LOWRES, TAPE2=HIRES, TAPE5=INPUT, TAPE6=OUTPUT)                                                              
C     ----------------------------------------------------------------          I2                                                  
C                                                                                                                                   
C     JAN 30/2008 - M. LAZARE.                                                  I2                                                  
C                                                                               I2                                                  
CBOXL2HR - CREATES AN "N-TIMES" HIRES FIELD FROM A LOWRES FIELD         1  1 C  I1                                                  
C                                                                               I3                                                  
CAUTHOR  - M.LAZARE                                                             I3                                                  
C                                                                               I3                                                  
CPURPOSE - CREATES A "N-TIMES" HIGHER RESOLUTION FIELD FROM AN EXISTING         I3                                                  
C          LOWER RESOLUTION FIELD, BY SIMPLY PROPOGATING EACH LOW-RES           I3                                                  
C          GRID VALUE INTO "N X N" SURROUNDING HIGH-RES VALUES.                 I3                                                  
C                                                                               I3                                                  
C          NOTE - THE LOW-RES FIELD MUST BE THE USUAL OFFSET TYPE.              I3                                                  
C               - THIS PROGRAM WILL CREATE UP TO A 1/12 X 1/12 DEGREE           I3                                                  
C                 GRID.                                                         I3                                                  
C                                                                               I3                                                  
CINPUT FILE...                                                                  I3                                                  
C                                                                               I3                                                  
C      LOWRES = OFFSET LAT-LON FIELD.                                           I3                                                  
C                                                                               I3                                                  
COUTPUT FILE...                                                                 I3                                                  
C                                                                               I3                                                  
C      HIRES  = OFFSET LAT-LON FIELD AT N*N THE SIZE OF LOWRES FIELD.           I3                                                  
C                                                                                                                                   
CINPUT PARAMETER...                                                                                                                 
C                                                                               I5                                                  
C      N      = INCREASED SIZE OF OUTPUT GRID COMPARED TO INPUT GRID.           I5                                                  
C                                                                               I5                                                  
CEXAMPLE OF INPUT CARD...                                                       I5                                                  
C                                                                               I5                                                  
C*BOXL2HR.    4                                                                 I5                                                  
C------------------------------------------------------------------------                                                           
C                                                                                                                                   
      IMPLICIT REAL (A-H,O-Z),                                                                                                      
     +INTEGER (I-N)                                                                                                                 
      PARAMETER (NLG=360*12,     NLAT=180*12,                                                                                       
     1           NLOMAX=360*180, NHIMAX=NLG*NLAT, IJB=NHIMAX)                                                                       
C                                                                                                                                   
      REAL GL(NLOMAX)                                                                                                               
      REAL GH(NHIMAX)                                                                                                               
                                                                                                                                    
      LOGICAL OK                                                                                                                    
C                                                                                                                                   
      COMMON/ICOM/IBUF(8),IDAT(IJB)                                                                                                 
c                                                                                                                                   
      DATA MAXX,NPGG/IJB,+1/                                                                                                        
C---------------------------------------------------------------------                                                              
      NFF=4                                                                                                                         
      CALL JCLPNT(NFF,1,2,5,6)                                                                                                      
      REWIND 1                                                                                                                      
C                                                                                                                                   
C     * READ DENSITY OF HI-RES GRID COMPARED TO LOW-RES GRID.                                                                       
C                                                                                                                                   
      READ(5,5010,END=900) N                                                    I4                                                  
      PRINT *, '0N = ',N                                                                                                            
                                                                                                                                    
C--------------------------------------------------------------------                                                               
C     * LOOP OVER ALL RECORDS.                                                                                                      
C                                                                                                                                   
      NR=0                                                                                                                          
  100 CALL GETFLD2(1,GL, -1 ,0,0,0,IBUF,MAXX,OK)                                                                                    
      IF (IBUF(1).EQ.NC4TO8("LABL"))   GO TO 100                                                                                    
      IF(.NOT.OK)        THEN                                                                                                       
        IF(NR.EQ.0) CALL                           XIT('BOXL2HR',-1)                                                                
        WRITE(6,6010) NR                                                                                                            
        CALL                                       XIT('BOXL2HR',0)                                                                 
      ENDIF                                                                                                                         
      IF(NR.EQ.0) WRITE(6,6025) IBUF                                                                                                
      LONLR=IBUF(5)                                                                                                                 
      LATLR=IBUF(6)                                                                                                                 
C                                                                                                                                   
C     * ABORT IF THIS IS NOT AN OFFSET GRID.                                                                                        
C                                                                                                                                   
      IF(MOD(LONLR,2).NE.0) CALL                   XIT('BOXL2HR',-2)                                                                
C                                                                                                                                   
C     * IF THIS IS THE FIRST RECORD IN, STORE THESE VALUES TO COMPARE                                                               
C     * AGAINST SUBSEQUENT SIZES. IN THEORY, ONE SHOULD BE OPERATING                                                                
C     * ON GRIDS WHICH ARE ALL OF THE SAME SIZE.                                                                                    
C                                                                                                                                   
      IF(NR.EQ.0) THEN                                                                                                              
        LONLR0=LONLR                                                                                                                
        LATLR0=LATLR                                                                                                                
      ENDIF                                                                                                                         
      IF(LONLR.NE.LONLR0.OR.LATLR.NE.LATLR0) CALL  XIT('BOXL2HR',-3)                                                                
C                                                                                                                                   
      LONHR=LONLR*N                                                                                                                 
      LATHR=LATLR*N                                                                                                                 
C                                                                                                                                   
C     * PROPOGATE LOW-RES VALUE TO ALL HIGH-RES POINTS IN ITS DOMAIN.                                                               
C                                                                                                                                   
      DO J=1,LATLR                                                                                                                  
      DO I=1,LONLR                                                                                                                  
        IJ=(J-1)*LONLR+I                                                                                                            
        DO JJ=1,N                                                                                                                   
          JHR=(J-1)*N+JJ                                                                                                            
          DO II=1,N                                                                                                                 
            IHR=(I-1)*N+II                                                                                                          
            IJHR=(JHR-1)*LONHR+IHR                                                                                                  
            GH(IJHR)=GL(IJ)                                                                                                         
          ENDDO                                                                                                                     
        ENDDO                                                                                                                       
      ENDDO                                                                                                                         
      ENDDO                                                                                                                         
C                                                                                                                                   
C     * SAVE THE RESULT.                                                                                                            
C                                                                                                                                   
      IBUF(5)=LONHR                                                                                                                 
      IBUF(6)=LATHR                                                                                                                 
      CALL PUTFLD2(2,GH,IBUF,MAXX)                                                                                                  
      IF(NR.EQ.0) WRITE(6,6025) IBUF                                                                                                
      NR=NR+1                                                                                                                       
      GO TO 100                                                                                                                     
  900 CALL                                         XIT('BOXL2HR',-4)                                                                
C---------------------------------------------------------------------                                                              
 5010 FORMAT(10X,I5)                                                            I4                                                  
 6010 FORMAT('0',I6,'  PAIRS OF RECORDS PROCESSED')                                                                                 
 6025 FORMAT(' ',A4,I10,2X,A4,I10,4I10)                                                                                             
      END                                                                                                                           
