Back to home page

MITgcm

 
 

    


File indexing completed on 2018-03-02 18:36:41 UTC

view on githubraw file Latest commit add29e06 on 2018-01-31 20:35:05 UTC
6d54cf9ca1 Ed H*0001 #include "PACKAGES_CONFIG.h"
b734cf7153 Chri*0002 #include "CPP_OPTIONS.h"
                0003 
985d9b22ad Jean*0004 C--  File external_forcing.F:
                0005 C--   Contents
                0006 C--   o EXTERNAL_FORCING_U
                0007 C--   o EXTERNAL_FORCING_V
                0008 C--   o EXTERNAL_FORCING_T
                0009 C--   o EXTERNAL_FORCING_S
                0010 
                0011 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
9366854e02 Chri*0012 CBOP
                0013 C     !ROUTINE: EXTERNAL_FORCING_U
                0014 C     !INTERFACE:
b734cf7153 Chri*0015       SUBROUTINE EXTERNAL_FORCING_U(
285db1597f Jean*0016      I           iMin,iMax, jMin,jMax, bi,bj, kLev,
                0017      I           myTime, myThid )
9366854e02 Chri*0018 C     !DESCRIPTION: \bv
                0019 C     *==========================================================*
285db1597f Jean*0020 C     | S/R EXTERNAL_FORCING_U
                0021 C     | o Contains problem specific forcing for zonal velocity.
9366854e02 Chri*0022 C     *==========================================================*
285db1597f Jean*0023 C     | Adds terms to gU for forcing by external sources
                0024 C     | e.g. wind stress, bottom friction etc ...
9366854e02 Chri*0025 C     *==========================================================*
                0026 C     \ev
                0027 
                0028 C     !USES:
1dbaea09ee Chri*0029       IMPLICIT NONE
b734cf7153 Chri*0030 C     == Global data ==
                0031 #include "SIZE.h"
                0032 #include "EEPARAMS.h"
                0033 #include "PARAMS.h"
                0034 #include "GRID.h"
                0035 #include "DYNVARS.h"
1dbaea09ee Chri*0036 #include "FFIELDS.h"
9366854e02 Chri*0037 
                0038 C     !INPUT/OUTPUT PARAMETERS:
b734cf7153 Chri*0039 C     == Routine arguments ==
285db1597f Jean*0040 C     iMin,iMax :: Working range of x-index for applying forcing.
                0041 C     jMin,jMax :: Working range of y-index for applying forcing.
                0042 C     bi,bj     :: Current tile indices
                0043 C     kLev      :: Current vertical level index
                0044 C     myTime    :: Current time in simulation
                0045 C     myThid    :: Thread Id number
b734cf7153 Chri*0046       INTEGER iMin, iMax, jMin, jMax, kLev, bi, bj
285db1597f Jean*0047       _RL myTime
39b995119f Alis*0048       INTEGER myThid
b734cf7153 Chri*0049 
b0340e9e76 Jean*0050 #ifdef USE_OLD_EXTERNAL_FORCING
9366854e02 Chri*0051 C     !LOCAL VARIABLES:
1dbaea09ee Chri*0052 C     == Local variables ==
285db1597f Jean*0053 C     i,j       :: Loop counters
015ef567d5 Jean*0054 C     kSurface  :: index of surface level
285db1597f Jean*0055       INTEGER i, j
e305438401 Mart*0056       INTEGER kSurface
9366854e02 Chri*0057 CEOP
1dbaea09ee Chri*0058 
9669509dca Jean*0059       IF ( fluidIsAir ) THEN
861b393501 Jean*0060        kSurface = 0
9669509dca Jean*0061       ELSEIF ( usingPCoords ) THEN
e305438401 Mart*0062        kSurface = Nr
9669509dca Jean*0063       ELSE
e305438401 Mart*0064        kSurface = 1
9669509dca Jean*0065       ENDIF
e305438401 Mart*0066 
1dbaea09ee Chri*0067 C--   Forcing term
861b393501 Jean*0068 #ifdef ALLOW_AIM
                0069       IF ( useAIM ) CALL AIM_TENDENCY_APPLY_U(
45e6cba2ac Jean*0070      U                       gU(1-OLx,1-OLy,kLev,bi,bj),
                0071      I                       iMin,iMax,jMin,jMax, kLev, bi,bj,
                0072      I                       myTime, 0, myThid )
861b393501 Jean*0073 #endif /* ALLOW_AIM */
285db1597f Jean*0074 
123913d7e9 Jean*0075 #ifdef ALLOW_ATM_PHYS
                0076       IF ( useAtm_Phys ) CALL ATM_PHYS_TENDENCY_APPLY_U(
45e6cba2ac Jean*0077      U                       gU(1-OLx,1-OLy,kLev,bi,bj),
                0078      I                       iMin,iMax,jMin,jMax, kLev, bi,bj,
                0079      I                       myTime, 0, myThid )
123913d7e9 Jean*0080 #endif /* ALLOW_ATM_PHYS */
                0081 
468f196fcd Andr*0082 #ifdef ALLOW_FIZHI
                0083       IF ( useFIZHI ) CALL FIZHI_TENDENCY_APPLY_U(
45e6cba2ac Jean*0084      U                       gU(1-OLx,1-OLy,kLev,bi,bj),
                0085      I                       iMin,iMax,jMin,jMax, kLev, bi,bj,
                0086      I                       myTime, 0, myThid )
468f196fcd Andr*0087 #endif /* ALLOW_FIZHI */
861b393501 Jean*0088 
015ef567d5 Jean*0089 C     Ocean: Add momentum surface forcing (e.g., wind-stress) in surface level
e305438401 Mart*0090       IF ( kLev .EQ. kSurface ) THEN
2d2555797b Jean*0091 c      DO j=1,sNy
                0092 C-jmc: Without CD-scheme, this is OK ; but with CD-scheme, needs to cover [0:sNy+1]
                0093        DO j=0,sNy+1
285db1597f Jean*0094         DO i=1,sNx+1
985d9b22ad Jean*0095           gU(i,j,kLev,bi,bj) = gU(i,j,kLev,bi,bj)
                0096      &      +foFacMom*surfaceForcingU(i,j,bi,bj)
                0097      &      *recip_drF(kLev)*_recip_hFacW(i,j,kLev,bi,bj)
                0098         ENDDO
                0099        ENDDO
                0100       ELSEIF ( kSurface.EQ.-1 ) THEN
                0101        DO j=0,sNy+1
                0102         DO i=1,sNx+1
                0103          IF ( kSurfW(i,j,bi,bj).EQ.kLev ) THEN
                0104           gU(i,j,kLev,bi,bj) = gU(i,j,kLev,bi,bj)
                0105      &      +foFacMom*surfaceForcingU(i,j,bi,bj)
                0106      &      *recip_drF(kLev)*_recip_hFacW(i,j,kLev,bi,bj)
                0107          ENDIF
