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