      PROGRAM A2OGRDS                                                                                                               
C     PROGRAM A2OGRDS (FIELDA,         LONO,         LATO,          DAO,        D2                                                  
C    1                                BETAO,       FIELDO,       OUTPUT,)       D2                                                  
C    2           TAPE1=FIELDA,   TAPE2=LONO,   TAPE3=LATO,    TAPE4=DAO,                                                            
C    3                          TAPE7=BETAO, TAPE8=FIELDO, TAPE6=OUTPUT)                                                            
C     ------------------------------------------------------------------        D2                                                  
C                                                                               D2                                                  
C     JUL 03/2003 - A.IRWIN,F.MAJAESS (REVISED FOR F90 AND LINUX PLATFORMS)     D2                                                  
C     APR 04/2002 - B.MIVILLE (REVISED FOR NEW DATA DESCRIPTION FORMAT )        D2                                                  
C     JUN 05/2001 - B.MIVILLE - ORIGINAL VERSION                                                                                    
C                                                                               D2                                                  
CA2OGRDS - INTERPOLATION FROM ATMOSPHERE GRID TO OCEAN GRID FOR                 D1                                                  
C          CELL CENTERED GRIDDED FIELDS                                 5  2    D1                                                  
C                                                                               D3                                                  
CAUTHOR  - B. MIVILLE                                                           D3                                                  
C                                                                               D3                                                  
CPURPOSE - INTERPOLATION FROM ATMOSPHERE GRID TO OCEAN GRID FOR CELL CENTERED   D3                                                  
C          GRIDDED FIELDS.                                                      D3                                                  
C                                                                               D3                                                  
C                                                                               D3                                                  
CINPUT FILES...                                                                 D3                                                  
C                                                                               D3                                                  
C   FIELDA = ATMOSPHERE INPUT FIELD                                             D3                                                  
C   LONO   = OCEAN GRID LONGITUDES                                              D3                                                  
C   LATO   = OCEAN GRID LATITUDES                                               D3                                                  
C   DAO    = AREA OF OCEAN GRID CELL                                            D3                                                  
C   BETAO  = BETA OF OCEAN GRID CELL                                            D3                                                  
C                                                                               D3                                                  
COUTPUT FILE...                                                                 D3                                                  
C                                                                               D3                                                  
C   FIELDO = OCEAN INTERPOLATED AND ADJUSTED OUTPUT FIELD                       D3                                                  
C                                                                               D3                                                  
C------------------------------------------------------------------------------                                                     
C                                                                                                                                   
C     * MAXIMUM 2-D GRID SIZE (I+2)*(J+2)=IM*JM --> IJM                                                                             
C     * FOR MAX GRID SIZE OF I*J PLUS ONE MORE ON EACH SIDE.                                                                        
C                                                                                                                                   
      IMPLICIT REAL (A-H,O-Z),                                                                                                      
     +INTEGER (I-N)                                                                                                                 
      PARAMETER (IM=771,JM=386,IJM=IM*JM,IJMV=IJM*1)                                                                                
      REAL FIELDA(IJM)                                                                                                              
      REAL AFIELD(IJM),LONO(IJM),LATO(IJM)                                                                                          
      REAL ELONA(IJM),ELATA(IJM)                                                                                                    
      REAL FIELDI(IJM)                                                                                                              
      REAL DAO(IJM),BETAO(IJM)                                                                                                      
      REAL DAA(IJM),BETAA(IJM)                                                                                                      
      REAL DLON,LONAW,LONAE                                                                                                         
      REAL EFIELDA(IJM)                                                                                                             
      INTEGER INDI(IJM),INDJ(IJM)                                                                                                   
      INTEGER INDII(IJM),INDJJ(IJM), ILATH                                                                                          
      INTEGER NLONO,NLATO,NLONA,NLATA                                                                                               
      INTEGER NF,NR                                                                                                                 
      INTEGER I,J,II,JJ                                                                                                             
C                                                                                                                                   
      LOGICAL OK                                                                                                                    
      INTEGER IBUF,IDAT,MAXX                                                                                                        
      COMMON/ICOM/IBUF(8),IDAT(IJMV)                                                                                                
      DATA MAXX/IJMV/                                                                                                               
C---------------------------------------------------------------------                                                              
C                                                                                                                                   
      NF=7                                                                                                                          
      CALL JCLPNT(NF,1,2,3,4,7,8,6)                                                                                                 
      REWIND 1                                                                                                                      
      REWIND 2                                                                                                                      
      REWIND 3                                                                                                                      
      REWIND 4                                                                                                                      
      REWIND 7                                                                                                                      
      REWIND 8                                                                                                                      
C                                                                                                                                   
      NR=0                                                                                                                          
C                                                                                                                                   
C     * READ OCEAN LONGITUDES AND LATITUDES                                                                                         
C                                                                                                                                   
      CALL GETFLD2 (2,LONO,NC4TO8("GRID"),-1,-1,-1,IBUF,MAXX,OK)                                                                    
      IF (.NOT.OK) CALL                            XIT('A2OGRDS',-1)                                                                