1dbaea09ee Chri*0108         ENDDO
                0109        ENDDO
                0110       ENDIF
                0111 
43af9695da Gael*0112 #ifdef ALLOW_EDDYPSI
45e6cba2ac Jean*0113          CALL TAUEDDY_TENDENCY_APPLY_U(
                0114      U                 gU(1-OLx,1-OLy,kLev,bi,bj),
                0115      I                 iMin,iMax,jMin,jMax, kLev, bi,bj,
                0116      I                 myTime, 0, myThid )
ac957095b5 Patr*0117 #endif
                0118 
6515c77b5c Jean*0119 #ifdef ALLOW_RBCS
                0120       IF (useRBCS) THEN
45e6cba2ac Jean*0121         CALL RBCS_ADD_TENDENCY(
                0122      U                 gU(1-OLx,1-OLy,kLev,bi,bj),
                0123      I                 kLev, bi, bj, -1,
                0124      I                 myTime, 0, myThid )
                0125 
6515c77b5c Jean*0126       ENDIF
45e6cba2ac Jean*0127 #endif /* ALLOW_RBCS */
6515c77b5c Jean*0128 
285db1597f Jean*0129 #ifdef ALLOW_OBCS
b275747e24 Patr*0130       IF (useOBCS) THEN
45e6cba2ac Jean*0131         CALL OBCS_SPONGE_U(
                0132      U                   gU(1-OLx,1-OLy,kLev,bi,bj),
                0133      I                   iMin,iMax,jMin,jMax, kLev, bi,bj,
                0134      I                   myTime, 0, myThid )
b275747e24 Patr*0135       ENDIF
45e6cba2ac Jean*0136 #endif /* ALLOW_OBCS */
4c6b97badf Patr*0137 
2d9d0bc0a6 Jean*0138 #ifdef ALLOW_MYPACKAGE
45e6cba2ac Jean*0139       IF ( useMYPACKAGE ) THEN
                0140         CALL MYPACKAGE_TENDENCY_APPLY_U(
                0141      U                 gU(1-OLx,1-OLy,kLev,bi,bj),
                0142      I                 iMin,iMax,jMin,jMax, kLev, bi,bj,
                0143      I                 myTime, 0, myThid )
                0144       ENDIF
2d9d0bc0a6 Jean*0145 #endif /* ALLOW_MYPACKAGE */
                0146 
b0340e9e76 Jean*0147 #endif /* USE_OLD_EXTERNAL_FORCING */
b734cf7153 Chri*0148       RETURN
                0149       END
285db1597f Jean*0150 
                0151 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
9366854e02 Chri*0152 CBOP
                0153 C     !ROUTINE: EXTERNAL_FORCING_V
                0154 C     !INTERFACE:
b734cf7153 Chri*0155       SUBROUTINE EXTERNAL_FORCING_V(
285db1597f Jean*0156      I           iMin,iMax, jMin,jMax, bi,bj, kLev,
                0157      I           myTime, myThid )
9366854e02 Chri*0158 C     !DESCRIPTION: \bv
                0159 C     *==========================================================*
285db1597f Jean*0160 C     | S/R EXTERNAL_FORCING_V
                0161 C     | o Contains problem specific forcing for merid velocity.
9366854e02 Chri*0162 C     *==========================================================*
285db1597f Jean*0163 C     | Adds terms to gV for forcing by external sources
                0164 C     | e.g. wind stress, bottom friction etc ...
9366854e02 Chri*0165 C     *==========================================================*
                0166 C     \ev
                0167 
                0168 C     !USES:
1dbaea09ee Chri*0169       IMPLICIT NONE
b734cf7153 Chri*0170 C     == Global data ==
                0171 #include "SIZE.h"
                0172 #include "EEPARAMS.h"
                0173 #include "PARAMS.h"
                0174 #include "GRID.h"
                0175 #include "DYNVARS.h"
1dbaea09ee Chri*0176 #include "FFIELDS.h"
                0177 
9366854e02 Chri*0178 C     !INPUT/OUTPUT PARAMETERS:
b734cf7153 Chri*0179 C     == Routine arguments ==
285db1597f Jean*0180 C     iMin,iMax :: Working range of x-index for applying forcing.
                0181 C     jMin,jMax :: Working range of y-index for applying forcing.
                0182 C     bi,bj     :: Current tile indices
                0183 C     kLev      :: Current vertical level index
                0184 C     myTime    :: Current time in simulation
                0185 C     myThid    :: Thread Id number
b734cf7153 Chri*0186       INTEGER iMin, iMax, jMin, jMax, kLev, bi, bj
285db1597f Jean*0187       _RL myTime
39b995119f Alis*0188       INTEGER myThid
9366854e02 Chri*0189 
b0340e9e76 Jean*0190 #ifdef USE_OLD_EXTERNAL_FORCING
9366854e02 Chri*0191 C     !LOCAL VARIABLES:
1dbaea09ee Chri*0192 C     == Local variables ==
285db1597f Jean*0193 C     i,j       :: Loop counters
015ef567d5 Jean*0194 C     kSurface  :: index of surface level
285db1597f Jean*0195       INTEGER i, j
e305438401 Mart*0196       INTEGER kSurface
9366854e02 Chri*0197 CEOP
1dbaea09ee Chri*0198 
9669509dca Jean*0199       IF ( fluidIsAir ) THEN
861b393501 Jean*0200        kSurface = 0
9669509dca Jean*0201       ELSEIF ( usingPCoords ) THEN
e305438401 Mart*0202        kSurface = Nr
9669509dca Jean*0203       ELSE
e305438401 Mart*0204        kSurface = 1
9669509dca Jean*0205       ENDIF
e305438401 Mart*0206 
1dbaea09ee Chri*0207 C--   Forcing term
861b393501 Jean*0208 #ifdef ALLOW_AIM
                0209       IF ( useAIM ) CALL AIM_TENDENCY_APPLY_V(
45e6cba2ac Jean*0210      U                       gV(1-OLx,1-OLy,kLev,bi,bj),
                0211      I                       iMin,iMax,jMin,jMax, kLev, bi,bj,
                0212      I                       myTime, 0, myThid )
