Back to home page

MITgcm
 
 

    

File indexing completed on 2025-07-08 05:10:41 UTC

view on githubraw file Latest commit 00c7090d on 2025-07-07 16:10:22 UTC
e874fa47e5 Jean*0001 #include "PACKAGES_CONFIG.h"
                0002 #include "CPP_OPTIONS.h"
                0003 
                0004 C--  File apply_forcing.F:
                0005 C--   Contents
                0006 C--   o APPLY_FORCING_U
                0007 C--   o APPLY_FORCING_V
                0008 C--   o APPLY_FORCING_T
                0009 C--   o APPLY_FORCING_S
                0010 
                0011 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0012 CBOP
                0013 C     !ROUTINE: APPLY_FORCING_U
                0014 C     !INTERFACE:
                0015       SUBROUTINE APPLY_FORCING_U(
                0016      U                     gU_arr,
                0017      I                     iMin,iMax,jMin,jMax, k, bi, bj,
                0018      I                     myTime, myIter, myThid )
                0019 C     !DESCRIPTION: \bv
                0020 C     *==========================================================*
                0021 C     | S/R APPLY_FORCING_U
                0022 C     | o Contains problem specific forcing for zonal velocity.
                0023 C     *==========================================================*
                0024 C     | Adds terms to gU for forcing by external sources
                0025 C     | e.g. wind stress, bottom friction etc ...
                0026 C     *==========================================================*
                0027 C     \ev
                0028 
                0029 C     !USES:
                0030       IMPLICIT NONE
                0031 C     == Global data ==
                0032 #include "SIZE.h"
                0033 #include "EEPARAMS.h"
                0034 #include "PARAMS.h"
                0035 #include "GRID.h"
                0036 #include "DYNVARS.h"
                0037 #include "FFIELDS.h"
                0038 
                0039 C     !INPUT/OUTPUT PARAMETERS:
                0040 C     gU_arr    :: the tendency array
                0041 C     iMin,iMax :: Working range of x-index for applying forcing.
                0042 C     jMin,jMax :: Working range of y-index for applying forcing.
                0043 C     k         :: Current vertical level index
                0044 C     bi,bj     :: Current tile indices
                0045 C     myTime    :: Current time in simulation
                0046 C     myIter    :: Current iteration number
                0047 C     myThid    :: my Thread Id number
                0048       _RL     gU_arr(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
                0049       INTEGER iMin, iMax, jMin, jMax
                0050       INTEGER k, bi, bj
                0051       _RL     myTime
                0052       INTEGER myIter
                0053       INTEGER myThid
                0054 
                0055 C     !LOCAL VARIABLES:
                0056 C     i,j       :: Loop counters
                0057 C     kSurface  :: index of surface level
                0058       INTEGER i, j
                0059 #ifdef USE_OLD_EXTERNAL_FORCING
                0060       _RL     locVar(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
202e12438b Jean*0061       _RL     tmpVar(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
e874fa47e5 Jean*0062 #else
                0063       INTEGER kSurface
5a705ed756 Jean*0064 #endif /* USE_OLD_EXTERNAL_FORCING */
e874fa47e5 Jean*0065 CEOP
                0066 
                0067 #ifdef USE_OLD_EXTERNAL_FORCING
                0068 
                0069       DO j=1-OLy,sNy+OLy
                0070         DO i=1-OLx,sNx+OLx
                0071           locVar(i,j) = gU(i,j,k,bi,bj)
                0072         ENDDO
                0073       ENDDO
                0074       CALL EXTERNAL_FORCING_U(
                0075      I              iMin, iMax, jMin, jMax, bi, bj, k,
                0076      I              myTime, myThid )
202e12438b Jean*0077 C-    Use 2-d local array tmpVar and split loop in 2 parts to avoid compiler
                0078 C     to mess-up this part by re-arranging the order of instructions (wrong
                0079 C     when gU and gU_arr are the same array, i.e., called with argument gU).
e874fa47e5 Jean*0080       DO j=1-OLy,sNy+OLy
                0081         DO i=1-OLx,sNx+OLx
202e12438b Jean*0082           tmpVar(i,j) = gU(i,j,k,bi,bj) - locVar(i,j)
e874fa47e5 Jean*0083           gU(i,j,k,bi,bj) = locVar(i,j)
202e12438b Jean*0084         ENDDO
                0085       ENDDO
aa25968b23 Jean*0086 C-    not needed since APPLY_FORCING_U is no longer called with argument gU
                0087 c     CALL FOOL_THE_COMPILER_RL( tmpVar(1,1) )
202e12438b Jean*0088       DO j=1-OLy,sNy+OLy
                0089         DO i=1-OLx,sNx+OLx
                0090           gU_arr(i,j) = gU_arr(i,j) + tmpVar(i,j)
e874fa47e5 Jean*0091         ENDDO
                0092       ENDDO
                0093 
                0094 #else  /* USE_OLD_EXTERNAL_FORCING */
                0095 
                0096       IF ( fluidIsAir ) THEN
                0097        kSurface = 0
                0098       ELSEIF ( usingPCoords ) THEN
                0099        kSurface = Nr
                0100       ELSE
                0101        kSurface = 1
                0102       ENDIF
                0103 
                0104 C--   Forcing term
                0105 #ifdef ALLOW_AIM
                0106       IF ( useAIM ) CALL AIM_TENDENCY_APPLY_U(
                0107      U                       gU_arr,
                0108      I                       iMin,iMax,jMin,jMax, k, bi,bj,
2c160c3ab4 Jean*0109      I                       myTime, myIter, myThid )
e874fa47e5 Jean*0110 #endif /* ALLOW_AIM */
                0111 
                0112 #ifdef ALLOW_ATM_PHYS
                0113       IF ( useAtm_Phys ) CALL ATM_PHYS_TENDENCY_APPLY_U(
                0114      U                       gU_arr,
                0115      I                       iMin,iMax,jMin,jMax, k, bi,bj,
2c160c3ab4 Jean*0116      I                       myTime, myIter, myThid )
e874fa47e5 Jean*0117 #endif /* ALLOW_ATM_PHYS */
                0118 
                0119 #ifdef ALLOW_FIZHI
                0120       IF ( useFIZHI ) CALL FIZHI_TENDENCY_APPLY_U(
                0121      U                       gU_arr,
                0122      I                       iMin,iMax,jMin,jMax, k, bi,bj,
2c160c3ab4 Jean*0123      I                       myTime, myIter, myThid )
e874fa47e5 Jean*0124 #endif /* ALLOW_FIZHI */
                0125 
614bfb3d2a Jean*0126 C     Add Tidal momentum forcing from 2-d geopotential anomaly
                0127       IF ( momTidalForcing ) THEN
                0128        DO j=0,sNy+1
                0129         DO i=1,sNx+1
                0130           gU_arr(i,j) = gU_arr(i,j)
                0131      &      - recip_dxC(i,j,bi,bj)*recip_deepFacC(k)
                0132      &      * ( phiTide2d(i,j,bi,bj) - phiTide2d(i-1,j,bi,bj) )
                0133      &      *_maskW(i,j,k,bi,bj)
                0134         ENDDO
                0135        ENDDO
                0136       ENDIF
                0137 
e874fa47e5 Jean*0138 C     Ocean: Add momentum surface forcing (e.g., wind-stress) in surface level
                0139       IF ( k .EQ. kSurface ) THEN
                0140 c      DO j=1,sNy
                0141 C-jmc: Without CD-scheme, this is OK ; but with CD-scheme, needs to cover [0:sNy+1]
                0142        DO j=0,sNy+1
                0143         DO i=1,sNx+1
                0144           gU_arr(i,j) = gU_arr(i,j)
                0145      &      +foFacMom*surfaceForcingU(i,j,bi,bj)
                0146      &      *recip_drF(k)*_recip_hFacW(i,j,k,bi,bj)
                0147         ENDDO
                0148        ENDDO
                0149       ELSEIF ( kSurface.EQ.-1 ) THEN
                0150        DO j=0,sNy+1
                0151         DO i=1,sNx+1
                0152          IF ( kSurfW(i,j,bi,bj).EQ.k ) THEN
                0153           gU_arr(i,j) = gU_arr(i,j)
                0154      &      +foFacMom*surfaceForcingU(i,j,bi,bj)
                0155      &      *recip_drF(k)*_recip_hFacW(i,j,k,bi,bj)
                0156          ENDIF
                0157         ENDDO
                0158        ENDDO
                0159       ENDIF
                0160 
                0161 #ifdef ALLOW_EDDYPSI
                0162          CALL TAUEDDY_TENDENCY_APPLY_U(
                0163      U                 gU_arr,
                0164      I                 iMin,iMax,jMin,jMax, k, bi,bj,
2c160c3ab4 Jean*0165      I                 myTime, myIter, myThid )
e874fa47e5 Jean*0166 #endif
                0167 
                0168 #ifdef ALLOW_RBCS
                0169       IF (useRBCS) THEN
                0170         CALL RBCS_ADD_TENDENCY(
                0171      U                 gU_arr,
                0172      I                 k, bi, bj, -1,
2c160c3ab4 Jean*0173      I                 myTime, myIter, myThid )
e874fa47e5 Jean*0174 
                0175       ENDIF
                0176 #endif /* ALLOW_RBCS */
                0177 
                0178 #ifdef ALLOW_OBCS
                0179       IF (useOBCS) THEN
                0180         CALL OBCS_SPONGE_U(
                0181      U                   gU_arr,
                0182      I                   iMin,iMax,jMin,jMax, k, bi,bj,
2c160c3ab4 Jean*0183      I                   myTime, myIter, myThid )
e874fa47e5 Jean*0184       ENDIF
                0185 #endif /* ALLOW_OBCS */
                0186 
                0187 #ifdef ALLOW_MYPACKAGE
                0188       IF ( useMYPACKAGE ) THEN
                0189         CALL MYPACKAGE_TENDENCY_APPLY_U(
                0190      U                 gU_arr,
                0191      I                 iMin,iMax,jMin,jMax, k, bi,bj,
2c160c3ab4 Jean*0192      I                 myTime, myIter, myThid )
e874fa47e5 Jean*0193       ENDIF
                0194 #endif /* ALLOW_MYPACKAGE */
                0195 
                0196 #endif /* USE_OLD_EXTERNAL_FORCING */
                0197 
                0198       RETURN
                0199       END
                0200 
                0201 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0202 CBOP
                0203 C     !ROUTINE: APPLY_FORCING_V
                0204 C     !INTERFACE:
                0205       SUBROUTINE APPLY_FORCING_V(
                0206      U                     gV_arr,
                0207      I                     iMin,iMax,jMin,jMax, k, bi, bj,
                0208      I                     myTime, myIter, myThid )
                0209 C     !DESCRIPTION: \bv
                0210 C     *==========================================================*
                0211 C     | S/R APPLY_FORCING_V
                0212 C     | o Contains problem specific forcing for merid velocity.
                0213 C     *==========================================================*
                0214 C     | Adds terms to gV for forcing by external sources
                0215 C     | e.g. wind stress, bottom friction etc ...
                0216 C     *==========================================================*
                0217 C     \ev
                0218 
                0219 C     !USES:
                0220       IMPLICIT NONE
                0221 C     == Global data ==
                0222 #include "SIZE.h"
                0223 #include "EEPARAMS.h"
                0224 #include "PARAMS.h"
                0225 #include "GRID.h"
                0226 #include "DYNVARS.h"
                0227 #include "FFIELDS.h"
                0228 
                0229 C     !INPUT/OUTPUT PARAMETERS:
                0230 C     gV_arr    :: the tendency array
                0231 C     iMin,iMax :: Working range of x-index for applying forcing.
                0232 C     jMin,jMax :: Working range of y-index for applying forcing.
                0233 C     k         :: Current vertical level index
                0234 C     bi,bj     :: Current tile indices
                0235 C     myTime    :: Current time in simulation
                0236 C     myIter    :: Current iteration number
                0237 C     myThid    :: my Thread Id number
                0238       _RL     gV_arr(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
                0239       INTEGER iMin, iMax, jMin, jMax
                0240       INTEGER k, bi, bj
                0241       _RL     myTime
                0242       INTEGER myIter
                0243       INTEGER myThid
                0244 
                0245 C     !LOCAL VARIABLES:
                0246 C     i,j       :: Loop counters
                0247 C     kSurface  :: index of surface level
                0248       INTEGER i, j
                0249 #ifdef USE_OLD_EXTERNAL_FORCING
                0250       _RL     locVar(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
202e12438b Jean*0251       _RL     tmpVar(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
e874fa47e5 Jean*0252 #else
                0253       INTEGER kSurface
5a705ed756 Jean*0254 #endif /* USE_OLD_EXTERNAL_FORCING */
e874fa47e5 Jean*0255 CEOP
                0256 
                0257 #ifdef USE_OLD_EXTERNAL_FORCING
                0258 
                0259       DO j=1-OLy,sNy+OLy
                0260         DO i=1-OLx,sNx+OLx
                0261           locVar(i,j) = gV(i,j,k,bi,bj)
                0262         ENDDO
                0263       ENDDO
                0264       CALL EXTERNAL_FORCING_V(
                0265      I              iMin, iMax, jMin, jMax, bi, bj, k,
                0266      I              myTime, myThid )
202e12438b Jean*0267 C-    Use 2-d local array tmpVar and split loop in 2 parts to avoid compiler
                0268 C     to mess-up this part by re-arranging the order of instructions (wrong
                0269 C     when gV and gV_arr are the same array, i.e., called with argument gV).
e874fa47e5 Jean*0270       DO j=1-OLy,sNy+OLy
                0271         DO i=1-OLx,sNx+OLx
202e12438b Jean*0272           tmpVar(i,j) = gV(i,j,k,bi,bj) - locVar(i,j)
e874fa47e5 Jean*0273           gV(i,j,k,bi,bj) = locVar(i,j)
202e12438b Jean*0274         ENDDO
                0275       ENDDO
aa25968b23 Jean*0276 C-    not needed since APPLY_FORCING_V is no longer called with argument gV
                0277 c     CALL FOOL_THE_COMPILER_RL( tmpVar(1,1) )
202e12438b Jean*0278       DO j=1-OLy,sNy+OLy
                0279         DO i=1-OLx,sNx+OLx
                0280           gV_arr(i,j) = gV_arr(i,j) + tmpVar(i,j)
e874fa47e5 Jean*0281         ENDDO
                0282       ENDDO
                0283 
                0284 #else  /* USE_OLD_EXTERNAL_FORCING */
                0285 
                0286       IF ( fluidIsAir ) THEN
                0287        kSurface = 0
                0288       ELSEIF ( usingPCoords ) THEN
                0289        kSurface = Nr
                0290       ELSE
                0291        kSurface = 1
                0292       ENDIF
                0293 
                0294 C--   Forcing term
                0295 #ifdef ALLOW_AIM
                0296       IF ( useAIM ) CALL AIM_TENDENCY_APPLY_V(
                0297      U                       gV_arr,
                0298      I                       iMin,iMax,jMin,jMax, k, bi,bj,
2c160c3ab4 Jean*0299      I                       myTime, myIter, myThid )
e874fa47e5 Jean*0300 #endif /* ALLOW_AIM */
                0301 
                0302 #ifdef ALLOW_ATM_PHYS
                0303       IF ( useAtm_Phys ) CALL ATM_PHYS_TENDENCY_APPLY_V(
                0304      U                       gV_arr,
                0305      I                       iMin,iMax,jMin,jMax, k, bi,bj,
2c160c3ab4 Jean*0306      I                       myTime, myIter, myThid )
e874fa47e5 Jean*0307 #endif /* ALLOW_ATM_PHYS */
                0308 
                0309 #ifdef ALLOW_FIZHI
                0310       IF ( useFIZHI ) CALL FIZHI_TENDENCY_APPLY_V(
                0311      U                       gV_arr,
                0312      I                       iMin,iMax,jMin,jMax, k, bi,bj,
2c160c3ab4 Jean*0313      I                       myTime, myIter, myThid )
e874fa47e5 Jean*0314 #endif /* ALLOW_FIZHI */
                0315 
614bfb3d2a Jean*0316 C     Add Tidal momentum forcing from 2-d geopotential anomaly
                0317       IF ( momTidalForcing ) THEN
                0318        DO j=1,sNy+1
                0319         DO i=0,sNx+1
                0320           gV_arr(i,j) = gV_arr(i,j)
                0321      &      - recip_dyC(i,j,bi,bj)*recip_deepFacC(k)
                0322      &      *( phiTide2d(i,j,bi,bj) - phiTide2d(i,j-1,bi,bj) )
                0323      &      *_maskS(i,j,k,bi,bj)
                0324         ENDDO
                0325        ENDDO
                0326       ENDIF
                0327 
e874fa47e5 Jean*0328 C     Ocean: Add momentum surface forcing (e.g., wind-stress) in surface level
                0329       IF ( k .EQ. kSurface ) THEN
                0330        DO j=1,sNy+1
                0331 c       DO i=1,sNx
                0332 C-jmc: Without CD-scheme, this is OK ; but with CD-scheme, needs to cover [0:sNx+1]
                0333         DO i=0,sNx+1
                0334           gV_arr(i,j) = gV_arr(i,j)
                0335      &      +foFacMom*surfaceForcingV(i,j,bi,bj)
                0336      &      *recip_drF(k)*_recip_hFacS(i,j,k,bi,bj)
                0337         ENDDO
                0338        ENDDO
                0339       ELSEIF ( kSurface.EQ.-1 ) THEN
                0340        DO j=1,sNy+1
                0341         DO i=0,sNx+1
                0342          IF ( kSurfS(i,j,bi,bj).EQ.k ) THEN
                0343           gV_arr(i,j) = gV_arr(i,j)
                0344      &      +foFacMom*surfaceForcingV(i,j,bi,bj)
                0345      &      *recip_drF(k)*_recip_hFacS(i,j,k,bi,bj)
                0346          ENDIF
                0347         ENDDO
                0348        ENDDO
                0349       ENDIF
                0350 
                0351 #ifdef ALLOW_EDDYPSI
                0352          CALL TAUEDDY_TENDENCY_APPLY_V(
                0353      U                 gV_arr,
                0354      I                 iMin,iMax,jMin,jMax, k, bi,bj,
2c160c3ab4 Jean*0355      I                 myTime, myIter, myThid )
e874fa47e5 Jean*0356 #endif
                0357 
                0358 #ifdef ALLOW_RBCS
                0359       IF (useRBCS) THEN
                0360         CALL RBCS_ADD_TENDENCY(
                0361      U                 gV_arr,
                0362      I                 k, bi, bj, -2,
2c160c3ab4 Jean*0363      I                 myTime, myIter, myThid )
e874fa47e5 Jean*0364       ENDIF
                0365 #endif /* ALLOW_RBCS */
                0366 
                0367 #ifdef ALLOW_OBCS
                0368       IF (useOBCS) THEN
                0369         CALL OBCS_SPONGE_V(
                0370      U                   gV_arr,
                0371      I                   iMin,iMax,jMin,jMax, k, bi,bj,
2c160c3ab4 Jean*0372      I                   myTime, myIter, myThid )
e874fa47e5 Jean*0373       ENDIF
                0374 #endif /* ALLOW_OBCS */
                0375 
                0376 #ifdef ALLOW_MYPACKAGE
                0377       IF ( useMYPACKAGE ) THEN
                0378         CALL MYPACKAGE_TENDENCY_APPLY_V(
                0379      U                 gV_arr,
                0380      I                 iMin,iMax,jMin,jMax, k, bi,bj,
2c160c3ab4 Jean*0381      I                 myTime, myIter, myThid )
e874fa47e5 Jean*0382       ENDIF
                0383 #endif /* ALLOW_MYPACKAGE */
                0384 
                0385 #endif /* USE_OLD_EXTERNAL_FORCING */
                0386 
                0387       RETURN
                0388       END
                0389 
                0390 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0391 CBOP
                0392 C     !ROUTINE: APPLY_FORCING_T
                0393 C     !INTERFACE:
                0394       SUBROUTINE APPLY_FORCING_T(
                0395      U                     gT_arr,
                0396      I                     iMin,iMax,jMin,jMax, k, bi, bj,
                0397      I                     myTime, myIter, myThid )
                0398 C     !DESCRIPTION: \bv
                0399 C     *==========================================================*
                0400 C     | S/R APPLY_FORCING_T
                0401 C     | o Contains problem specific forcing for temperature.
                0402 C     *==========================================================*
                0403 C     | Adds terms to gT for forcing by external sources
                0404 C     | e.g. heat flux, climatalogical relaxation, etc ...
                0405 C     *==========================================================*
                0406 C     \ev
                0407 
                0408 C     !USES:
                0409       IMPLICIT NONE
                0410 C     == Global data ==
                0411 #include "SIZE.h"
                0412 #include "EEPARAMS.h"
                0413 #include "PARAMS.h"
                0414 #include "GRID.h"
                0415 #include "DYNVARS.h"
                0416 #include "FFIELDS.h"
                0417 #include "SURFACE.h"
                0418 
                0419 C     !INPUT/OUTPUT PARAMETERS:
                0420 C     gT_arr    :: the tendency array
                0421 C     iMin,iMax :: Working range of x-index for applying forcing.
                0422 C     jMin,jMax :: Working range of y-index for applying forcing.
                0423 C     k         :: Current vertical level index
                0424 C     bi,bj     :: Current tile indices
                0425 C     myTime    :: Current time in simulation
                0426 C     myIter    :: Current iteration number
                0427 C     myThid    :: my Thread Id number
                0428       _RL     gT_arr(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
                0429       INTEGER iMin, iMax, jMin, jMax
                0430       INTEGER k, bi, bj
                0431       _RL     myTime
                0432       INTEGER myIter
                0433       INTEGER myThid
                0434 
                0435 C     !LOCAL VARIABLES:
                0436 C     i,j       :: Loop counters
                0437 C     kSurface  :: index of surface level
                0438       INTEGER i, j
5a705ed756 Jean*0439 #ifndef USE_OLD_EXTERNAL_FORCING
e874fa47e5 Jean*0440       INTEGER kSurface
                0441       INTEGER km, kc, kp
5a705ed756 Jean*0442       _RL     tmpVar(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
e874fa47e5 Jean*0443       _RL tmpFac, delPI
                0444       _RL recip_Cp
5a705ed756 Jean*0445 #endif /* USE_OLD_EXTERNAL_FORCING */
                0446 CEOP
e874fa47e5 Jean*0447 
                0448 #ifdef USE_OLD_EXTERNAL_FORCING
                0449 
                0450       DO j=1-OLy,sNy+OLy
                0451         DO i=1-OLx,sNx+OLx
5a705ed756 Jean*0452           gT(i,j,k,bi,bj) = 0. _d 0
e874fa47e5 Jean*0453         ENDDO
                0454       ENDDO
                0455       CALL EXTERNAL_FORCING_T(
                0456      I              iMin, iMax, jMin, jMax, bi, bj, k,
                0457      I              myTime, myThid )
202e12438b Jean*0458       DO j=1-OLy,sNy+OLy
                0459         DO i=1-OLx,sNx+OLx
5a705ed756 Jean*0460           gT_arr(i,j) = gT_arr(i,j) + gT(i,j,k,bi,bj)
e874fa47e5 Jean*0461         ENDDO
                0462       ENDDO
                0463 
                0464 #else  /* USE_OLD_EXTERNAL_FORCING */
                0465 
                0466       IF ( fluidIsAir ) THEN
                0467        kSurface = 0
                0468       ELSEIF ( usingZCoords .AND. useShelfIce ) THEN
                0469        kSurface = -1
                0470       ELSEIF ( usingPCoords ) THEN
                0471        kSurface = Nr
                0472       ELSE
                0473        kSurface = 1
                0474       ENDIF
                0475       recip_Cp = 1. _d 0 / HeatCapacity_Cp
                0476 
5a705ed756 Jean*0477 C--   Note on loop range: For model dynamics, only needs to get correct
                0478 C     forcing (update gT_arr) in tile interior (1:sNx,1:sNy);
                0479 C     However, for some diagnostics, we may want to get valid forcing
                0480 C     extended over 1 point in tile halo region (0:sNx+1,0:sNy=1).
                0481 
e874fa47e5 Jean*0482 C--   Forcing term
                0483 #ifdef ALLOW_AIM
                0484       IF ( useAIM ) CALL AIM_TENDENCY_APPLY_T(
                0485      U                       gT_arr,
                0486      I                       iMin,iMax,jMin,jMax, k, bi,bj,
2c160c3ab4 Jean*0487      I                       myTime, myIter, myThid )
e874fa47e5 Jean*0488 #endif /* ALLOW_AIM */
                0489 
                0490 #ifdef ALLOW_ATM_PHYS
                0491       IF ( useAtm_Phys ) CALL ATM_PHYS_TENDENCY_APPLY_T(
                0492      U                       gT_arr,
                0493      I                       iMin,iMax,jMin,jMax, k, bi,bj,
2c160c3ab4 Jean*0494      I                       myTime, myIter, myThid )
e874fa47e5 Jean*0495 #endif /* ALLOW_ATM_PHYS */
                0496 
                0497 #ifdef ALLOW_FIZHI
                0498       IF ( useFIZHI ) CALL FIZHI_TENDENCY_APPLY_T(
                0499      U                       gT_arr,
                0500      I                       iMin,iMax,jMin,jMax, k, bi,bj,
2c160c3ab4 Jean*0501      I                       myTime, myIter, myThid )
e874fa47e5 Jean*0502 #endif /* ALLOW_FIZHI */
                0503 
                0504 #ifdef ALLOW_ADDFLUID
                0505       IF ( selectAddFluid.NE.0 .AND. temp_addMass.NE.UNSET_RL ) THEN
                0506        IF ( ( selectAddFluid.GE.1 .AND. nonlinFreeSurf.GT.0 )
                0507      &      .OR. convertFW2Salt.EQ.-1. _d 0 ) THEN
5a705ed756 Jean*0508          DO j=0,sNy+1
                0509           DO i=0,sNx+1
e874fa47e5 Jean*0510             gT_arr(i,j) = gT_arr(i,j)
                0511      &        + addMass(i,j,k,bi,bj)*mass2rUnit
                0512      &          *( temp_addMass - theta(i,j,k,bi,bj) )
                0513      &          *recip_rA(i,j,bi,bj)
                0514      &          *recip_drF(k)*_recip_hFacC(i,j,k,bi,bj)
                0515 C    &          *recip_deepFac2C(k)*recip_rhoFacC(k)
                0516           ENDDO
                0517          ENDDO
                0518        ELSE
5a705ed756 Jean*0519          DO j=0,sNy+1
                0520           DO i=0,sNx+1
e874fa47e5 Jean*0521             gT_arr(i,j) = gT_arr(i,j)
                0522      &        + addMass(i,j,k,bi,bj)*mass2rUnit
                0523      &          *( temp_addMass - tRef(k) )
                0524      &          *recip_rA(i,j,bi,bj)
                0525      &          *recip_drF(k)*_recip_hFacC(i,j,k,bi,bj)
                0526 C    &          *recip_deepFac2C(k)*recip_rhoFacC(k)
                0527           ENDDO
                0528          ENDDO
                0529        ENDIF
                0530       ENDIF
                0531 #endif /* ALLOW_ADDFLUID */
                0532 
                0533 #ifdef ALLOW_FRICTION_HEATING
                0534       IF ( addFrictionHeating ) THEN
                0535         IF ( fluidIsAir ) THEN
                0536 C         conversion from in-situ Temp to Pot.Temp
                0537           tmpFac = (atm_Po/rC(k))**atm_kappa
                0538 C         conversion from W/m^2/r_unit to K/s
                0539           tmpFac = (tmpFac/atm_Cp) * mass2rUnit
                0540         ELSE
                0541 C         conversion from W/m^2/r_unit to K/s
                0542           tmpFac = recip_Cp * mass2rUnit
                0543         ENDIF
5a705ed756 Jean*0544         DO j=0,sNy+1
                0545           DO i=0,sNx+1
e874fa47e5 Jean*0546             gT_arr(i,j) = gT_arr(i,j)
e24c9bfc82 Jean*0547      &         + frictionHeating(i,j,k,bi,bj)*tmpFac
e874fa47e5 Jean*0548      &          *recip_drF(k)*_recip_hFacC(i,j,k,bi,bj)
                0549           ENDDO
                0550         ENDDO
                0551       ENDIF
                0552 #endif /* ALLOW_FRICTION_HEATING */
                0553 
                0554       IF ( fluidIsAir .AND. atm_Rq.NE.zeroRL .AND. Nr.NE.1 ) THEN
                0555 C--   Compressible fluid: account for difference between moist and dry air
                0556 C     specific volume in Enthalpy equation (+ V.dP term), since only the
                0557 C     dry air part is accounted for in the (dry) Pot.Temp formulation.
                0558 C     Used centered averaging from interface to center (consistent with
                0559 C     conversion term in KE eq) and same discretisation ( [T*Q]_bar_k )
                0560 C     as for Theta_v in CALC_PHI_HYD
                0561 
                0562 C     conversion from in-situ Temp to Pot.Temp
                0563         tmpFac = (atm_Po/rC(k))**atm_kappa
                0564 C     conversion from W/kg to K/s
                0565         tmpFac = tmpFac/atm_Cp
                0566         km = k-1
                0567         kc = k
                0568         kp = k+1
                0569         IF ( k.EQ.1 ) THEN
5a705ed756 Jean*0570           DO j=0,sNy+1
                0571            DO i=0,sNx+1
e874fa47e5 Jean*0572             tmpVar(i,j) = 0.
                0573            ENDDO
                0574           ENDDO
                0575         ELSE
                0576           delPI = atm_Cp*( (rC(km)/atm_Po)**atm_kappa
                0577      &                   - (rC(kc)/atm_Po)**atm_kappa )
5a705ed756 Jean*0578           DO j=0,sNy+1
                0579            DO i=0,sNx+1
e874fa47e5 Jean*0580             tmpVar(i,j) = wVel(i,j,kc,bi,bj)*delPI*atm_Rq
                0581      &                  *( theta(i,j,km,bi,bj)*salt(i,j,km,bi,bj)
                0582      &                   + theta(i,j,kc,bi,bj)*salt(i,j,kc,bi,bj)
                0583      &                   )*maskC(i,j,km,bi,bj)*0.25 _d 0
                0584            ENDDO
                0585           ENDDO
                0586         ENDIF
                0587         IF ( k.LT.Nr ) THEN
                0588           delPI = atm_Cp*( (rC(kc)/atm_Po)**atm_kappa
                0589      &                   - (rC(kp)/atm_Po)**atm_kappa )
5a705ed756 Jean*0590           DO j=0,sNy+1
                0591            DO i=0,sNx+1
e874fa47e5 Jean*0592             tmpVar(i,j) = tmpVar(i,j)
                0593      &                  + wVel(i,j,kp,bi,bj)*delPI*atm_Rq
                0594      &                  *( theta(i,j,kc,bi,bj)*salt(i,j,kc,bi,bj)
                0595      &                   + theta(i,j,kp,bi,bj)*salt(i,j,kp,bi,bj)
                0596      &                   )*maskC(i,j,kp,bi,bj)*0.25 _d 0
                0597            ENDDO
                0598           ENDDO
                0599         ENDIF
5a705ed756 Jean*0600         DO j=0,sNy+1
                0601           DO i=0,sNx+1
e874fa47e5 Jean*0602             gT_arr(i,j) = gT_arr(i,j)
                0603      &         + tmpVar(i,j)*tmpFac
                0604      &          *recip_drF(k)*_recip_hFacC(i,j,k,bi,bj)
                0605           ENDDO
                0606         ENDDO
                0607 #ifdef ALLOW_DIAGNOSTICS
                0608         IF ( useDiagnostics ) THEN
                0609 C     conversion to W/m^2
                0610           tmpFac = rUnit2mass
                0611           CALL DIAGNOSTICS_SCALE_FILL( tmpVar, tmpFac, 1,
5a705ed756 Jean*0612      &                     'MoistCor', kc, 1, 2, bi,bj,myThid )
e874fa47e5 Jean*0613         ENDIF
                0614 #endif /* ALLOW_DIAGNOSTICS */
                0615       ENDIF
                0616 
                0617 C     Ocean: Add temperature surface forcing (e.g., heat-flux) in surface level
                0618       IF ( k .EQ. kSurface ) THEN
5a705ed756 Jean*0619        DO j=0,sNy+1
                0620         DO i=0,sNx+1
e874fa47e5 Jean*0621           gT_arr(i,j) = gT_arr(i,j)
                0622      &      +surfaceForcingT(i,j,bi,bj)
                0623      &      *recip_drF(k)*_recip_hFacC(i,j,k,bi,bj)
                0624         ENDDO
                0625        ENDDO
                0626       ELSEIF ( kSurface.EQ.-1 ) THEN
5a705ed756 Jean*0627        DO j=0,sNy+1
                0628         DO i=0,sNx+1
e874fa47e5 Jean*0629          IF ( kSurfC(i,j,bi,bj).EQ.k ) THEN
                0630           gT_arr(i,j) = gT_arr(i,j)
                0631      &      +surfaceForcingT(i,j,bi,bj)
                0632      &      *recip_drF(k)*_recip_hFacC(i,j,k,bi,bj)
                0633          ENDIF
                0634         ENDDO
                0635        ENDDO
                0636       ENDIF
                0637 
                0638       IF (linFSConserveTr) THEN
5a705ed756 Jean*0639        DO j=0,sNy+1
                0640         DO i=0,sNx+1
0320e25227 Mart*0641          IF (k .EQ. kSurfC(i,j,bi,bj)) THEN
                0642           gT_arr(i,j) = gT_arr(i,j)
e874fa47e5 Jean*0643      &        +TsurfCor*recip_drF(k)*_recip_hFacC(i,j,k,bi,bj)
0320e25227 Mart*0644          ENDIF
e874fa47e5 Jean*0645         ENDDO
                0646        ENDDO
                0647       ENDIF
                0648 
90929f8806 Patr*0649 #ifdef ALLOW_GEOTHERMAL_FLUX
                0650       IF ( usingZCoords ) THEN
5a705ed756 Jean*0651        DO j=0,sNy+1
                0652         DO i=0,sNx+1
90929f8806 Patr*0653          IF ( k.EQ.kLowC(i,j,bi,bj) ) THEN
                0654           gT_arr(i,j)=gT_arr(i,j)
                0655      &      + geothermalFlux(i,j,bi,bj)
                0656      &        *recip_Cp*mass2rUnit
                0657      &        *recip_drF(k)*_recip_hFacC(i,j,k,bi,bj)
                0658          ENDIF
                0659         ENDDO
                0660        ENDDO
0320e25227 Mart*0661       ELSEIF ( kSurface .EQ. Nr ) THEN
                0662 C     this is oceanic pressure coordinate case
                0663 C     where the flux at the bottom is applied as kSurfC
                0664        DO j=0,sNy+1
                0665         DO i=0,sNx+1
                0666          IF ( k.EQ.kSurfC(i,j,bi,bj) ) THEN
                0667           gT_arr(i,j)=gT_arr(i,j)
                0668      &      + geothermalFlux(i,j,bi,bj)
                0669      &        *recip_Cp*mass2rUnit
                0670      &        *recip_drF(k)*_recip_hFacC(i,j,k,bi,bj)
                0671          ENDIF
                0672         ENDDO
                0673        ENDDO
                0674       ELSE
44d3986245 Jean*0675 C-    Neither Z-Coords nor kSurface=Nr : not implemented
                0676        STOP 'ABNORMAL END: S/R APPLY_FORCING_T (geothermal-flux)'
90929f8806 Patr*0677       ENDIF
                0678 #endif /* ALLOW_GEOTHERMAL_FLUX */
                0679 
e874fa47e5 Jean*0680 #ifdef SHORTWAVE_HEATING
                0681 C Penetrating SW radiation
00c7090dc0 Mart*0682       IF ( selectPenetratingSW .GT. 0 ) THEN
5a705ed756 Jean*0683        DO j=0,sNy+1
                0684         DO i=0,sNx+1
e874fa47e5 Jean*0685          gT_arr(i,j) = gT_arr(i,j)
00c7090dc0 Mart*0686      &        + Qsw(i,j,bi,bj)*gravitySign
                0687      &        *( SWFrac3D(i,j,k,bi,bj) - SWFrac3D(i,j,k+1,bi,bj) )
0320e25227 Mart*0688      &        *recip_Cp*mass2rUnit
                0689      &        *recip_drF(k)*_recip_hFacC(i,j,k,bi,bj)
e874fa47e5 Jean*0690         ENDDO
                0691        ENDDO
00c7090dc0 Mart*0692       ENDIF
0320e25227 Mart*0693 #endif /* SHORTWAVE_HEATING */
e874fa47e5 Jean*0694 
                0695 #ifdef ALLOW_FRAZIL
                0696       IF ( useFRAZIL )
                0697      &     CALL FRAZIL_TENDENCY_APPLY_T(
                0698      U                 gT_arr,
                0699      I                 iMin,iMax,jMin,jMax, k, bi,bj,
2c160c3ab4 Jean*0700      I                 myTime, myIter, myThid )
e874fa47e5 Jean*0701 #endif /* ALLOW_FRAZIL */
                0702 
                0703 #ifdef ALLOW_SHELFICE
                0704       IF ( useShelfIce )
                0705      &     CALL SHELFICE_FORCING_T(
                0706      U                   gT_arr,
                0707      I                   iMin,iMax,jMin,jMax, k, bi,bj,
2c160c3ab4 Jean*0708      I                   myTime, myIter, myThid )
e874fa47e5 Jean*0709 #endif /* ALLOW_SHELFICE */
                0710 
                0711 #ifdef ALLOW_ICEFRONT
                0712       IF ( useICEFRONT )
                0713      &     CALL ICEFRONT_TENDENCY_APPLY_T(
                0714      U                   gT_arr,
2c160c3ab4 Jean*0715      I                   k, bi, bj, myTime, myIter, myThid )
e874fa47e5 Jean*0716 #endif /* ALLOW_ICEFRONT */
                0717 
                0718 #ifdef ALLOW_SALT_PLUME
                0719       IF ( useSALT_PLUME )
                0720      &     CALL SALT_PLUME_TENDENCY_APPLY_T(
                0721      U                     gT_arr,
                0722      I                     iMin,iMax,jMin,jMax, k, bi,bj,
2c160c3ab4 Jean*0723      I                     myTime, myIter, myThid )
e874fa47e5 Jean*0724 #endif /* ALLOW_SALT_PLUME */
                0725 
                0726 #ifdef ALLOW_RBCS
                0727       IF (useRBCS) THEN
                0728         CALL RBCS_ADD_TENDENCY(
                0729      U                 gT_arr,
                0730      I                 k, bi, bj, 1,
2c160c3ab4 Jean*0731      I                 myTime, myIter, myThid )
e874fa47e5 Jean*0732       ENDIF
                0733 #endif /* ALLOW_RBCS */
                0734 
                0735 #ifdef ALLOW_OBCS
                0736       IF (useOBCS) THEN
                0737         CALL OBCS_SPONGE_T(
                0738      U                   gT_arr,
                0739      I                   iMin,iMax,jMin,jMax, k, bi,bj,
2c160c3ab4 Jean*0740      I                   myTime, myIter, myThid )
e874fa47e5 Jean*0741       ENDIF
                0742 #endif /* ALLOW_OBCS */
                0743 
                0744 #ifdef ALLOW_BBL
                0745       IF ( useBBL ) CALL BBL_TENDENCY_APPLY_T(
                0746      U                       gT_arr,
                0747      I                       iMin,iMax,jMin,jMax, k, bi,bj,
2c160c3ab4 Jean*0748      I                       myTime, myIter, myThid )
e874fa47e5 Jean*0749 #endif /* ALLOW_BBL */
                0750 
                0751 #ifdef ALLOW_MYPACKAGE
                0752       IF ( useMYPACKAGE ) THEN
                0753         CALL MYPACKAGE_TENDENCY_APPLY_T(
                0754      U                 gT_arr,
                0755      I                 iMin,iMax,jMin,jMax, k, bi,bj,
2c160c3ab4 Jean*0756      I                 myTime, myIter, myThid )
e874fa47e5 Jean*0757       ENDIF
                0758 #endif /* ALLOW_MYPACKAGE */
                0759 
                0760 #endif /* USE_OLD_EXTERNAL_FORCING */
                0761 
                0762       RETURN
                0763       END
                0764 
                0765 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0766 CBOP
                0767 C     !ROUTINE: APPLY_FORCING_S
                0768 C     !INTERFACE:
                0769       SUBROUTINE APPLY_FORCING_S(
                0770      U                     gS_arr,
                0771      I                     iMin,iMax,jMin,jMax, k, bi, bj,
                0772      I                     myTime, myIter, myThid )
                0773 C     !DESCRIPTION: \bv
                0774 C     *==========================================================*
                0775 C     | S/R APPLY_FORCING_S
                0776 C     | o Contains problem specific forcing for merid velocity.
                0777 C     *==========================================================*
                0778 C     | Adds terms to gS for forcing by external sources
                0779 C     | e.g. fresh-water flux, climatalogical relaxation, etc ...
                0780 C     *==========================================================*
                0781 C     \ev
                0782 
                0783 C     !USES:
                0784       IMPLICIT NONE
                0785 C     == Global data ==
                0786 #include "SIZE.h"
                0787 #include "EEPARAMS.h"
                0788 #include "PARAMS.h"
                0789 #include "GRID.h"
                0790 #include "DYNVARS.h"
                0791 #include "FFIELDS.h"
                0792 #include "SURFACE.h"
                0793 
                0794 C     !INPUT/OUTPUT PARAMETERS:
                0795 C     gS_arr    :: the tendency array
                0796 C     iMin,iMax :: Working range of x-index for applying forcing.
                0797 C     jMin,jMax :: Working range of y-index for applying forcing.
                0798 C     k         :: Current vertical level index
                0799 C     bi,bj     :: Current tile indices
                0800 C     myTime    :: Current time in simulation
                0801 C     myIter    :: Current iteration number
                0802 C     myThid    :: my Thread Id number
                0803       _RL     gS_arr(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
                0804       INTEGER iMin, iMax, jMin, jMax
                0805       INTEGER k, bi, bj
                0806       _RL     myTime
                0807       INTEGER myIter
                0808       INTEGER myThid
                0809 
                0810 C     !LOCAL VARIABLES:
                0811 C     i,j       :: Loop counters
                0812 C     kSurface  :: index of surface level
                0813       INTEGER i, j
5a705ed756 Jean*0814 #ifndef USE_OLD_EXTERNAL_FORCING
e874fa47e5 Jean*0815       INTEGER kSurface
5a705ed756 Jean*0816 #endif /* USE_OLD_EXTERNAL_FORCING */
e874fa47e5 Jean*0817 CEOP
                0818 
                0819 #ifdef USE_OLD_EXTERNAL_FORCING
                0820 
                0821       DO j=1-OLy,sNy+OLy
                0822         DO i=1-OLx,sNx+OLx
5a705ed756 Jean*0823           gS(i,j,k,bi,bj) = 0. _d 0
e874fa47e5 Jean*0824         ENDDO
                0825       ENDDO
                0826       CALL EXTERNAL_FORCING_S(
                0827      I              iMin, iMax, jMin, jMax, bi, bj, k,
                0828      I              myTime, myThid )
                0829       DO j=1-OLy,sNy+OLy
                0830         DO i=1-OLx,sNx+OLx
5a705ed756 Jean*0831           gS_arr(i,j) = gS_arr(i,j) + gS(i,j,k,bi,bj)
e874fa47e5 Jean*0832         ENDDO
                0833       ENDDO
                0834 
                0835 #else  /* USE_OLD_EXTERNAL_FORCING */
                0836 
                0837       IF ( fluidIsAir ) THEN
                0838        kSurface = 0
                0839       ELSEIF ( usingZCoords .AND. useShelfIce ) THEN
                0840        kSurface = -1
                0841       ELSEIF ( usingPCoords ) THEN
                0842        kSurface = Nr
                0843       ELSE
                0844        kSurface = 1
                0845       ENDIF
                0846 
5a705ed756 Jean*0847 C--   Note on loop range: For model dynamics, only needs to get correct
                0848 C     forcing (update gS_arr) in tile interior (1:sNx,1:sNy);
                0849 C     However, for some diagnostics, we may want to get valid forcing
                0850 C     extended over 1 point in tile halo region (0:sNx+1,0:sNy=1).
                0851 
e874fa47e5 Jean*0852 C--   Forcing term
                0853 #ifdef ALLOW_AIM
                0854       IF ( useAIM ) CALL AIM_TENDENCY_APPLY_S(
                0855      U                       gS_arr,
                0856      I                       iMin,iMax,jMin,jMax, k, bi,bj,
2c160c3ab4 Jean*0857      I                       myTime, myIter, myThid )
e874fa47e5 Jean*0858 #endif /* ALLOW_AIM */
                0859 
                0860 #ifdef ALLOW_ATM_PHYS
                0861       IF ( useAtm_Phys ) CALL ATM_PHYS_TENDENCY_APPLY_S(
                0862      U                       gS_arr,
                0863      I                       iMin,iMax,jMin,jMax, k, bi,bj,
2c160c3ab4 Jean*0864      I                       myTime, myIter, myThid )
e874fa47e5 Jean*0865 #endif /* ALLOW_ATM_PHYS */
                0866 
                0867 #ifdef ALLOW_FIZHI
                0868       IF ( useFIZHI ) CALL FIZHI_TENDENCY_APPLY_S(
                0869      U                       gS_arr,
                0870      I                       iMin,iMax,jMin,jMax, k, bi,bj,
2c160c3ab4 Jean*0871      I                       myTime, myIter, myThid )
e874fa47e5 Jean*0872 #endif /* ALLOW_FIZHI */
                0873 
                0874 #ifdef ALLOW_ADDFLUID
                0875       IF ( selectAddFluid.NE.0 .AND. salt_addMass.NE.UNSET_RL ) THEN
                0876        IF ( ( selectAddFluid.GE.1 .AND. nonlinFreeSurf.GT.0 )
                0877      &      .OR. convertFW2Salt.EQ.-1. _d 0 ) THEN
5a705ed756 Jean*0878          DO j=0,sNy+1
                0879           DO i=0,sNx+1
e874fa47e5 Jean*0880             gS_arr(i,j) = gS_arr(i,j)
                0881      &        + addMass(i,j,k,bi,bj)*mass2rUnit
                0882      &          *( salt_addMass - salt(i,j,k,bi,bj) )
                0883      &          *recip_rA(i,j,bi,bj)
                0884      &          *recip_drF(k)*_recip_hFacC(i,j,k,bi,bj)
                0885 C    &          *recip_deepFac2C(k)*recip_rhoFacC(k)
                0886           ENDDO
                0887          ENDDO
                0888        ELSE
5a705ed756 Jean*0889          DO j=0,sNy+1
                0890           DO i=0,sNx+1
e874fa47e5 Jean*0891             gS_arr(i,j) = gS_arr(i,j)
                0892      &        + addMass(i,j,k,bi,bj)*mass2rUnit
                0893      &          *( salt_addMass - sRef(k) )
                0894      &          *recip_rA(i,j,bi,bj)
                0895      &          *recip_drF(k)*_recip_hFacC(i,j,k,bi,bj)
                0896 C    &          *recip_deepFac2C(k)*recip_rhoFacC(k)
                0897           ENDDO
                0898          ENDDO
                0899        ENDIF
                0900       ENDIF
                0901 #endif /* ALLOW_ADDFLUID */
                0902 
                0903 C     Ocean: Add salinity surface forcing (e.g., fresh-water) in surface level
                0904       IF ( k .EQ. kSurface ) THEN
5a705ed756 Jean*0905        DO j=0,sNy+1
                0906         DO i=0,sNx+1
e874fa47e5 Jean*0907           gS_arr(i,j) = gS_arr(i,j)
                0908      &      +surfaceForcingS(i,j,bi,bj)
                0909      &      *recip_drF(k)*_recip_hFacC(i,j,k,bi,bj)
                0910         ENDDO
                0911        ENDDO
                0912       ELSEIF ( kSurface.EQ.-1 ) THEN
5a705ed756 Jean*0913        DO j=0,sNy+1
                0914         DO i=0,sNx+1
e874fa47e5 Jean*0915          IF ( kSurfC(i,j,bi,bj).EQ.k ) THEN
                0916           gS_arr(i,j) = gS_arr(i,j)
                0917      &      +surfaceForcingS(i,j,bi,bj)
                0918      &      *recip_drF(k)*_recip_hFacC(i,j,k,bi,bj)
                0919          ENDIF
                0920         ENDDO
                0921        ENDDO
                0922       ENDIF
                0923 
                0924       IF (linFSConserveTr) THEN
5a705ed756 Jean*0925        DO j=0,sNy+1
                0926         DO i=0,sNx+1
0320e25227 Mart*0927          IF (k .EQ. kSurfC(i,j,bi,bj)) THEN
                0928           gS_arr(i,j) = gS_arr(i,j)
e874fa47e5 Jean*0929      &        +SsurfCor*recip_drF(k)*_recip_hFacC(i,j,k,bi,bj)
0320e25227 Mart*0930          ENDIF
e874fa47e5 Jean*0931         ENDDO
                0932        ENDDO
                0933       ENDIF
                0934 
                0935 #ifdef ALLOW_SHELFICE
                0936       IF ( useShelfIce )
                0937      &     CALL SHELFICE_FORCING_S(
                0938      U                   gS_arr,
                0939      I                   iMin,iMax,jMin,jMax, k, bi,bj,
2c160c3ab4 Jean*0940      I                   myTime, myIter, myThid )
e874fa47e5 Jean*0941 #endif /* ALLOW_SHELFICE */
                0942 
                0943 #ifdef ALLOW_ICEFRONT
                0944       IF ( useICEFRONT )
                0945      &     CALL ICEFRONT_TENDENCY_APPLY_S(
                0946      U                   gS_arr,
2c160c3ab4 Jean*0947      I                   k, bi, bj, myTime, myIter, myThid )
e874fa47e5 Jean*0948 #endif /* ALLOW_ICEFRONT */
                0949 
                0950 #ifdef ALLOW_SALT_PLUME
                0951       IF ( useSALT_PLUME )
                0952      &     CALL SALT_PLUME_TENDENCY_APPLY_S(
                0953      U                     gS_arr,
                0954      I                     iMin,iMax,jMin,jMax, k, bi,bj,
2c160c3ab4 Jean*0955      I                     myTime, myIter, myThid )
e874fa47e5 Jean*0956 #endif /* ALLOW_SALT_PLUME */
                0957 
                0958 #ifdef ALLOW_RBCS
                0959       IF (useRBCS) THEN
                0960         CALL RBCS_ADD_TENDENCY(
                0961      U                 gS_arr,
                0962      I                 k, bi, bj, 2,
2c160c3ab4 Jean*0963      I                 myTime, myIter, myThid )
e874fa47e5 Jean*0964       ENDIF
                0965 #endif /* ALLOW_RBCS */
                0966 
                0967 #ifdef ALLOW_OBCS
                0968       IF (useOBCS) THEN
                0969         CALL OBCS_SPONGE_S(
                0970      U                   gS_arr,
                0971      I                   iMin,iMax,jMin,jMax, k, bi,bj,
2c160c3ab4 Jean*0972      I                   myTime, myIter, myThid )
e874fa47e5 Jean*0973       ENDIF
                0974 #endif /* ALLOW_OBCS */
                0975 
                0976 #ifdef ALLOW_BBL
                0977       IF ( useBBL ) CALL BBL_TENDENCY_APPLY_S(
                0978      U                       gS_arr,
                0979      I                       iMin,iMax,jMin,jMax, k, bi,bj,
2c160c3ab4 Jean*0980      I                       myTime, myIter, myThid )
e874fa47e5 Jean*0981 #endif /* ALLOW_BBL */
                0982 
                0983 #ifdef ALLOW_MYPACKAGE
                0984       IF ( useMYPACKAGE ) THEN
                0985         CALL MYPACKAGE_TENDENCY_APPLY_S(
                0986      U                 gS_arr,
                0987      I                 iMin,iMax,jMin,jMax, k, bi,bj,
2c160c3ab4 Jean*0988      I                 myTime, myIter, myThid )
e874fa47e5 Jean*0989       ENDIF
                0990 #endif /* ALLOW_MYPACKAGE */
                0991 
                0992 #endif /* USE_OLD_EXTERNAL_FORCING */
                0993 
                0994       RETURN
                0995       END
[ Source navigation ] [ Diff markup ] [ Identifier search ] [ general search ]

This page was automatically generated from https://github.com/MITgcm/MITgcm by the 2.2.1-MITgcm-0.1 LXR engine.

The LXR team
Valid CSS 2.1! Valid HTML 4.01!