pkg/seaice/seaice_advection.F

f12f84b0ce Jean*0001 #include "SEAICE_OPTIONS.h"
                0002 #ifdef ALLOW_GENERIC_ADVDIFF
                0003 # include "GAD_OPTIONS.h"
                0004 #endif
772b2ed80e Gael*0005 #ifdef ALLOW_AUTODIFF
                0006 # include "AUTODIFF_OPTIONS.h"
                0007 #endif
03105a7583 Mart*0008
                0009 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0010 CBOP
                0011 C !ROUTINE: SEAICE_ADVECTION
                0012
                0013 C !INTERFACE: ==========================================================
                0014       SUBROUTINE SEAICE_ADVECTION(
                0015      I     tracerIdentity,
0d75a51072 Mart*0016      I     advectionSchArg,
f12f84b0ce Jean*0017      I     uFld, vFld, uTrans, vTrans, iceFld, r_hFld,
                0018      O     gFld, afx, afy,
03105a7583 Mart*0019      I     bi, bj, myTime, myIter, myThid)
                0020
                0021 C !DESCRIPTION:
f12f84b0ce Jean*0022 C Calculates the tendency of a sea-ice field due to advection.
03105a7583 Mart*0023 C It uses the multi-dimensional method given in \ref{sect:multiDimAdvection}
                0024 C and can only be used for the non-linear advection schemes such as the
f12f84b0ce Jean*0025 C direct-space-time method and flux-limiters.
03105a7583 Mart*0026 C
                0027 C This routine is an adaption of the GAD_ADVECTION for 2D-fields.
f12f84b0ce Jean*0028 C for Area, effective thickness or other "extensive" sea-ice field,
                0029 C  the contribution iceFld*div(u) (that is present in gad_advection)
                0030 C  is not included here.
03105a7583 Mart*0031 C
                0032 C The algorithm is as follows:
                0033 C \begin{itemize}
                0034 C \item{$\theta^{(n+1/2)} = \theta^{(n)}
                0035 C      - \Delta t \partial_x (u\theta^{(n)}) + \theta^{(n)} \partial_x u$}
                0036 C \item{$\theta^{(n+2/2)} = \theta^{(n+1/2)}
                0037 C      - \Delta t \partial_y (v\theta^{(n+1/2)}) + \theta^{(n)} \partial_y v$}
                0038 C \item{$G_\theta = ( \theta^{(n+2/2)} - \theta^{(n)} )/\Delta t$}
                0039 C \end{itemize}
                0040 C
                0041 C The tendency (output) is over-written by this routine.
                0042
                0043 C !USES: ===============================================================
                0044       IMPLICIT NONE
                0045 #include "SIZE.h"
                0046 #include "EEPARAMS.h"
                0047 #include "PARAMS.h"
                0048 #include "GRID.h"
7303eab4f2 Patr*0049 #include "SEAICE_SIZE.h"
03105a7583 Mart*0050 #include "SEAICE_PARAMS.h"
3f0f10fc37 Mart*0051 #include "SEAICE_GRID.h"
0d75a51072 Mart*0052 #include "SEAICE.h"
f12f84b0ce Jean*0053 #ifdef ALLOW_GENERIC_ADVDIFF
                0054 # include "GAD.h"
                0055 #endif
0d75a51072 Mart*0056 #ifdef ALLOW_AUTODIFF
                0057 # include "AUTODIFF_PARAMS.h"
                0058 #endif /* ALLOW_AUTODIFF */
03105a7583 Mart*0059 #ifdef ALLOW_AUTODIFF_TAMC
                0060 # include "tamc.h"
fd1ff3e50c Patr*0061 # ifdef ALLOW_PTRACERS
                0062 #  include "PTRACERS_SIZE.h"
                0063 # endif
0d75a51072 Mart*0064 #endif /* ALLOW_AUTODIFF_TAMC */
03105a7583 Mart*0065 #ifdef ALLOW_EXCH2
f9f661930b Jean*0066 #include "W2_EXCH2_SIZE.h"
03105a7583 Mart*0067 #include "W2_EXCH2_TOPOLOGY.h"
                0068 #endif /* ALLOW_EXCH2 */
4a98994c14 Jean*0069       LOGICAL extensiveFld
                0070       PARAMETER ( extensiveFld = .TRUE. )
03105a7583 Mart*0071
                0072 C !INPUT PARAMETERS: ===================================================
a1ab12d5e7 Dimi*0073 C  tracerIdentity  :: tracer identifier
0d75a51072 Mart*0074 C  advectionSchArg :: advection scheme to use (Horizontal plane)
f12f84b0ce Jean*0075 C  extensiveFld    :: indicates to advect an "extensive" type of ice field
                0076 C  uFld            :: velocity, zonal component
                0077 C  vFld            :: velocity, meridional component
                0078 C  uTrans,vTrans   :: volume transports at U,V points
                0079 C  iceFld          :: sea-ice field
e8c00a82b3 Jean*0080 C  r_hFld          :: reciprocal of ice-thickness (only used for "intensive"
f12f84b0ce Jean*0081 C                     type of sea-ice field)
                0082 C  bi,bj           :: tile indices
                0083 C  myTime          :: current time
                0084 C  myIter          :: iteration number