861b393501 Jean*0213 #endif /* ALLOW_AIM */
                0214 
123913d7e9 Jean*0215 #ifdef ALLOW_ATM_PHYS
                0216       IF ( useAtm_Phys ) CALL ATM_PHYS_TENDENCY_APPLY_V(
45e6cba2ac Jean*0217      U                       gV(1-OLx,1-OLy,kLev,bi,bj),
                0218      I                       iMin,iMax,jMin,jMax, kLev, bi,bj,
                0219      I                       myTime, 0, myThid )
123913d7e9 Jean*0220 #endif /* ALLOW_ATM_PHYS */
                0221 
468f196fcd Andr*0222 #ifdef ALLOW_FIZHI
                0223       IF ( useFIZHI ) CALL FIZHI_TENDENCY_APPLY_V(
45e6cba2ac Jean*0224      U                       gV(1-OLx,1-OLy,kLev,bi,bj),
                0225      I                       iMin,iMax,jMin,jMax, kLev, bi,bj,
                0226      I                       myTime, 0, myThid )
468f196fcd Andr*0227 #endif /* ALLOW_FIZHI */
285db1597f Jean*0228 
015ef567d5 Jean*0229 C     Ocean: Add momentum surface forcing (e.g., wind-stress) in surface level
e305438401 Mart*0230       IF ( kLev .EQ. kSurface ) THEN
285db1597f Jean*0231        DO j=1,sNy+1
2d2555797b Jean*0232 c       DO i=1,sNx
                0233 C-jmc: Without CD-scheme, this is OK ; but with CD-scheme, needs to cover [0:sNx+1]
                0234         DO i=0,sNx+1
985d9b22ad Jean*0235           gV(i,j,kLev,bi,bj) = gV(i,j,kLev,bi,bj)
                0236      &      +foFacMom*surfaceForcingV(i,j,bi,bj)
                0237      &      *recip_drF(kLev)*_recip_hFacS(i,j,kLev,bi,bj)
                0238         ENDDO
                0239        ENDDO
                0240       ELSEIF ( kSurface.EQ.-1 ) THEN
                0241        DO j=1,sNy+1
                0242         DO i=0,sNx+1
                0243          IF ( kSurfS(i,j,bi,bj).EQ.kLev ) THEN
                0244           gV(i,j,kLev,bi,bj) = gV(i,j,kLev,bi,bj)
                0245      &      +foFacMom*surfaceForcingV(i,j,bi,bj)
                0246      &      *recip_drF(kLev)*_recip_hFacS(i,j,kLev,bi,bj)
                0247          ENDIF
1dbaea09ee Chri*0248         ENDDO
                0249        ENDDO
                0250       ENDIF
b734cf7153 Chri*0251 
43af9695da Gael*0252 #ifdef ALLOW_EDDYPSI
45e6cba2ac Jean*0253          CALL TAUEDDY_TENDENCY_APPLY_V(
                0254      U                 gV(1-OLx,1-OLy,kLev,bi,bj),
                0255      I                 iMin,iMax,jMin,jMax, kLev, bi,bj,
                0256      I                 myTime, 0, myThid )
ac957095b5 Patr*0257 #endif
                0258 
6515c77b5c Jean*0259 #ifdef ALLOW_RBCS
                0260       IF (useRBCS) THEN
45e6cba2ac Jean*0261         CALL RBCS_ADD_TENDENCY(
                0262      U                 gV(1-OLx,1-OLy,kLev,bi,bj),
                0263      I                 kLev, bi, bj, -2,
                0264      I                 myTime, 0, myThid )
6515c77b5c Jean*0265       ENDIF
45e6cba2ac Jean*0266 #endif /* ALLOW_RBCS */
6515c77b5c Jean*0267 
285db1597f Jean*0268 #ifdef ALLOW_OBCS
b275747e24 Patr*0269       IF (useOBCS) THEN
45e6cba2ac Jean*0270         CALL OBCS_SPONGE_V(
                0271      U                   gV(1-OLx,1-OLy,kLev,bi,bj),
                0272      I                   iMin,iMax,jMin,jMax, kLev, bi,bj,
                0273      I                   myTime, 0, myThid )
b275747e24 Patr*0274       ENDIF
45e6cba2ac Jean*0275 #endif /* ALLOW_OBCS */
4c6b97badf Patr*0276 
2d9d0bc0a6 Jean*0277 #ifdef ALLOW_MYPACKAGE
45e6cba2ac Jean*0278       IF ( useMYPACKAGE ) THEN
                0279         CALL MYPACKAGE_TENDENCY_APPLY_V(
                0280      U                 gV(1-OLx,1-OLy,kLev,bi,bj),
                0281      I                 iMin,iMax,jMin,jMax, kLev, bi,bj,
                0282      I                 myTime, 0, myThid )
                0283       ENDIF
2d9d0bc0a6 Jean*0284 #endif /* ALLOW_MYPACKAGE */
                0285 
b0340e9e76 Jean*0286 #endif /* USE_OLD_EXTERNAL_FORCING */
b734cf7153 Chri*0287       RETURN
                0288       END
285db1597f Jean*0289 
                0290 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
9366854e02 Chri*0291 CBOP
                0292 C     !ROUTINE: EXTERNAL_FORCING_T
                0293 C     !INTERFACE:
b734cf7153 Chri*0294       SUBROUTINE EXTERNAL_FORCING_T(
285db1597f Jean*0295      I           iMin,iMax, jMin,jMax, bi,bj, kLev,
                0296      I           myTime, myThid )
9366854e02 Chri*0297 C     !DESCRIPTION: \bv
                0298 C     *==========================================================*
285db1597f Jean*0299 C     | S/R EXTERNAL_FORCING_T
                0300 C     | o Contains problem specific forcing for temperature.
9366854e02 Chri*0301 C     *==========================================================*
285db1597f Jean*0302 C     | Adds terms to gT for forcing by external sources
                0303 C     | e.g. heat flux, climatalogical relaxation, etc ...
9366854e02 Chri*0304 C     *==========================================================*
                0305 C     \ev
                0306 
                0307 C     !USES:
1dbaea09ee Chri*0308       IMPLICIT NONE
b734cf7153 Chri*0309 C     == Global data ==
                0310 #include "SIZE.h"
                0311 #include "EEPARAMS.h"
                0312 #include "PARAMS.h"
                0313 #include "GRID.h"
                0314 #include "DYNVARS.h"
                0315 #include "FFIELDS.h"