C                                                                                                                                   
      NLONO=IBUF(5)                                                                                                                 
      NLATO=IBUF(6)                                                                                                                 
C                                                                                                                                   
      CALL GETFLD2 (3,LATO,NC4TO8("GRID"),-1,-1,-1,IBUF,MAXX,OK)                                                                    
      IF (.NOT.OK) CALL                            XIT('A2OGRDS',-2)                                                                
C                                                                                                                                   
      IF((IBUF(5).NE.NLONO).OR.(IBUF(6).NE.NLATO))                                                                                  
     1   CALL                                      XIT('A2OGRDS',-3)                                                                
C                                                                                                                                   
C     * READ IN THE OCEAN GRID CELL AREAS                                                                                           
C                                                                                                                                   
      CALL GETFLD2 (4,DAO,NC4TO8("GRID"),-1,-1,-1,IBUF,MAXX,OK)                                                                     
      IF (.NOT.OK) CALL                            XIT('A2OGRDS',-4)                                                                
C                                                                                                                                   
C     * CHECK IF DIMENSION OF DAO ARE THE SAME AS LATO/LONO                                                                         
C                                                                                                                                   
      IF((IBUF(6).NE.NLATO).OR.(NLONO.NE.IBUF(5)))                                                                                  
     1     CALL                                    XIT('A2OGRDS',-5)                                                                
C                                                                                                                                   
C     * READ IN OCEAN BETA, SHOULD BE AT SURFACE OR FIRST LEVEL                                                                     
C                                                                                                                                   
      CALL GETFLD2 (7,BETAO,NC4TO8("GRID"),-1,-1,-1,IBUF,MAXX,OK)                                                                   
      IF (.NOT.OK) CALL                            XIT('A2OGRDS',-6)                                                                
C                                                                                                                                   
C     * CHECK IF DIMENSION OF BETAO ARE THE SAME AS LATO/LONO                                                                       
C                                                                                                                                   
      IF((NLATO.NE.IBUF(6)).OR.(NLONO.NE.IBUF(5)))                                                                                  
     1     CALL                                    XIT('A2OGRDS',-7)                                                                
C                                                                                                                                   
C     * READ IN ATMOSPHERE FIELD                                                                                                    
C                                                                                                                                   
 600  CALL GETFLD2(1,FIELDA,-1,-1,-1,-1,IBUF,MAXX,OK)                                                                               
      IF (.NOT.OK)THEN                                                                                                              
         IF (NR.EQ.0) CALL                         XIT('A2OGRDS',-8)                                                                
         CALL                                      XIT('A2OGRDS',0)                                                                 
      ENDIF                                                                                                                         
C                                                                                                                                   
C     * VERIFY IF THERE IS ANY SUPERLABEL OR CHAR.                                                                                  
C     * PROGRAM WILL EXIT IF IT ENCOUNTERS A SUPERLABEL OR CHAR.                                                                    
C                                                                                                                                   
      IF(IBUF(1).NE.NC4TO8("GRID"))THEN                                                                                             
         IF((IBUF(1).EQ.NC4TO8("LABL")).OR.                                                                                         
     +      (IBUF(1).EQ.NC4TO8("CHAR")))     THEN                                                                                   
            WRITE(6,6030)' *** SUPERLABELS OR CHAR ARE NOT ALLOWED ***'                                                             
            CALL                                   XIT('A2OGRDS',-9)                                                                
         ELSE                                                                                                                       
            WRITE(6,6030)' *** FIELD LABEL IS NOT GRID ***'                                                                         
            CALL                                   XIT('A2OGRDS',-10)                                                               
         ENDIF                                                                                                                      
      ENDIF                                                                                                                         
C                                                                                                                                   
C     * VERIFY THAT THE INPUT FIELD IS NOT A WIND STRESS                                                                            
C                                                                                                                                   
      IF(NR.EQ.0)THEN                                                                                                               
         IBUF3=IBUF(3)                                                                                                              
         NLONA=IBUF(5)                                                                                                              
         NLATA=IBUF(6)                                                                                                              
         NWRDSA=(NLONA+1)*(NLATA+2)                                                                                                 
         NWRDSO=NLONO*NLATO                                                                                                         
C                                                                                                                                   
         IF((IBUF(3).EQ.NC4TO8("OUFS")).OR.                                                                                         
     1      (IBUF(3).EQ.NC4TO8("OVFS")).OR.                                                                                         
     2      (IBUF(3).EQ.NC4TO8(" UFS")).OR.                                                                                         
     3      (IBUF(3).EQ.NC4TO8(" VFS")))     THEN                                                                                   
            WRITE(6,6030)' *** INPUT FIELD IS A WIND STRESS ***'                                                                    
            WRITE(6,6010) IBUF(3)                                                                                                   
            CALL                                   XIT('A2OGRDS',-11)                                                               
         ENDIF                                                                                                                      