e8c00a82b3 Jean*0085 C  myThid          :: my Thread Id number
03105a7583 Mart*0086       INTEGER tracerIdentity
0d75a51072 Mart*0087       INTEGER advectionSchArg
f12f84b0ce Jean*0088       _RL uFld  (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
                0089       _RL vFld  (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
                0090       _RL uTrans(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
                0091       _RL vTrans(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
                0092       _RL iceFld(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
                0093       _RL r_hFld(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
03105a7583 Mart*0094       INTEGER bi,bj
                0095       _RL myTime
                0096       INTEGER myIter
                0097       INTEGER myThid
                0098
                0099 C !OUTPUT PARAMETERS: ==================================================
f12f84b0ce Jean*0100 C  gFld          :: tendency array
                0101 C  afx           :: horizontal advective flux, x direction
                0102 C  afy           :: horizontal advective flux, y direction
                0103       _RL gFld  (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
                0104       _RL afx   (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
                0105       _RL afy   (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
03105a7583 Mart*0106
e0fa1cecbf Mart*0107 #ifdef ALLOW_GENERIC_ADVDIFF
03105a7583 Mart*0108 C !LOCAL VARIABLES: ====================================================
                0109 C  maskLocW      :: 2-D array for mask at West points
                0110 C  maskLocS      :: 2-D array for mask at South points
                0111 C  iMin,iMax,    :: loop range for called routines
                0112 C  jMin,jMax     :: loop range for called routines
f12f84b0ce Jean*0113 C [iMin,iMax]Upd :: loop range to update sea-ice field
                0114 C [jMin,jMax]Upd :: loop range to update sea-ice field
03105a7583 Mart*0115 C  i,j,k         :: loop indices
0d75a51072 Mart*0116 C advectionScheme:: local copy of routine argument advectionSchArg
03105a7583 Mart*0117 C  af            :: 2-D array for horizontal advective flux
f12f84b0ce Jean*0118 C  localTij      :: 2-D array, temporary local copy of sea-ice fld
03105a7583 Mart*0119 C  calc_fluxes_X :: logical to indicate to calculate fluxes in X dir
                0120 C  calc_fluxes_Y :: logical to indicate to calculate fluxes in Y dir
                0121 C  interiorOnly  :: only update the interior of myTile, but not the edges
                0122 C  overlapOnly   :: only update the edges of myTile, but not the interior
                0123 C  nipass        :: number of passes in multi-dimensional method
                0124 C  ipass         :: number of the current pass being made
f12f84b0ce Jean*0125 C  myTile        :: variables used to determine which cube face
03105a7583 Mart*0126 C  nCFace        :: owns a tile for cube grid runs using
                0127 C                :: multi-dim advection.
                0128 C [N,S,E,W]_edge :: true if N,S,E,W edge of myTile is an Edge of the cube
2264082a04 Jean*0129 C     msgBuf     :: Informational/error message buffer
03105a7583 Mart*0130       _RS maskLocW(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
                0131       _RS maskLocS(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
                0132       INTEGER iMin,iMax,jMin,jMax
                0133       INTEGER iMinUpd,iMaxUpd,jMinUpd,jMaxUpd
                0134       INTEGER i,j,k
0d75a51072 Mart*0135       INTEGER advectionScheme
03105a7583 Mart*0136       _RL af      (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
                0137       _RL localTij(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
                0138       LOGICAL calc_fluxes_X, calc_fluxes_Y, withSigns
                0139       LOGICAL interiorOnly, overlapOnly
                0140       INTEGER nipass,ipass
                0141       INTEGER nCFace
                0142       LOGICAL N_edge, S_edge, E_edge, W_edge
2264082a04 Jean*0143       CHARACTER*(MAX_LEN_MBUF) msgBuf
03105a7583 Mart*0144 #ifdef ALLOW_EXCH2
                0145       INTEGER myTile
                0146 #endif
                0147 #ifdef ALLOW_DIAGNOSTICS
                0148       CHARACTER*8 diagName
37de51ebf5 Mart*0149       CHARACTER*4 SEAICE_DIAG_SUFX, diagSufx
                0150       EXTERNAL    SEAICE_DIAG_SUFX
03105a7583 Mart*0151 #endif
f12f84b0ce Jean*0152       LOGICAL dBug
23142459d0 Jean*0153       INTEGER ioUnit
f12f84b0ce Jean*0154       _RL tmpFac
7c50f07931 Mart*0155 #ifdef ALLOW_AUTODIFF_TAMC
edb6656069 Mart*0156 C     tkey :: tape key (depends on tracer and tile indices)
                0157 C     dkey :: tape key (depends on direction and tkey)
                0158       INTEGER tkey, dkey
7c50f07931 Mart*0159 #endif
03105a7583 Mart*0160 CEOP
                0161
0d75a51072 Mart*0162 C     make local copy to be tampered with if necessary
                0163       advectionScheme = advectionSchArg
03105a7583 Mart*0164 #ifdef ALLOW_AUTODIFF_TAMC
edb6656069 Mart*0165       tkey = bi + (bj-1)*nSx + (ikey_dynamics-1)*nSx*nSy
                0166       tkey = tracerIdentity + (tkey-1)*maxpass
7c50f07931 Mart*0167       IF (tracerIdentity.GT.maxpass) THEN
1574069d50 Mart*0168        WRITE(msgBuf,'(A,2I5)')
                0169      &      'SEAICE_ADVECTION: tracerIdentity > maxpass ',
                0170      &      tracerIdentity, maxpass
7c50f07931 Mart*0171        CALL PRINT_ERROR( msgBuf, myThid )
                0172        STOP 'ABNORMAL END: S/R SEAICE_ADVECTION'
                0173       ENDIF
8377b8ee87 Mart*0174 #endif /* ALLOW_AUTODIFF_TAMC */
0d75a51072 Mart*0175 C
8377b8ee87 Mart*0176 #ifdef ALLOW_AUTODIFF
0d75a51072 Mart*0177       IF ( inAdMode .AND. useApproxAdvectionInAdMode ) THEN
                0178 C     In AD-mode, we change non-linear, potentially unstable AD advection
                0179 C     schemes to linear schemes with more stability. So far only DST3 with
                0180 C     flux limiting is replaced by DST3 without flux limiting, but any
                0181 C     combination is possible.
                0182        IF ( advectionSchArg.EQ.ENUM_DST3_FLUX_LIMIT )
                0183      &      advectionScheme = ENUM_DST3
                0184 C     here is room for more advection schemes as this becomes necessary
                0185       ENDIF
8377b8ee87 Mart*0186 #endif /* ALLOW_AUTODIFF */
03105a7583 Mart*0187
37de51ebf5 Mart*0188 #ifdef ALLOW_DIAGNOSTICS
                0189 C--   Set diagnostic suffix for the current tracer
                0190       IF ( useDiagnostics ) THEN
                0191         diagSufx = SEAICE_DIAG_SUFX( tracerIdentity, myThid )
                0192       ENDIF
                0193 #endif
03105a7583 Mart*0194
23142459d0 Jean*0195       ioUnit = standardMessageUnit
                0196       dBug = debugLevel.GE.debLevC
f12f84b0ce Jean*0197      &     .AND. myIter.EQ.nIter0
                0198      &     .AND. ( tracerIdentity.EQ.GAD_HEFF .OR.
                0199      &             tracerIdentity.EQ.GAD_QICE2 )
                0200 c    &     .AND. tracerIdentity.EQ.GAD_HEFF
                0201
03105a7583 Mart*0202 C--   Set up work arrays with valid (i.e. not NaN) values
                0203 C     These inital values do not alter the numerical results. They
                0204 C     just ensure that all memory references are to valid floating
                0205 C     point numbers. This prevents spurious hardware signals due to
                0206 C     uninitialised but inert locations.
8377b8ee87 Mart*0207 #ifdef ALLOW_AUTODIFF
03105a7583 Mart*0208       DO j=1-OLy,sNy+OLy
                0209        DO i=1-OLx,sNx+OLx
                0210         localTij(i,j) = 0. _d 0
                0211        ENDDO
                0212       ENDDO
f12f84b0ce Jean*0213 #endif
03105a7583 Mart*0214
                0215 C--   Set tile-specific parameters for horizontal fluxes
                0216       IF (useCubedSphereExchange) THEN
                0217        nipass=3
                0218 #ifdef ALLOW_EXCH2
c424ee7cc7 Jean*0219        myTile = W2_myTileList(bi,bj)
03105a7583 Mart*0220        nCFace = exch2_myFace(myTile)
                0221        N_edge = exch2_isNedge(myTile).EQ.1
                0222        S_edge = exch2_isSedge(myTile).EQ.1
                0223        E_edge = exch2_isEedge(myTile).EQ.1
                0224        W_edge = exch2_isWedge(myTile).EQ.1
                0225 #else
                0226        nCFace = bi
                0227        N_edge = .TRUE.
                0228        S_edge = .TRUE.
                0229        E_edge = .TRUE.
                0230        W_edge = .TRUE.
                0231 #endif
                0232       ELSE
                0233        nipass=2
                0234        nCFace = bi
                0235        N_edge = .FALSE.
                0236        S_edge = .FALSE.
                0237        E_edge = .FALSE.
                0238        W_edge = .FALSE.
                0239       ENDIF
                0240
                0241       iMin = 1-OLx
                0242       iMax = sNx+OLx
                0243       jMin = 1-OLy
                0244       jMax = sNy+OLy
1574069d50 Mart*0245 #ifdef ALLOW_AUTODIFF_TAMC
                0246       IF ( nipass.GT.maxcube ) THEN
                0247          WRITE(msgBuf,'(A,2(I3,A))') 'S/R SEAICE_ADVECTION: nipass =',
                0248      &     nipass, ' >', maxcube, ' = maxcube, ==> check "tamc.h"'
                0249          CALL PRINT_ERROR( msgBuf, myThid )
                0250          STOP 'ABNORMAL END: S/R SEAICE_ADVECTION'
                0251       ENDIF
                0252 #endif /* ALLOW_AUTODIFF_TAMC */
03105a7583 Mart*0253
                0254       k = 1
f12f84b0ce Jean*0255 C--   Start of k loop for horizontal fluxes
                0256 #ifdef ALLOW_AUTODIFF_TAMC
                0257 CADJ STORE iceFld =
edb6656069 Mart*0258 CADJ &     comlev1_bibj_k_gadice, key=tkey, byte=isbyte
03105a7583 Mart*0259 #endif /* ALLOW_AUTODIFF_TAMC */
                0260
                0261 C     Content of CALC_COMMON_FACTORS, adapted for 2D fields
                0262 C--   Get temporary terms used by tendency routines
                0263
f12f84b0ce Jean*0264 C--   Make local copy of sea-ice field and mask West & South
03105a7583 Mart*0265       DO j=1-OLy,sNy+OLy
                0266        DO i=1-OLx,sNx+OLx
6299430b39 Jean*0267          localTij(i,j)=iceFld(i,j)
                0268 #ifdef ALLOW_OBCS
ec0d7df165 Mart*0269          maskLocW(i,j) = SIMaskU(i,j,bi,bj)*maskInW(i,j,bi,bj)
                0270          maskLocS(i,j) = SIMaskV(i,j,bi,bj)*maskInS(i,j,bi,bj)
6299430b39 Jean*0271 #else /* ALLOW_OBCS */
ec0d7df165 Mart*0272          maskLocW(i,j) = SIMaskU(i,j,bi,bj)
                0273          maskLocS(i,j) = SIMaskV(i,j,bi,bj)
6299430b39 Jean*0274 #endif /* ALLOW_OBCS */
03105a7583 Mart*0275        ENDDO
                0276       ENDDO
f12f84b0ce Jean*0277
8377b8ee87 Mart*0278 #ifdef ALLOW_AUTODIFF
f12f84b0ce Jean*0279 C-     Initialise Advective flux in X & Y
                0280        DO j=1-OLy,sNy+OLy
                0281         DO i=1-OLx,sNx+OLx
                0282          afx(i,j) = 0.
                0283          afy(i,j) = 0.
                0284         ENDDO
                0285        ENDDO
                0286 #endif
                0287
24fb6044b7 Patr*0288 cph-exch2#ifndef ALLOW_AUTODIFF_TAMC
03105a7583 Mart*0289       IF (useCubedSphereExchange) THEN
                0290        withSigns = .FALSE.
f12f84b0ce Jean*0291        CALL FILL_CS_CORNER_UV_RS(
03105a7583 Mart*0292      &      withSigns, maskLocW,maskLocS, bi,bj, myThid )
                0293       ENDIF
24fb6044b7 Patr*0294 cph-exch2#endif
03105a7583 Mart*0295
                0296 C--   Multiple passes for different directions on different tiles
                0297 C--   For cube need one pass for each of red, green and blue axes.
                0298       DO ipass=1,nipass
                0299 #ifdef ALLOW_AUTODIFF_TAMC
edb6656069 Mart*0300        dkey = ipass + (tkey-1)*maxcube
03105a7583 Mart*0301 #endif /* ALLOW_AUTODIFF_TAMC */
                0302
                0303        interiorOnly = .FALSE.
                0304        overlapOnly  = .FALSE.
                0305        IF (useCubedSphereExchange) THEN
f12f84b0ce Jean*0306 C--   CubedSphere : pass 3 times, with partial update of local seaice field
03105a7583 Mart*0307         IF (ipass.EQ.1) THEN
                0308          overlapOnly  = MOD(nCFace,3).EQ.0
                0309          interiorOnly = MOD(nCFace,3).NE.0
                0310          calc_fluxes_X = nCFace.EQ.6 .OR. nCFace.EQ.1 .OR. nCFace.EQ.2
                0311          calc_fluxes_Y = nCFace.EQ.3 .OR. nCFace.EQ.4 .OR. nCFace.EQ.5
                0312         ELSEIF (ipass.EQ.2) THEN
                0313          overlapOnly  = MOD(nCFace,3).EQ.2
                0314          calc_fluxes_X = nCFace.EQ.2 .OR. nCFace.EQ.3 .OR. nCFace.EQ.4
                0315          calc_fluxes_Y = nCFace.EQ.5 .OR. nCFace.EQ.6 .OR. nCFace.EQ.1
                0316         ELSE
                0317          calc_fluxes_X = nCFace.EQ.5 .OR. nCFace.EQ.6
                0318          calc_fluxes_Y = nCFace.EQ.2 .OR. nCFace.EQ.3
                0319         ENDIF
                0320        ELSE
                0321 C--   not CubedSphere
                0322         calc_fluxes_X = MOD(ipass,2).EQ.1
                0323         calc_fluxes_Y = .NOT.calc_fluxes_X
                0324        ENDIF
23142459d0 Jean*0325        IF (dBug.AND.bi.EQ.3 ) WRITE(ioUnit,*)'ICE_adv:',tracerIdentity,
f12f84b0ce Jean*0326      &   ipass,calc_fluxes_X,calc_fluxes_Y,overlapOnly,interiorOnly
                0327
03105a7583 Mart*0328 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0329 C--   X direction
f12f84b0ce Jean*0330
03105a7583 Mart*0331 #ifdef ALLOW_AUTODIFF_TAMC
edb6656069 Mart*0332 CADJ STORE localTij(:,:) =
                0333 CADJ &     comlev1_bibj_k_gadice_pass, key=dkey, byte=isbyte
b989892ba6 Patr*0334 # ifndef DISABLE_MULTIDIM_ADVECTION
edb6656069 Mart*0335 CADJ STORE af(:,:) =
                0336 CADJ &     comlev1_bibj_k_gadice_pass, key=dkey, byte=isbyte
b989892ba6 Patr*0337 # endif
03105a7583 Mart*0338 #endif /* ALLOW_AUTODIFF_TAMC */
                0339 C
                0340        IF (calc_fluxes_X) THEN
f12f84b0ce Jean*0341
03105a7583 Mart*0342 C-     Do not compute fluxes if
f12f84b0ce Jean*0343 C       a) needed in overlap only
03105a7583 Mart*0344 C   and b) the overlap of myTile are not cube-face Edges
                0345         IF ( .NOT.overlapOnly .OR. N_edge .OR. S_edge ) THEN
                0346
f12f84b0ce Jean*0347 C-     Advective flux in X
2264082a04 Jean*0348          DO j=1-OLy,sNy+OLy
                0349           DO i=1-OLx,sNx+OLx
f12f84b0ce Jean*0350            af(i,j) = 0.
                0351           ENDDO
                0352          ENDDO
                0353
24fb6044b7 Patr*0354 cph-exch2#ifndef ALLOW_AUTODIFF_TAMC
03105a7583 Mart*0355 C-     Internal exchange for calculations in X
                0356          IF ( useCubedSphereExchange .AND.
                0357      &      ( overlapOnly .OR. ipass.EQ.1 ) ) THEN
93e3461d85 Jean*0358           CALL FILL_CS_CORNER_TR_RL( 1, .FALSE.,
1891130b05 Jean*0359      &                               localTij, bi,bj, myThid )
03105a7583 Mart*0360          ENDIF
24fb6044b7 Patr*0361 cph-exch2#endif
03105a7583 Mart*0362
                0363 #ifdef ALLOW_AUTODIFF_TAMC
                0364 # ifndef DISABLE_MULTIDIM_ADVECTION
f12f84b0ce Jean*0365 CADJ STORE localTij(:,:)  =
edb6656069 Mart*0366 CADJ &     comlev1_bibj_k_gadice_pass, key=dkey, byte=isbyte
03105a7583 Mart*0367 # endif
                0368 #endif /* ALLOW_AUTODIFF_TAMC */
                0369
                0370          IF ( advectionScheme.EQ.ENUM_UPWIND_1RST
                0371      &        .OR. advectionScheme.EQ.ENUM_DST2 ) THEN
692dd30681 Jean*0372           CALL GAD_DST2U1_ADV_X( bi,bj,k, advectionScheme, .TRUE.,
                0373      I         SEAICE_deltaTtherm, uTrans, uFld, localTij,
03105a7583 Mart*0374      O         af, myThid )
72f0014384 Jean*0375           IF ( dBug .AND. bi.EQ.3 ) THEN
                0376             i=MIN(12,sNx)
                0377             j=MIN(11,sNy)
23142459d0 Jean*0378             WRITE(ioUnit,'(A,1P4E14.6)') 'ICE_adv: xFx=', af(i+1,j),
72f0014384 Jean*0379      &        localTij(i,j), uTrans(i+1,j), af(i+1,j)/uTrans(i+1,j)
                0380           ENDIF
0d75a51072 Mart*0381          ELSEIF ( advectionScheme.EQ.ENUM_FLUX_LIMIT ) THEN
692dd30681 Jean*0382           CALL GAD_FLUXLIMIT_ADV_X( bi,bj,k, .TRUE.,
                0383      I         SEAICE_deltaTtherm, uTrans, uFld, maskLocW, localTij,
03105a7583 Mart*0384      O         af, myThid )
0d75a51072 Mart*0385          ELSEIF ( advectionScheme.EQ.ENUM_DST3 ) THEN
692dd30681 Jean*0386           CALL GAD_DST3_ADV_X(      bi,bj,k, .TRUE.,
                0387      I         SEAICE_deltaTtherm, uTrans, uFld, maskLocW, localTij,
03105a7583 Mart*0388      O         af, myThid )
0d75a51072 Mart*0389          ELSEIF ( advectionScheme.EQ.ENUM_DST3_FLUX_LIMIT ) THEN
692dd30681 Jean*0390           CALL GAD_DST3FL_ADV_X(    bi,bj,k, .TRUE.,
                0391      I         SEAICE_deltaTtherm, uTrans, uFld, maskLocW, localTij,
03105a7583 Mart*0392      O         af, myThid )
0d75a51072 Mart*0393          ELSEIF ( advectionScheme.EQ.ENUM_OS7MP ) THEN
72f0014384 Jean*0394           CALL GAD_OS7MP_ADV_X(     bi,bj,k, .TRUE.,
b227b62e2b Mart*0395      I         SEAICE_deltaTtherm, uTrans, uFld, maskLocW, localTij,
                0396      O         af, myThid )
598aebfcee Mart*0397 #ifndef ALLOW_AUTODIFF
0d75a51072 Mart*0398          ELSEIF ( advectionScheme.EQ.ENUM_PPM_NULL_LIMIT  .OR.
                0399      &            advectionScheme.EQ.ENUM_PPM_MONO_LIMIT  .OR.
                0400      &            advectionScheme.EQ.ENUM_PPM_WENO_LIMIT ) THEN
83ddf5a6c6 Mart*0401           CALL GAD_PPM_ADV_X( advectionScheme, bi, bj, k , .TRUE.,
                0402      I         SEAICE_deltaTtherm, uFld, uTrans, localTij,
                0403      O         af, myThid )
0d75a51072 Mart*0404          ELSEIF ( advectionScheme.EQ.ENUM_PQM_NULL_LIMIT  .OR.
                0405      &            advectionScheme.EQ.ENUM_PQM_MONO_LIMIT  .OR.
                0406      &            advectionScheme.EQ.ENUM_PQM_WENO_LIMIT ) THEN
83ddf5a6c6 Mart*0407           CALL GAD_PQM_ADV_X( advectionScheme, bi, bj, k , .TRUE.,
                0408      I         SEAICE_deltaTtherm, uFld, uTrans, localTij,
                0409      O         af, myThid )
b227b62e2b Mart*0410 #endif
03105a7583 Mart*0411          ELSE
f2f222dd0d Patr*0412            WRITE(msgBuf,'(A,I3,A)')
                0413      &      'SEAICE_ADVECTION: adv. scheme ', advectionScheme,
                0414      &      ' incompatibale with multi-dim. adv.'
                0415            CALL PRINT_ERROR( msgBuf, myThid )
                0416            STOP 'ABNORMAL END: S/R SEAICE_ADVECTION'
03105a7583 Mart*0417          ENDIF
f12f84b0ce Jean*0418
03105a7583 Mart*0419 C--   Advective flux in X : done
                0420         ENDIF
f12f84b0ce Jean*0421
24fb6044b7 Patr*0422 cph-exch2#ifndef ALLOW_AUTODIFF_TAMC
03105a7583 Mart*0423 C--   Internal exchange for next calculations in Y
                0424         IF ( overlapOnly .AND. ipass.EQ.1 ) THEN
93e3461d85 Jean*0425          CALL FILL_CS_CORNER_TR_RL( 2, .FALSE.,
1891130b05 Jean*0426      &                              localTij, bi,bj, myThid )
03105a7583 Mart*0427         ENDIF
24fb6044b7 Patr*0428 cph-exch2#endif
03105a7583 Mart*0429
f12f84b0ce Jean*0430 C-     Update the local seaice field where needed:
03105a7583 Mart*0431
                0432 C     update in overlap-Only
                0433         IF ( overlapOnly ) THEN
f12f84b0ce Jean*0434          iMinUpd = 1-OLx+1
                0435          iMaxUpd = sNx+OLx-1
                0436 C--   notes: these 2 lines below have no real effect (because recip_hFac=0
03105a7583 Mart*0437 C            in corner region) but safer to keep them.
                0438          IF ( W_edge ) iMinUpd = 1
                0439          IF ( E_edge ) iMaxUpd = sNx
f12f84b0ce Jean*0440
                0441          IF ( S_edge .AND. extensiveFld ) THEN
                0442           DO j=1-OLy,0
03105a7583 Mart*0443            DO i=iMinUpd,iMaxUpd
f12f84b0ce Jean*0444             localTij(i,j)=localTij(i,j)
e8c00a82b3 Jean*0445      &         -SEAICE_deltaTtherm*maskInC(i,j,bi,bj)
03105a7583 Mart*0446      &           *recip_rA(i,j,bi,bj)
f12f84b0ce Jean*0447      &           *(  af(i+1,j)-af(i,j)
                0448      &            )
                0449            ENDDO
                0450           ENDDO
                0451          ELSEIF ( S_edge ) THEN
                0452           DO j=1-OLy,0
                0453            DO i=iMinUpd,iMaxUpd
                0454             localTij(i,j)=localTij(i,j)
e8c00a82b3 Jean*0455      &         -SEAICE_deltaTtherm*maskInC(i,j,bi,bj)
f12f84b0ce Jean*0456      &           *recip_rA(i,j,bi,bj)*r_hFld(i,j)
                0457      &           *( (af(i+1,j)-af(i,j))
                0458      &             -(uTrans(i+1,j)-uTrans(i,j))*iceFld(i,j)
                0459      &            )
03105a7583 Mart*0460            ENDDO
                0461           ENDDO
                0462          ENDIF
f12f84b0ce Jean*0463          IF ( N_edge .AND. extensiveFld ) THEN
                0464           DO j=sNy+1,sNy+OLy
03105a7583 Mart*0465            DO i=iMinUpd,iMaxUpd
f12f84b0ce Jean*0466             localTij(i,j)=localTij(i,j)
e8c00a82b3 Jean*0467      &         -SEAICE_deltaTtherm*maskInC(i,j,bi,bj)
03105a7583 Mart*0468      &           *recip_rA(i,j,bi,bj)
f12f84b0ce Jean*0469      &           *(  af(i+1,j)-af(i,j)
                0470      &            )
                0471            ENDDO
                0472           ENDDO
                0473          ELSEIF ( N_edge ) THEN
                0474           DO j=sNy+1,sNy+OLy
                0475            DO i=iMinUpd,iMaxUpd
                0476             localTij(i,j)=localTij(i,j)
e8c00a82b3 Jean*0477      &         -SEAICE_deltaTtherm*maskInC(i,j,bi,bj)
f12f84b0ce Jean*0478      &           *recip_rA(i,j,bi,bj)*r_hFld(i,j)
                0479      &           *( (af(i+1,j)-af(i,j))
                0480      &             -(uTrans(i+1,j)-uTrans(i,j))*iceFld(i,j)
                0481      &            )
03105a7583 Mart*0482            ENDDO
                0483           ENDDO
                0484          ENDIF
f12f84b0ce Jean*0485 C--   keep advective flux (for diagnostics)
                0486          IF ( S_edge ) THEN
                0487           DO j=1-OLy,0
                0488            DO i=1-OLx+1,sNx+OLx
                0489             afx(i,j) = af(i,j)
                0490            ENDDO
                0491           ENDDO
                0492          ENDIF
                0493          IF ( N_edge ) THEN
                0494           DO j=sNy+1,sNy+OLy
                0495            DO i=1-OLx+1,sNx+OLx
                0496             afx(i,j) = af(i,j)
                0497            ENDDO
                0498           ENDDO
                0499          ENDIF
                0500
03105a7583 Mart*0501         ELSE
                0502 C     do not only update the overlap
f12f84b0ce Jean*0503          jMinUpd = 1-OLy
                0504          jMaxUpd = sNy+OLy
03105a7583 Mart*0505          IF ( interiorOnly .AND. S_edge ) jMinUpd = 1
                0506          IF ( interiorOnly .AND. N_edge ) jMaxUpd = sNy
f12f84b0ce Jean*0507          IF ( extensiveFld ) THEN
                0508           DO j=jMinUpd,jMaxUpd
                0509            DO i=1-OLx+1,sNx+OLx-1
                0510             localTij(i,j)=localTij(i,j)
e8c00a82b3 Jean*0511      &         -SEAICE_deltaTtherm*maskInC(i,j,bi,bj)
f12f84b0ce Jean*0512      &           *recip_rA(i,j,bi,bj)
                0513      &           *(  af(i+1,j)-af(i,j)
                0514      &            )
                0515            ENDDO
03105a7583 Mart*0516           ENDDO
f12f84b0ce Jean*0517          ELSE
                0518           DO j=jMinUpd,jMaxUpd
                0519            DO i=1-OLx+1,sNx+OLx-1
                0520             localTij(i,j)=localTij(i,j)
e8c00a82b3 Jean*0521      &         -SEAICE_deltaTtherm*maskInC(i,j,bi,bj)
f12f84b0ce Jean*0522      &           *recip_rA(i,j,bi,bj)*r_hFld(i,j)
                0523      &           *( (af(i+1,j)-af(i,j))
                0524      &             -(uTrans(i+1,j)-uTrans(i,j))*iceFld(i,j)
                0525      &            )
                0526            ENDDO
03105a7583 Mart*0527           ENDDO
f12f84b0ce Jean*0528          ENDIF
                0529 C--   keep advective flux (for diagnostics)
                0530          DO j=jMinUpd,jMaxUpd
                0531            DO i=1-OLx+1,sNx+OLx
                0532             afx(i,j) = af(i,j)
                0533            ENDDO
03105a7583 Mart*0534          ENDDO
                0535
                0536 C-     end if/else update overlap-Only
                0537         ENDIF
f12f84b0ce Jean*0538
03105a7583 Mart*0539 C--   End of X direction
                0540        ENDIF
f12f84b0ce Jean*0541
03105a7583 Mart*0542 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0543 C--   Y direction
f12f84b0ce Jean*0544
03105a7583 Mart*0545 #ifdef ALLOW_AUTODIFF_TAMC
b989892ba6 Patr*0546 # ifndef DISABLE_MULTIDIM_ADVECTION
f12f84b0ce Jean*0547 CADJ STORE localTij(:,:)  =
edb6656069 Mart*0548 CADJ &     comlev1_bibj_k_gadice_pass, key=dkey, byte=isbyte
f12f84b0ce Jean*0549 CADJ STORE af(:,:)  =
edb6656069 Mart*0550 CADJ &     comlev1_bibj_k_gadice_pass, key=dkey, byte=isbyte
b989892ba6 Patr*0551 # endif
03105a7583 Mart*0552 #endif /* ALLOW_AUTODIFF_TAMC */
f12f84b0ce Jean*0553
03105a7583 Mart*0554        IF (calc_fluxes_Y) THEN
                0555
                0556 C-     Do not compute fluxes if
                0557 C       a) needed in overlap only
                0558 C   and b) the overlap of myTile are not cube-face edges
                0559         IF ( .NOT.overlapOnly .OR. E_edge .OR. W_edge ) THEN
                0560
f12f84b0ce Jean*0561 C-     Advective flux in Y
                0562          DO j=1-OLy,sNy+OLy
                0563           DO i=1-OLx,sNx+OLx
                0564            af(i,j) = 0.
                0565           ENDDO
                0566          ENDDO
                0567
24fb6044b7 Patr*0568 cph-exch2#ifndef ALLOW_AUTODIFF_TAMC
03105a7583 Mart*0569 C-     Internal exchange for calculations in Y
                0570          IF ( useCubedSphereExchange .AND.
                0571      &      ( overlapOnly .OR. ipass.EQ.1 ) ) THEN
93e3461d85 Jean*0572           CALL FILL_CS_CORNER_TR_RL( 2, .FALSE.,
1891130b05 Jean*0573      &                               localTij, bi,bj, myThid )
03105a7583 Mart*0574          ENDIF
24fb6044b7 Patr*0575 cph-exch2#endif
03105a7583 Mart*0576
f12f84b0ce Jean*0577 #ifdef ALLOW_AUTODIFF_TAMC
0d75a51072 Mart*0578 # ifndef DISABLE_MULTIDIM_ADVECTION
f12f84b0ce Jean*0579 CADJ STORE localTij(:,:)  =
edb6656069 Mart*0580 CADJ &     comlev1_bibj_k_gadice_pass, key=dkey, byte=isbyte
0d75a51072 Mart*0581 # endif
03105a7583 Mart*0582 #endif /* ALLOW_AUTODIFF_TAMC */
                0583
                0584          IF ( advectionScheme.EQ.ENUM_UPWIND_1RST
                0585      &        .OR. advectionScheme.EQ.ENUM_DST2 ) THEN
692dd30681 Jean*0586           CALL GAD_DST2U1_ADV_Y( bi,bj,k, advectionScheme, .TRUE.,
                0587      I         SEAICE_deltaTtherm, vTrans, vFld, localTij,
03105a7583 Mart*0588      O         af, myThid )
72f0014384 Jean*0589           IF ( dBug .AND. bi.EQ.3 ) THEN
                0590             i=MIN(12,sNx)
                0591             j=MIN(11,sNy)
23142459d0 Jean*0592             WRITE(ioUnit,'(A,1P4E14.6)') 'ICE_adv: yFx=', af(i,j+1),
72f0014384 Jean*0593      &        localTij(i,j), vTrans(i,j+1), af(i,j+1)/vTrans(i,j+1)
                0594           ENDIF
0d75a51072 Mart*0595          ELSEIF ( advectionScheme.EQ.ENUM_FLUX_LIMIT ) THEN
692dd30681 Jean*0596           CALL GAD_FLUXLIMIT_ADV_Y( bi,bj,k, .TRUE.,
                0597      I         SEAICE_deltaTtherm, vTrans, vFld, maskLocS, localTij,
03105a7583 Mart*0598      O         af, myThid )
0d75a51072 Mart*0599          ELSEIF( advectionScheme.EQ.ENUM_DST3 ) THEN
692dd30681 Jean*0600           CALL GAD_DST3_ADV_Y(      bi,bj,k, .TRUE.,
                0601      I         SEAICE_deltaTtherm, vTrans, vFld, maskLocS, localTij,
03105a7583 Mart*0602      O         af, myThid )
0d75a51072 Mart*0603          ELSEIF ( advectionScheme.EQ.ENUM_DST3_FLUX_LIMIT ) THEN
692dd30681 Jean*0604           CALL GAD_DST3FL_ADV_Y(    bi,bj,k, .TRUE.,
                0605      I         SEAICE_deltaTtherm, vTrans, vFld, maskLocS, localTij,
03105a7583 Mart*0606      O         af, myThid )
0d75a51072 Mart*0607          ELSEIF ( advectionScheme.EQ.ENUM_OS7MP ) THEN
b227b62e2b Mart*0608           CALL GAD_OS7MP_ADV_Y(     bi,bj,k, .TRUE.,
                0609      I         SEAICE_deltaTtherm, vTrans, vFld, maskLocS, localTij,
                0610      O         af, myThid )
598aebfcee Mart*0611 #ifndef ALLOW_AUTODIFF
0d75a51072 Mart*0612          ELSEIF ( advectionScheme.EQ.ENUM_PPM_NULL_LIMIT  .OR.
                0613      &            advectionScheme.EQ.ENUM_PPM_MONO_LIMIT  .OR.
                0614      &            advectionScheme.EQ.ENUM_PPM_WENO_LIMIT ) THEN
83ddf5a6c6 Mart*0615           CALL GAD_PPM_ADV_Y( advectionScheme, bi, bj, k , .TRUE.,
                0616      I         SEAICE_deltaTtherm, vFld, vTrans, localTij,
                0617      O         af, myThid )
0d75a51072 Mart*0618          ELSEIF ( advectionScheme.EQ.ENUM_PQM_NULL_LIMIT  .OR.
                0619      &            advectionScheme.EQ.ENUM_PQM_MONO_LIMIT  .OR.
                0620      &            advectionScheme.EQ.ENUM_PQM_WENO_LIMIT ) THEN
83ddf5a6c6 Mart*0621           CALL GAD_PQM_ADV_Y( advectionScheme, bi, bj, k , .TRUE.,
                0622      I         SEAICE_deltaTtherm, vFld, vTrans, localTij,
                0623      O         af, myThid )
b227b62e2b Mart*0624 #endif
03105a7583 Mart*0625          ELSE
f2f222dd0d Patr*0626            WRITE(msgBuf,'(A,I3,A)')
                0627      &      'SEAICE_ADVECTION: adv. scheme ', advectionScheme,
                0628      &      ' incompatibale with multi-dim. adv.'
                0629            CALL PRINT_ERROR( msgBuf, myThid )
                0630            STOP 'ABNORMAL END: S/R SEAICE_ADVECTION'
03105a7583 Mart*0631          ENDIF
                0632
                0633 C-     Advective flux in Y : done
                0634         ENDIF
                0635
24fb6044b7 Patr*0636 cph-exch2#ifndef ALLOW_AUTODIFF_TAMC
03105a7583 Mart*0637 C-     Internal exchange for next calculations in X
                0638         IF ( overlapOnly .AND. ipass.EQ.1 ) THEN
93e3461d85 Jean*0639          CALL FILL_CS_CORNER_TR_RL( 1, .FALSE.,
1891130b05 Jean*0640      &                              localTij, bi,bj, myThid )
03105a7583 Mart*0641         ENDIF
24fb6044b7 Patr*0642 cph-exch2#endif
03105a7583 Mart*0643
f12f84b0ce Jean*0644 C-     Update the local seaice field where needed:
03105a7583 Mart*0645
                0646 C      update in overlap-Only
                0647         IF ( overlapOnly ) THEN
f12f84b0ce Jean*0648          jMinUpd = 1-OLy+1
                0649          jMaxUpd = sNy+OLy-1
                0650 C- notes: these 2 lines below have no real effect (because recip_hFac=0
03105a7583 Mart*0651 C         in corner region) but safer to keep them.
                0652          IF ( S_edge ) jMinUpd = 1
                0653          IF ( N_edge ) jMaxUpd = sNy
f12f84b0ce Jean*0654
                0655          IF ( W_edge .AND. extensiveFld ) THEN
03105a7583 Mart*0656           DO j=jMinUpd,jMaxUpd
f12f84b0ce Jean*0657            DO i=1-OLx,0
                0658             localTij(i,j)=localTij(i,j)
e8c00a82b3 Jean*0659      &         -SEAICE_deltaTtherm*maskInC(i,j,bi,bj)
03105a7583 Mart*0660      &           *recip_rA(i,j,bi,bj)
f12f84b0ce Jean*0661      &           *(  af(i,j+1)-af(i,j)
                0662      &            )
                0663            ENDDO
                0664           ENDDO
                0665          ELSEIF ( W_edge ) THEN
                0666           DO j=jMinUpd,jMaxUpd
                0667            DO i=1-OLx,0
                0668             localTij(i,j)=localTij(i,j)
e8c00a82b3 Jean*0669      &         -SEAICE_deltaTtherm*maskInC(i,j,bi,bj)
f12f84b0ce Jean*0670      &           *recip_rA(i,j,bi,bj)*r_hFld(i,j)
                0671      &           *( (af(i,j+1)-af(i,j))
                0672      &             -(vTrans(i,j+1)-vTrans(i,j))*iceFld(i,j)
                0673      &            )
03105a7583 Mart*0674            ENDDO
                0675           ENDDO
                0676          ENDIF
f12f84b0ce Jean*0677          IF ( E_edge .AND. extensiveFld ) THEN
03105a7583 Mart*0678           DO j=jMinUpd,jMaxUpd
f12f84b0ce Jean*0679            DO i=sNx+1,sNx+OLx
                0680             localTij(i,j)=localTij(i,j)
e8c00a82b3 Jean*0681      &         -SEAICE_deltaTtherm*maskInC(i,j,bi,bj)
03105a7583 Mart*0682      &           *recip_rA(i,j,bi,bj)
f12f84b0ce Jean*0683      &           *(  af(i,j+1)-af(i,j)
                0684      &            )
                0685            ENDDO
                0686           ENDDO
                0687          ELSEIF ( E_edge ) THEN
                0688           DO j=jMinUpd,jMaxUpd
                0689            DO i=sNx+1,sNx+OLx
                0690             localTij(i,j)=localTij(i,j)
e8c00a82b3 Jean*0691      &         -SEAICE_deltaTtherm*maskInC(i,j,bi,bj)
f12f84b0ce Jean*0692      &           *recip_rA(i,j,bi,bj)*r_hFld(i,j)
                0693      &           *( (af(i,j+1)-af(i,j))
                0694      &             -(vTrans(i,j+1)-vTrans(i,j))*iceFld(i,j)
                0695      &            )
03105a7583 Mart*0696            ENDDO
                0697           ENDDO
                0698          ENDIF
f12f84b0ce Jean*0699 C--   keep advective flux (for diagnostics)
                0700          IF ( W_edge ) THEN
                0701           DO j=1-OLy+1,sNy+OLy
                0702            DO i=1-OLx,0
                0703             afy(i,j) = af(i,j)
                0704            ENDDO
                0705           ENDDO
                0706          ENDIF
                0707          IF ( E_edge ) THEN
                0708           DO j=1-OLy+1,sNy+OLy
                0709            DO i=sNx+1,sNx+OLx
                0710             afy(i,j) = af(i,j)
                0711            ENDDO
                0712           ENDDO
                0713          ENDIF
                0714
03105a7583 Mart*0715         ELSE
                0716 C     do not only update the overlap
f12f84b0ce Jean*0717          iMinUpd = 1-OLx
                0718          iMaxUpd = sNx+OLx
03105a7583 Mart*0719          IF ( interiorOnly .AND. W_edge ) iMinUpd = 1
                0720          IF ( interiorOnly .AND. E_edge ) iMaxUpd = sNx
f12f84b0ce Jean*0721          IF ( extensiveFld ) THEN
                0722           DO j=1-OLy+1,sNy+OLy-1
                0723            DO i=iMinUpd,iMaxUpd
                0724             localTij(i,j)=localTij(i,j)
e8c00a82b3 Jean*0725      &         -SEAICE_deltaTtherm*maskInC(i,j,bi,bj)
f12f84b0ce Jean*0726      &           *recip_rA(i,j,bi,bj)
                0727      &           *(  af(i,j+1)-af(i,j)
                0728      &            )
                0729            ENDDO
03105a7583 Mart*0730           ENDDO
f12f84b0ce Jean*0731          ELSE
                0732           DO j=1-OLy+1,sNy+OLy-1
                0733            DO i=iMinUpd,iMaxUpd
                0734             localTij(i,j)=localTij(i,j)
e8c00a82b3 Jean*0735      &         -SEAICE_deltaTtherm*maskInC(i,j,bi,bj)
f12f84b0ce Jean*0736      &           *recip_rA(i,j,bi,bj)*r_hFld(i,j)
                0737      &           *( (af(i,j+1)-af(i,j))
                0738      &             -(vTrans(i,j+1)-vTrans(i,j))*iceFld(i,j)
                0739      &            )
                0740            ENDDO
03105a7583 Mart*0741           ENDDO
f12f84b0ce Jean*0742          ENDIF
                0743 C--   keep advective flux (for diagnostics)
                0744          DO j=1-OLy+1,sNy+OLy
                0745            DO i=iMinUpd,iMaxUpd
                0746             afy(i,j) = af(i,j)
                0747            ENDDO
03105a7583 Mart*0748          ENDDO
                0749
                0750 C      end if/else update overlap-Only
                0751         ENDIF
                0752
                0753 C--   End of Y direction
                0754        ENDIF
                0755
                0756 C--   End of ipass loop
                0757       ENDDO
                0758
f12f84b0ce Jean*0759 C-    explicit advection is done ; store tendency in gFld:
                0760       DO j=1-OLy,sNy+OLy
                0761        DO i=1-OLx,sNx+OLx
2096f95c9b Mart*0762         gFld(i,j)=(localTij(i,j)-iceFld(i,j))/SEAICE_deltaTtherm
03105a7583 Mart*0763        ENDDO
                0764       ENDDO
2096f95c9b Mart*0765       IF ( dBug .AND. bi.EQ.3 ) THEN
72f0014384 Jean*0766        i=MIN(12,sNx)
                0767        j=MIN(11,sNy)
2096f95c9b Mart*0768        tmpFac= SEAICE_deltaTtherm*recip_rA(i,j,bi,bj)
23142459d0 Jean*0769        WRITE(ioUnit,'(A,1P4E14.6)') 'ICE_adv:',
2096f95c9b Mart*0770      &      afx(i,j)*tmpFac,afx(i+1,j)*tmpFac,
                0771      &      afy(i,j)*tmpFac,afy(i,j+1)*tmpFac
                0772       ENDIF
f12f84b0ce Jean*0773
37de51ebf5 Mart*0774 #ifdef ALLOW_DIAGNOSTICS
                0775         IF ( useDiagnostics ) THEN
                0776          diagName = 'ADVx'//diagSufx
                0777          CALL DIAGNOSTICS_FILL(afx,diagName, k,1, 2,bi,bj, myThid)
                0778          diagName = 'ADVy'//diagSufx
                0779          CALL DIAGNOSTICS_FILL(afy,diagName, k,1, 2,bi,bj, myThid)
                0780         ENDIF
                0781 #endif
03105a7583 Mart*0782
                0783 #ifdef ALLOW_DEBUG
be55146c1b Jean*0784       IF ( debugLevel .GE. debLevC
03105a7583 Mart*0785      &     .AND. tracerIdentity.EQ.GAD_HEFF
                0786      &     .AND. k.LE.3 .AND. myIter.EQ.1+nIter0
                0787      &     .AND. nPx.EQ.1 .AND. nPy.EQ.1
                0788      &     .AND. useCubedSphereExchange ) THEN
                0789        CALL DEBUG_CS_CORNER_UV( ' afx,afy from SEAICE_ADVECTION',
                0790      &      afx,afy, k, standardMessageUnit,bi,bj,myThid )
                0791       ENDIF
                0792 #endif /* ALLOW_DEBUG */
                0793
e0fa1cecbf Mart*0794 #endif /* ALLOW_GENERIC_ADVDIFF */
03105a7583 Mart*0795       RETURN
                0796       END