f2d1ba7d38 Davi*0316 #include "SURFACE.h"
77af23a186 Patr*0317 
9366854e02 Chri*0318 C     !INPUT/OUTPUT PARAMETERS:
b734cf7153 Chri*0319 C     == Routine arguments ==
285db1597f Jean*0320 C     iMin,iMax :: Working range of x-index for applying forcing.
                0321 C     jMin,jMax :: Working range of y-index for applying forcing.
                0322 C     bi,bj     :: Current tile indices
                0323 C     kLev      :: Current vertical level index
                0324 C     myTime    :: Current time in simulation
                0325 C     myThid    :: Thread Id number
b734cf7153 Chri*0326       INTEGER iMin, iMax, jMin, jMax, kLev, bi, bj
285db1597f Jean*0327       _RL myTime
39b995119f Alis*0328       INTEGER myThid
b734cf7153 Chri*0329 
b0340e9e76 Jean*0330 #ifdef USE_OLD_EXTERNAL_FORCING
9366854e02 Chri*0331 C     !LOCAL VARIABLES:
1dbaea09ee Chri*0332 C     == Local variables ==
285db1597f Jean*0333 C     i,j       :: Loop counters
015ef567d5 Jean*0334 C     kSurface  :: index of surface level
285db1597f Jean*0335       INTEGER i, j
e305438401 Mart*0336       INTEGER kSurface
015ef567d5 Jean*0337       INTEGER km, kc, kp
                0338       _RL tmpVar(1:sNx,1:sNy)
                0339       _RL tmpFac, delPI
faf82d94de Patr*0340       _RL recip_Cp
285db1597f Jean*0341 CEOP
7b9cf8f7da Jean*0342 #ifdef SHORTWAVE_HEATING
                0343       _RL minusone
015ef567d5 Jean*0344       PARAMETER (minusOne=-1.)
                0345       _RL swfracb(2)
7b9cf8f7da Jean*0346       INTEGER kp1
                0347 #endif
1dbaea09ee Chri*0348 
9669509dca Jean*0349       IF ( fluidIsAir ) THEN
861b393501 Jean*0350        kSurface = 0
985d9b22ad Jean*0351       ELSEIF ( usingZCoords .AND. useShelfIce ) THEN
                0352        kSurface = -1
9669509dca Jean*0353       ELSEIF ( usingPCoords ) THEN
e305438401 Mart*0354        kSurface = Nr
9669509dca Jean*0355       ELSE
e305438401 Mart*0356        kSurface = 1
9669509dca Jean*0357       ENDIF
faf82d94de Patr*0358       recip_Cp = 1. _d 0 / HeatCapacity_Cp
e305438401 Mart*0359 
1dbaea09ee Chri*0360 C--   Forcing term
861b393501 Jean*0361 #ifdef ALLOW_AIM
                0362       IF ( useAIM ) CALL AIM_TENDENCY_APPLY_T(
45e6cba2ac Jean*0363      U                       gT(1-OLx,1-OLy,kLev,bi,bj),
                0364      I                       iMin,iMax,jMin,jMax, kLev, bi,bj,
                0365      I                       myTime, 0, myThid )
861b393501 Jean*0366 #endif /* ALLOW_AIM */
                0367 
123913d7e9 Jean*0368 #ifdef ALLOW_ATM_PHYS
                0369       IF ( useAtm_Phys ) CALL ATM_PHYS_TENDENCY_APPLY_T(
45e6cba2ac Jean*0370      U                       gT(1-OLx,1-OLy,kLev,bi,bj),
                0371      I                       iMin,iMax,jMin,jMax, kLev, bi,bj,
                0372      I                       myTime, 0, myThid )
123913d7e9 Jean*0373 #endif /* ALLOW_ATM_PHYS */
                0374 
468f196fcd Andr*0375 #ifdef ALLOW_FIZHI
                0376       IF ( useFIZHI ) CALL FIZHI_TENDENCY_APPLY_T(
45e6cba2ac Jean*0377      U                       gT(1-OLx,1-OLy,kLev,bi,bj),
                0378      I                       iMin,iMax,jMin,jMax, kLev, bi,bj,
                0379      I                       myTime, 0, myThid )
468f196fcd Andr*0380 #endif /* ALLOW_FIZHI */
d8206d87ee Patr*0381 
1387d73548 Jean*0382 #ifdef ALLOW_ADDFLUID
80d98e0151 Dimi*0383       IF ( selectAddFluid.NE.0 .AND. temp_addMass.NE.UNSET_RL ) THEN
1387d73548 Jean*0384        IF ( ( selectAddFluid.GE.1 .AND. nonlinFreeSurf.GT.0 )
                0385      &      .OR. convertFW2Salt.EQ.-1. _d 0 ) THEN
                0386          DO j=1,sNy
                0387           DO i=1,sNx
                0388             gT(i,j,kLev,bi,bj) = gT(i,j,kLev,bi,bj)
                0389      &        + addMass(i,j,kLev,bi,bj)*mass2rUnit
80d98e0151 Dimi*0390      &          *( temp_addMass - theta(i,j,kLev,bi,bj) )
1387d73548 Jean*0391      &          *recip_rA(i,j,bi,bj)
                0392      &          *recip_drF(kLev)*_recip_hFacC(i,j,kLev,bi,bj)
                0393 C    &          *recip_deepFac2C(kLev)*recip_rhoFacC(kLev)
                0394           ENDDO
                0395          ENDDO
                0396        ELSE
                0397          DO j=1,sNy
                0398           DO i=1,sNx
                0399             gT(i,j,kLev,bi,bj) = gT(i,j,kLev,bi,bj)
                0400      &        + addMass(i,j,kLev,bi,bj)*mass2rUnit
80d98e0151 Dimi*0401      &          *( temp_addMass - tRef(kLev) )
1387d73548 Jean*0402      &          *recip_rA(i,j,bi,bj)
                0403      &          *recip_drF(kLev)*_recip_hFacC(i,j,kLev,bi,bj)
                0404 C    &          *recip_deepFac2C(kLev)*recip_rhoFacC(kLev)
                0405           ENDDO
                0406          ENDDO
                0407        ENDIF
                0408       ENDIF
                0409 #endif /* ALLOW_ADDFLUID */
                0410 