C                                                                                                                                   
C        * CALCULATE THE ATMOSPHERE LATITUDE ASSUMING THAT THE GRID IS A                                                            
C        * NORMAL GAUSSIAN GRID                                                                                                     
C                                                                                                                                   
         CALL ALATLON(NLONA,NLATA,ELONA,ELATA)                                                                                      
C                                                                                                                                   
C        * VERIFY THAT OCEAN LONGITUDES FALL WITHIN THE ATMOSPHERE                                                                  
C        * LONGITUDES RANGE PLUS ONE POINT TO THE EAST AND ONE TO THE WEST.                                                         
C        * ASSUMING UNIFORMLY SPACED LONGITUDES.                                                                                    
C                                                                                                                                   
         IF(LONO(1).LT.ELONA(1).OR.LONO(NWRDSO).GT.ELONA(NWRDSA))THEN                                                               
           WRITE(6,6030) 'OCEAN LONGITUDES OUTSIDE ATMOSPHERE RANGE'                                                                
           WRITE(6,6022) 'LONO(1): ',LONO(1),                                                                                       
     1          'LONO(NLONO): ',LONO(NWRDSO)                                                                                        
            CALL                                   XIT('A2OGRDS',-12)                                                               
         ENDIF                                                                                                                      
C                                                                                                                                   
         WRITE(6,6025)'ATMOSPHERE GRID DIMENSION: ',NLONA,NLATA                                                                     
         WRITE(6,6025)'     OCEAN GRID DIMENSION: ',NLONO,NLATO                                                                     
C                                                                                                                                   
C        * SEARCH FOR RELATIVE POSITION OF EACH OCEAN POINT TO ATMOSPHERE                                                           
C        * POINT                                                                                                                    
C                                                                                                                                   
         CALL INDEXAO(ELONA,ELATA,NLONA,NLATA,LONO,LATO,NLONO,NLATO,                                                                
     1        DAO,BETAO,INDI,INDJ,INDII,INDJJ,DAA,BETAA)                                                                            
C                                                                                                                                   
      ELSE                                                                                                                          
C                                                                                                                                   
C        * CHECK THAT ATMOSPHERE FIELD DIMENSION HAS NOT CHANGED                                                                    
C                                                                                                                                   
         IF(IBUF(5).NE.NLONA.OR.IBUF(6).NE.NLATA)THEN                                                                               
            WRITE(6,6030)' * DIMENSION OF FIELD HAS CHANGED * '                                                                     
            WRITE(6,6015)' * RECORD NUMBER: ',NR+1                                                                                  
            CALL                                   XIT('A2OGRDS',-13)                                                               
         ENDIF                                                                                                                      
C                                                                                                                                   
C        * CHECK IF LABEL HAS CHANGED                                                                                               
C                                                                                                                                   
         IF(IBUF(3).NE.IBUF3) THEN                                                                                                  
            WRITE(6,6030) 'INPUT FIELD HAS CHANGED LABEL'                                                                           
            WRITE(6,6010) IBUF(3)                                                                                                   
            CALL                                   XIT('A2OGRDS',-14)                                                               
         ENDIF                                                                                                                      
      ENDIF                                                                                                                         
C                                                                                                                                   
C     * DO THE INTERPOLATION                                                                                                        
C                                                                                                                                   
      CALL BVINTRP(FIELDA,NLONA,NLATA,ELONA,ELATA,INDI,INDJ,                                                                        
     1     NLONO,NLATO,LONO,LATO,DAO,BETAO,BETAA,DAA,FIELDI,EFIELDA)                                                                
C                                                                                                                                   
C     * DO THE ADJUSTMENTS TO THE ORIGNAL ATMOSPHERE VALUES                                                                         
C                                                                                                                                   
      CALL GRIDCON(EFIELDA,FIELDI,NLONO,NLATO,NLONA,NLATA,DAO,BETAO,                                                                
     1     DAA,BETAA,INDII,INDJJ,AFIELD)                                                                                            
C                                                                                                                                   
C     * WRITE RESULTS OCEAN INTERPOLATED/ADJUSTED FIELD TO FILE                                                                     
C                                                                                                                                   
      IBUF(5)=NLONO                                                                                                                 
      IBUF(6)=NLATO                                                                                                                 
      CALL PUTFLD2(8,AFIELD,IBUF,MAXX)                                                                                              
C                                                                                                                                   
      NR = NR + 1                                                                                                                   
C                                                                                                                                   
      GOTO 600                                                                                                                      
C                                                                                                                                   
C----------------------------------------------------------------------                                                             
 6010 FORMAT('INPUT ATMOSPHERE FIELD: ',A4)                                                                                         
 6015 FORMAT(A,I8)                                                                                                                  
 6020 FORMAT(A,I8,A,I8)                                                                                                             
 6022 FORMAT(A,E12.5,A,E12.5)                                                                                                       
 6025 FORMAT(A,2I8)                                                                                                                 
 6030 FORMAT(A)                                                                                                                     
      END                                                                                                                           
