      SUBROUTINE GRIDCON(EFIELDA,FIELDI,NLONO,NLATO,NLONA,NLATA,DAO,
     1                   BETAO,DAA,BETAA,INDII,INDJJ,AFIELD)
C
C     * APR 04/02 - B. MIVILLE - REVISED FOR NEW DATA DESCRIPTION FORMAT
C     * JUN 08/01 - B. MIVILLE
C
C     * CONSERVE THE ORIGINAL ATMOSPHERE VALUES IN THE INTERPOLATED 
C     * OCEAN VALUES
C
C     * THIS IS DONE ASSUMING AN INTEGRAL NUMBER OF OCEAN POINT INSIDE 
C     * THE OVERLYING ATMOSPHERE GRID CELL. THE AREA WEIGHTED AVERAGE 
C     * OF THE OCEAN POINTS NEED TO EQUAL THE ATMOSPHERE POINT.
C
C     * INPUT PARAMETERS...
C
C     * EFIELDA = EXPANDED ATMOSPHERE FIELD
C     * FIELDI  = INTERPOLATED OCEAN FIELD
C     * NLONO   = NUMBER OF OCEAN LONGITUDES INCLUDING CYCLIC
C     * NLATO   = NUMBER OF OCEAN LATITUDES
C     * NLONA   = NUMBER OF ATMOSPHERE LONGITUDES INCLUDING CYCLIC
C     * NLATA   = NUMBER OF ATMOSPHERE LATITUDES 
C     * DAO     = AREA OF OCEAN GRID CELL
C     * BETAO   = HEAVISIDE FUNCTION FOR OCEAN GRID CELL
C     * DAA     = AREA OF ATMOSPHERE GRID CELL
C     * BETAA   = HEAVISIDE FUNCTION FOR ATMOSPHERE GRID CELL
C     * INDII   = INDEX THE OCEAN I POINT TO ATMOSPHERE II POINT 
C     *           FOR ADJUSTMENT
C     * INDJJ   = INDEX THE OCEAN J POINT TO ATMOSPHERE JJ POINT 
C     *           FOR ADJUSTMENT
C
C     * OUTPUT PARAMETERS...
C
C     * AFIELD = ADJUSTED OCEAN FIELD
C
C--------------------------------------------------------------------------------
C
C     * ARRAY SIZE FOR BOT(IMX,JMX) MADE BIG ENOUGH TO ENSURE MOST
C     * FUTURE GRID SIZE
C
      IMPLICIT REAL (A-H,O-Z),
     +INTEGER (I-N)
      PARAMETER(IMX=769,JMX=384)
      INTEGER NLONA,NLATA,NLONO,NLATO
      INTEGER INDII(NLONO,NLATO),INDJJ(NLONO,NLATO),IP,IM
      REAL FIELDI(NLONO,NLATO),EFIELDA(0:NLONA,0:NLATA+1)
      REAL AFIELD(NLONO,NLATO)
      REAL TOP,EPSI,BOT(IMX,JMX)
      REAL DAO(NLONO,NLATO),BETAO(NLONO,NLATO)
      REAL DAA(0:NLONA,0:NLATA+1),BETAA(0:NLONA,0:NLATA+1)
C-----------------------------------------------------------------------
C
C     * VERIFY INPUT GRID SIZE
C
      IF((NLATA.GT.JMX).OR.(NLONA.GT.IMX))THEN
         WRITE(6,'(A,2I8,A)') ' ***ARRAY SIZE BIGGER THAN MAXIMUM '
     1        ,IMX,JMX,' ***'
         CALL                                      XIT('GRIDCON',-14)
      ENDIF
C
      IP=0
      IM=0
C
C     * CHECK IF FIELD IS POSITIVE OR MIX
C
      DO 504 J=1,NLATA
         DO 502 I=1,NLONA
            BOT(I,J)=0.E0
            IF(EFIELDA(I,J).GE.0.E0) THEN
               IP=1
            ELSE
               IM=1
            ENDIF
 502     CONTINUE
 504  CONTINUE
C
C     * FIND ADJUSTMENT
C
      DO 508 J=1,NLATO
         DO 506 I=1,NLONO-1
            II=INDII(I,J)
            JJ=INDJJ(I,J)
            BOT(II,JJ)=BOT(II,JJ)+BETAO(I,J)*FIELDI(I,J)*DAO(I,J)
 506     CONTINUE
 508  CONTINUE
C
C     * ADJUST
C
C     * ADDITIVE ADJUSMENT IS ONLY DONE WHEN THE FIELD HAS POSITIVE 
C     * AND NEGATIVE VALUES. MULTIPLICATIVE ADJUSTMENTS IS DONE ONLY 
C     * WHEN THE FIELD IS DEFINITE POSITIVE OR DEFINITE NEGATIVE.
C
C     * IF WE USE ONLY THE ADDITIVE SCHEME WE MIGHT OBTAIN UNPHYSICAL 
C     * VALUES. THE MULTIPLICATIVE ADJUSTMENT IS A PROBLEM WHEN THE 
C     * DENOMINATOR IN THE EQUATION IS NEAR ZERO.
C
      IF((IP.EQ.1).AND.(IM.EQ.1)) THEN
C        * ADDITIVE ADJUSTMENT
         DO 512 J=1,NLATO
            DO 510 I=1,NLONO-1
               II=INDII(I,J)
               JJ=INDJJ(I,J)
               IF(DAA(II,JJ).EQ.0.E0) THEN
                  EPSI=0.E0
                  AFIELD(I,J)=BETAO(I,J)*FIELDI(I,J)
               ELSE
                  TOP=BETAA(II,JJ)*EFIELDA(II,JJ)*DAA(II,JJ)
                  EPSI=(TOP-BOT(II,JJ))/DAA(II,JJ)
                  AFIELD(I,J)=BETAO(I,J)*(EPSI+FIELDI(I,J))
               ENDIF
 510        CONTINUE
            AFIELD(NLONO,J)=AFIELD(1,J)
 512     CONTINUE
C     
      ELSE
C        * MULTIPLICATIVE ADJUSTMENT
         DO 516 J=1,NLATO
            DO 514 I=1,NLONO-1
               II=INDII(I,J)
               JJ=INDJJ(I,J)
               IF(BOT(II,JJ).EQ.0.E0)THEN
                  EPSI=0.E0
                  AFIELD(I,J)=0.E0
               ELSE
                  TOP=BETAA(II,JJ)*EFIELDA(II,JJ)*DAA(II,JJ)
                  EPSI=TOP/BOT(II,JJ)
                  AFIELD(I,J)=BETAO(I,J)*(EPSI*FIELDI(I,J))
               ENDIF
 514        CONTINUE
            AFIELD(NLONO,J)=AFIELD(1,J)
 516     CONTINUE
      ENDIF
C     
      RETURN
      END