a7ae998c8d Jean*0411 #ifdef ALLOW_FRICTION_HEATING
                0412       IF ( addFrictionHeating ) THEN
                0413         IF ( fluidIsAir ) THEN
                0414 C         conversion from in-situ Temp to Pot.Temp
                0415           tmpFac = (atm_Po/rC(kLev))**atm_kappa
                0416 C         conversion from W/m^2/r_unit to K/s
                0417           tmpFac = (tmpFac/atm_Cp) * mass2rUnit
                0418         ELSE
                0419 C         conversion from W/m^2/r_unit to K/s
faf82d94de Patr*0420           tmpFac = recip_Cp * mass2rUnit
a7ae998c8d Jean*0421         ENDIF
                0422         DO j=1,sNy
                0423           DO i=1,sNx
                0424             gT(i,j,kLev,bi,bj) = gT(i,j,kLev,bi,bj)
e24c9bfc82 Jean*0425      &         + frictionHeating(i,j,k,bi,bj)*tmpFac
a7ae998c8d Jean*0426      &          *recip_drF(kLev)*_recip_hFacC(i,j,kLev,bi,bj)
                0427           ENDDO
                0428         ENDDO
                0429       ENDIF
                0430 #endif /* ALLOW_FRICTION_HEATING */
                0431 
015ef567d5 Jean*0432       IF ( fluidIsAir .AND. atm_Rq.NE.zeroRL .AND. Nr.NE.1 ) THEN
                0433 C--   Compressible fluid: account for difference between moist and dry air
                0434 C     specific volume in Enthalpy equation (+ V.dP term), since only the
                0435 C     dry air part is accounted for in the (dry) Pot.Temp formulation.
                0436 C     Used centered averaging from interface to center (consistent with
                0437 C     conversion term in KE eq) and same discretisation ( [T*Q]_bar_k )
                0438 C     as for Theta_v in CALC_PHI_HYD
                0439 
                0440 C     conversion from in-situ Temp to Pot.Temp
                0441         tmpFac = (atm_Po/rC(kLev))**atm_kappa
                0442 C     conversion from W/kg to K/s
                0443         tmpFac = tmpFac/atm_Cp
                0444         km = kLev-1
                0445         kc = kLev
                0446         kp = kLev+1
                0447         IF ( kLev.EQ.1 ) THEN
                0448           DO j=1,sNy
                0449            DO i=1,sNx
                0450             tmpVar(i,j) = 0.
                0451            ENDDO
                0452           ENDDO
                0453         ELSE
                0454           delPI = atm_Cp*( (rC(km)/atm_Po)**atm_kappa
                0455      &                   - (rC(kc)/atm_Po)**atm_kappa )
                0456           DO j=1,sNy
                0457            DO i=1,sNx
                0458             tmpVar(i,j) = wVel(i,j,kc,bi,bj)*delPI*atm_Rq
                0459      &                  *( theta(i,j,km,bi,bj)*salt(i,j,km,bi,bj)
                0460      &                   + theta(i,j,kc,bi,bj)*salt(i,j,kc,bi,bj)
                0461      &                   )*maskC(i,j,km,bi,bj)*0.25 _d 0
                0462            ENDDO
                0463           ENDDO
                0464         ENDIF
                0465         IF ( kLev.LT.Nr ) THEN
                0466           delPI = atm_Cp*( (rC(kc)/atm_Po)**atm_kappa
                0467      &                   - (rC(kp)/atm_Po)**atm_kappa )
                0468           DO j=1,sNy
                0469            DO i=1,sNx
                0470             tmpVar(i,j) = tmpVar(i,j)
                0471      &                  + wVel(i,j,kp,bi,bj)*delPI*atm_Rq
                0472      &                  *( theta(i,j,kc,bi,bj)*salt(i,j,kc,bi,bj)
                0473      &                   + theta(i,j,kp,bi,bj)*salt(i,j,kp,bi,bj)
                0474      &                   )*maskC(i,j,kp,bi,bj)*0.25 _d 0
                0475            ENDDO
                0476           ENDDO
                0477         ENDIF
                0478         DO j=1,sNy
                0479           DO i=1,sNx
                0480             gT(i,j,kLev,bi,bj) = gT(i,j,kLev,bi,bj)
                0481      &         + tmpVar(i,j)*tmpFac
                0482      &          *recip_drF(kLev)*_recip_hFacC(i,j,kLev,bi,bj)
                0483           ENDDO
                0484         ENDDO
                0485 #ifdef ALLOW_DIAGNOSTICS
                0486         IF ( useDiagnostics ) THEN
                0487 C     conversion to W/m^2
                0488           tmpFac = rUnit2mass
                0489           CALL DIAGNOSTICS_SCALE_FILL( tmpVar, tmpFac, 1,
                0490      &                     'MoistCor', kc, 1, 3, bi,bj,myThid )
                0491         ENDIF
                0492 #endif /* ALLOW_DIAGNOSTICS */
                0493       ENDIF
                0494 
                0495 C     Ocean: Add temperature surface forcing (e.g., heat-flux) in surface level
e305438401 Mart*0496       IF ( kLev .EQ. kSurface ) THEN
285db1597f Jean*0497        DO j=1,sNy
                0498         DO i=1,sNx
985d9b22ad Jean*0499           gT(i,j,kLev,bi,bj)=gT(i,j,kLev,bi,bj)
                0500      &      +surfaceForcingT(i,j,bi,bj)
                0501      &      *recip_drF(kLev)*_recip_hFacC(i,j,kLev,bi,bj)
                0502         ENDDO
                0503        ENDDO
                0504       ELSEIF ( kSurface.EQ.-1 ) THEN
                0505        DO j=1,sNy
                0506         DO i=1,sNx
                0507          IF ( kSurfC(i,j,bi,bj).EQ.kLev ) THEN
                0508           gT(i,j,kLev,bi,bj)=gT(i,j,kLev,bi,bj)
                0509      &      +surfaceForcingT(i,j,bi,bj)
                0510      &      *recip_drF(kLev)*_recip_hFacC(i,j,kLev,bi,bj)
                0511          ENDIF
1dbaea09ee Chri*0512         ENDDO
                0513        ENDDO
                0514       ENDIF
                0515 
f2d1ba7d38 Davi*0516       IF (linFSConserveTr) THEN
                0517        DO j=1,sNy
                0518         DO i=1,sNx
a7ae998c8d Jean*0519           IF (kLev .EQ. kSurfC(i,j,bi,bj)) THEN
f2d1ba7d38 Davi*0520             gT(i,j,kLev,bi,bj)=gT(i,j,kLev,bi,bj)
                0521      &        +TsurfCor*recip_drF(kLev)*_recip_hFacC(i,j,kLev,bi,bj)
                0522           ENDIF
                0523         ENDDO
                0524        ENDDO
                0525       ENDIF
                0526 
fb3dc7d949 Alis*0527 #ifdef SHORTWAVE_HEATING
                0528 C Penetrating SW radiation
285db1597f Jean*0529 c     IF ( usePenetratingSW ) THEN
45e6cba2ac Jean*0530        swfracb(1)=abs(rF(kLev))
                0531        swfracb(2)=abs(rF(kLev+1))
285db1597f Jean*0532        CALL SWFRAC(
015ef567d5 Jean*0533      I             2, minusOne,
70f67f70d4 Jean*0534      U             swfracb,
                0535      I             myTime, 1, myThid )
45e6cba2ac Jean*0536        kp1 = kLev+1
                0537        IF (kLev.EQ.Nr) THEN
                0538         kp1 = kLev
7b9cf8f7da Jean*0539         swfracb(2)=0. _d 0
285db1597f Jean*0540        ENDIF
                0541        DO j=1,sNy
                0542         DO i=1,sNx
45e6cba2ac Jean*0543          gT(i,j,kLev,bi,bj) = gT(i,j,kLev,bi,bj)
                0544      &   -Qsw(i,j,bi,bj)*(swfracb(1)*maskC(i,j,kLev,bi,bj)
7b9cf8f7da Jean*0545      &                   -swfracb(2)*maskC(i,j,kp1, bi,bj))
faf82d94de Patr*0546      &    *recip_Cp*mass2rUnit
45e6cba2ac Jean*0547      &    *recip_drF(kLev)*_recip_hFacC(i,j,kLev,bi,bj)
285db1597f Jean*0548         ENDDO
fb3dc7d949 Alis*0549        ENDDO
285db1597f Jean*0550 c     ENDIF
fb3dc7d949 Alis*0551 #endif
4c6b97badf Patr*0552 
45e6cba2ac Jean*0553 #ifdef ALLOW_FRAZIL
                0554       IF ( useFRAZIL )
                0555      &     CALL FRAZIL_TENDENCY_APPLY_T(
                0556      U                 gT(1-OLx,1-OLy,kLev,bi,bj),
                0557      I                 iMin,iMax,jMin,jMax, kLev, bi,bj,
                0558      I                 myTime, 0, myThid )
                0559 #endif /* ALLOW_FRAZIL */
                0560 
                0561 #ifdef ALLOW_SHELFICE
                0562       IF ( useShelfIce )
                0563      &     CALL SHELFICE_FORCING_T(
                0564      U                   gT(1-OLx,1-OLy,kLev,bi,bj),
                0565      I                   iMin,iMax,jMin,jMax, kLev, bi,bj,
                0566      I                   myTime, 0, myThid )
                0567 #endif /* ALLOW_SHELFICE */
                0568 
                0569 #ifdef ALLOW_ICEFRONT
                0570       IF ( useICEFRONT )
                0571      &     CALL ICEFRONT_TENDENCY_APPLY_T(
                0572      U                   gT(1-OLx,1-OLy,kLev,bi,bj),
                0573      I                   kLev, bi, bj, myTime, 0, myThid )
                0574 #endif /* ALLOW_ICEFRONT */
                0575 
bbffc59522 An T*0576 #ifdef ALLOW_SALT_PLUME
                0577       IF ( useSALT_PLUME )
                0578      &     CALL SALT_PLUME_TENDENCY_APPLY_T(
45e6cba2ac Jean*0579      U                     gT(1-OLx,1-OLy,kLev,bi,bj),
                0580      I                     iMin,iMax,jMin,jMax, kLev, bi,bj,
                0581      I                     myTime, 0, myThid )
bbffc59522 An T*0582 #endif /* ALLOW_SALT_PLUME */
                0583 
c754af56ea Step*0584 #ifdef ALLOW_RBCS
45e6cba2ac Jean*0585       IF (useRBCS) THEN
                0586         CALL RBCS_ADD_TENDENCY(
                0587      U                 gT(1-OLx,1-OLy,kLev,bi,bj),
                0588      I                 kLev, bi, bj, 1,
                0589      I                 myTime, 0, myThid )
                0590       ENDIF
                0591 #endif /* ALLOW_RBCS */
c754af56ea Step*0592 
285db1597f Jean*0593 #ifdef ALLOW_OBCS
b275747e24 Patr*0594       IF (useOBCS) THEN
45e6cba2ac Jean*0595         CALL OBCS_SPONGE_T(
                0596      U                   gT(1-OLx,1-OLy,kLev,bi,bj),
                0597      I                   iMin,iMax,jMin,jMax, kLev, bi,bj,
                0598      I                   myTime, 0, myThid )
b275747e24 Patr*0599       ENDIF
45e6cba2ac Jean*0600 #endif /* ALLOW_OBCS */
4c6b97badf Patr*0601 
15338fa568 Dimi*0602 #ifdef ALLOW_BBL
                0603       IF ( useBBL ) CALL BBL_TENDENCY_APPLY_T(
45e6cba2ac Jean*0604      U                       gT(1-OLx,1-OLy,kLev,bi,bj),
                0605      I                       iMin,iMax,jMin,jMax, kLev, bi,bj,
                0606      I                       myTime, 0, myThid )
15338fa568 Dimi*0607 #endif /* ALLOW_BBL */
                0608 
2d9d0bc0a6 Jean*0609 #ifdef ALLOW_MYPACKAGE
45e6cba2ac Jean*0610       IF ( useMYPACKAGE ) THEN
                0611         CALL MYPACKAGE_TENDENCY_APPLY_T(
                0612      U                 gT(1-OLx,1-OLy,kLev,bi,bj),
                0613      I                 iMin,iMax,jMin,jMax, kLev, bi,bj,
                0614      I                 myTime, 0, myThid )
                0615       ENDIF
2d9d0bc0a6 Jean*0616 #endif /* ALLOW_MYPACKAGE */
                0617 
b0340e9e76 Jean*0618 #endif /* USE_OLD_EXTERNAL_FORCING */
b734cf7153 Chri*0619       RETURN
                0620       END
285db1597f Jean*0621 
                0622 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
9366854e02 Chri*0623 CBOP
                0624 C     !ROUTINE: EXTERNAL_FORCING_S
                0625 C     !INTERFACE:
b734cf7153 Chri*0626       SUBROUTINE EXTERNAL_FORCING_S(
285db1597f Jean*0627      I           iMin,iMax, jMin,jMax, bi,bj, kLev,
                0628      I           myTime, myThid )
b734cf7153 Chri*0629 
9366854e02 Chri*0630 C     !DESCRIPTION: \bv
                0631 C     *==========================================================*
285db1597f Jean*0632 C     | S/R EXTERNAL_FORCING_S
                0633 C     | o Contains problem specific forcing for merid velocity.
9366854e02 Chri*0634 C     *==========================================================*
285db1597f Jean*0635 C     | Adds terms to gS for forcing by external sources
                0636 C     | e.g. fresh-water flux, climatalogical relaxation, etc ...
9366854e02 Chri*0637 C     *==========================================================*
                0638 C     \ev
                0639 
                0640 C     !USES:
                0641       IMPLICIT NONE
b734cf7153 Chri*0642 C     == Global data ==
                0643 #include "SIZE.h"
                0644 #include "EEPARAMS.h"
                0645 #include "PARAMS.h"
                0646 #include "GRID.h"
                0647 #include "DYNVARS.h"
1dbaea09ee Chri*0648 #include "FFIELDS.h"
f2d1ba7d38 Davi*0649 #include "SURFACE.h"
b734cf7153 Chri*0650 
9366854e02 Chri*0651 C     !INPUT/OUTPUT PARAMETERS:
b734cf7153 Chri*0652 C     == Routine arguments ==
285db1597f Jean*0653 C     iMin,iMax :: Working range of x-index for applying forcing.
                0654 C     jMin,jMax :: Working range of y-index for applying forcing.
                0655 C     bi,bj     :: Current tile indices
                0656 C     kLev      :: Current vertical level index
                0657 C     myTime    :: Current time in simulation
                0658 C     myThid    :: Thread Id number
b734cf7153 Chri*0659       INTEGER iMin, iMax, jMin, jMax, kLev, bi, bj
285db1597f Jean*0660       _RL myTime
39b995119f Alis*0661       INTEGER myThid
b734cf7153 Chri*0662 
b0340e9e76 Jean*0663 #ifdef USE_OLD_EXTERNAL_FORCING
9366854e02 Chri*0664 C     !LOCAL VARIABLES:
1dbaea09ee Chri*0665 C     == Local variables ==
285db1597f Jean*0666 C     i,j       :: Loop counters
015ef567d5 Jean*0667 C     kSurface  :: index of surface level
285db1597f Jean*0668       INTEGER i, j
e305438401 Mart*0669       INTEGER kSurface
9366854e02 Chri*0670 CEOP
1dbaea09ee Chri*0671 
9669509dca Jean*0672       IF ( fluidIsAir ) THEN
861b393501 Jean*0673        kSurface = 0
985d9b22ad Jean*0674       ELSEIF ( usingZCoords .AND. useShelfIce ) THEN
                0675        kSurface = -1
9669509dca Jean*0676       ELSEIF ( usingPCoords ) THEN
e305438401 Mart*0677        kSurface = Nr
9669509dca Jean*0678       ELSE
e305438401 Mart*0679        kSurface = 1
9669509dca Jean*0680       ENDIF
e305438401 Mart*0681 
1dbaea09ee Chri*0682 C--   Forcing term
861b393501 Jean*0683 #ifdef ALLOW_AIM
                0684       IF ( useAIM ) CALL AIM_TENDENCY_APPLY_S(
45e6cba2ac Jean*0685      U                       gS(1-OLx,1-OLy,kLev,bi,bj),
                0686      I                       iMin,iMax,jMin,jMax, kLev, bi,bj,
                0687      I                       myTime, 0, myThid )
861b393501 Jean*0688 #endif /* ALLOW_AIM */
                0689 
123913d7e9 Jean*0690 #ifdef ALLOW_ATM_PHYS
                0691       IF ( useAtm_Phys ) CALL ATM_PHYS_TENDENCY_APPLY_S(
45e6cba2ac Jean*0692      U                       gS(1-OLx,1-OLy,kLev,bi,bj),
                0693      I                       iMin,iMax,jMin,jMax, kLev, bi,bj,
                0694      I                       myTime, 0, myThid )
123913d7e9 Jean*0695 #endif /* ALLOW_ATM_PHYS */
                0696 
468f196fcd Andr*0697 #ifdef ALLOW_FIZHI
                0698       IF ( useFIZHI ) CALL FIZHI_TENDENCY_APPLY_S(
45e6cba2ac Jean*0699      U                       gS(1-OLx,1-OLy,kLev,bi,bj),
                0700      I                       iMin,iMax,jMin,jMax, kLev, bi,bj,
                0701      I                       myTime, 0, myThid )
468f196fcd Andr*0702 #endif /* ALLOW_FIZHI */
d8206d87ee Patr*0703 
1387d73548 Jean*0704 #ifdef ALLOW_ADDFLUID
80d98e0151 Dimi*0705       IF ( selectAddFluid.NE.0 .AND. salt_addMass.NE.UNSET_RL ) THEN
1387d73548 Jean*0706        IF ( ( selectAddFluid.GE.1 .AND. nonlinFreeSurf.GT.0 )
                0707      &      .OR. convertFW2Salt.EQ.-1. _d 0 ) THEN
                0708          DO j=1,sNy
                0709           DO i=1,sNx
                0710             gS(i,j,kLev,bi,bj) = gS(i,j,kLev,bi,bj)
                0711      &        + addMass(i,j,kLev,bi,bj)*mass2rUnit
80d98e0151 Dimi*0712      &          *( salt_addMass - salt(i,j,kLev,bi,bj) )
1387d73548 Jean*0713      &          *recip_rA(i,j,bi,bj)
                0714      &          *recip_drF(kLev)*_recip_hFacC(i,j,kLev,bi,bj)
                0715 C    &          *recip_deepFac2C(kLev)*recip_rhoFacC(kLev)
                0716           ENDDO
                0717          ENDDO
                0718        ELSE
                0719          DO j=1,sNy
                0720           DO i=1,sNx
                0721             gS(i,j,kLev,bi,bj) = gS(i,j,kLev,bi,bj)
                0722      &        + addMass(i,j,kLev,bi,bj)*mass2rUnit
80d98e0151 Dimi*0723      &          *( salt_addMass - sRef(kLev) )
1387d73548 Jean*0724      &          *recip_rA(i,j,bi,bj)
                0725      &          *recip_drF(kLev)*_recip_hFacC(i,j,kLev,bi,bj)
                0726 C    &          *recip_deepFac2C(kLev)*recip_rhoFacC(kLev)
                0727           ENDDO
                0728          ENDDO
                0729        ENDIF
                0730       ENDIF
                0731 #endif /* ALLOW_ADDFLUID */
                0732 
015ef567d5 Jean*0733 C     Ocean: Add salinity surface forcing (e.g., fresh-water) in surface level
e305438401 Mart*0734       IF ( kLev .EQ. kSurface ) THEN
285db1597f Jean*0735        DO j=1,sNy
                0736         DO i=1,sNx
985d9b22ad Jean*0737           gS(i,j,kLev,bi,bj)=gS(i,j,kLev,bi,bj)
                0738      &      +surfaceForcingS(i,j,bi,bj)
                0739      &      *recip_drF(kLev)*_recip_hFacC(i,j,kLev,bi,bj)
                0740         ENDDO
                0741        ENDDO
                0742       ELSEIF ( kSurface.EQ.-1 ) THEN
                0743        DO j=1,sNy
                0744         DO i=1,sNx
                0745          IF ( kSurfC(i,j,bi,bj).EQ.kLev ) THEN
                0746           gS(i,j,kLev,bi,bj)=gS(i,j,kLev,bi,bj)
                0747      &      +surfaceForcingS(i,j,bi,bj)
                0748      &      *recip_drF(kLev)*_recip_hFacC(i,j,kLev,bi,bj)
                0749          ENDIF
1dbaea09ee Chri*0750         ENDDO
                0751        ENDDO
                0752       ENDIF
                0753 
f2d1ba7d38 Davi*0754       IF (linFSConserveTr) THEN
                0755        DO j=1,sNy
                0756         DO i=1,sNx
a7ae998c8d Jean*0757           IF (kLev .EQ. kSurfC(i,j,bi,bj)) THEN
f2d1ba7d38 Davi*0758             gS(i,j,kLev,bi,bj)=gS(i,j,kLev,bi,bj)
                0759      &        +SsurfCor*recip_drF(kLev)*_recip_hFacC(i,j,kLev,bi,bj)
                0760           ENDIF
                0761         ENDDO
                0762        ENDDO
                0763       ENDIF
                0764 
a6cbc7a360 Mart*0765 #ifdef ALLOW_SHELFICE
                0766       IF ( useShelfIce )
                0767      &     CALL SHELFICE_FORCING_S(
45e6cba2ac Jean*0768      U                   gS(1-OLx,1-OLy,kLev,bi,bj),
                0769      I                   iMin,iMax,jMin,jMax, kLev, bi,bj,
                0770      I                   myTime, 0, myThid )
a6cbc7a360 Mart*0771 #endif /* ALLOW_SHELFICE */
                0772 
5da8ce63fa Dimi*0773 #ifdef ALLOW_ICEFRONT
e5c5488a84 Dimi*0774       IF ( useICEFRONT )
                0775      &     CALL ICEFRONT_TENDENCY_APPLY_S(
45e6cba2ac Jean*0776      U                   gS(1-OLx,1-OLy,kLev,bi,bj),
                0777      I                   kLev, bi, bj, myTime, 0, myThid )
5da8ce63fa Dimi*0778 #endif /* ALLOW_ICEFRONT */
                0779 
8c3259a14c Dimi*0780 #ifdef ALLOW_SALT_PLUME
b5aa60a554 Dimi*0781       IF ( useSALT_PLUME )
e4775240e5 Dimi*0782      &     CALL SALT_PLUME_TENDENCY_APPLY_S(
45e6cba2ac Jean*0783      U                     gS(1-OLx,1-OLy,kLev,bi,bj),
                0784      I                     iMin,iMax,jMin,jMax, kLev, bi,bj,
                0785      I                     myTime, 0, myThid )
8c3259a14c Dimi*0786 #endif /* ALLOW_SALT_PLUME */
                0787 
c754af56ea Step*0788 #ifdef ALLOW_RBCS
45e6cba2ac Jean*0789       IF (useRBCS) THEN
                0790         CALL RBCS_ADD_TENDENCY(
                0791      U                 gS(1-OLx,1-OLy,kLev,bi,bj),
                0792      I                 kLev, bi, bj, 2,
                0793      I                 myTime, 0, myThid )
                0794       ENDIF
8c3259a14c Dimi*0795 #endif /* ALLOW_RBCS */
c754af56ea Step*0796 
285db1597f Jean*0797 #ifdef ALLOW_OBCS
b275747e24 Patr*0798       IF (useOBCS) THEN
45e6cba2ac Jean*0799         CALL OBCS_SPONGE_S(
                0800      U                   gS(1-OLx,1-OLy,kLev,bi,bj),
                0801      I                   iMin,iMax,jMin,jMax, kLev, bi,bj,
                0802      I                   myTime, 0, myThid )
b275747e24 Patr*0803       ENDIF
8c3259a14c Dimi*0804 #endif /* ALLOW_OBCS */
4c6b97badf Patr*0805 
15338fa568 Dimi*0806 #ifdef ALLOW_BBL
                0807       IF ( useBBL ) CALL BBL_TENDENCY_APPLY_S(
45e6cba2ac Jean*0808      U                       gS(1-OLx,1-OLy,kLev,bi,bj),
                0809      I                       iMin,iMax,jMin,jMax, kLev, bi,bj,
                0810      I                       myTime, 0, myThid )
15338fa568 Dimi*0811 #endif /* ALLOW_BBL */
                0812 
2d9d0bc0a6 Jean*0813 #ifdef ALLOW_MYPACKAGE
45e6cba2ac Jean*0814       IF ( useMYPACKAGE ) THEN
                0815         CALL MYPACKAGE_TENDENCY_APPLY_S(
                0816      U                 gS(1-OLx,1-OLy,kLev,bi,bj),
                0817      I                 iMin,iMax,jMin,jMax, kLev, bi,bj,
                0818      I                 myTime, 0, myThid )
                0819       ENDIF
2d9d0bc0a6 Jean*0820 #endif /* ALLOW_MYPACKAGE */
                0821 
b0340e9e76 Jean*0822 #endif /* USE_OLD_EXTERNAL_FORCING */
b734cf7153 Chri*0823       RETURN
                0824       END