model/src/external_forcing.F

C $Header: /u/gcmpack/MITgcm/model/src/external_forcing.F,v 1.57 2010/04/26 20:37:02 dimitri Exp $
C $Name:  $

#include "PACKAGES_CONFIG.h"
#include "CPP_OPTIONS.h"

CBOP
C     !ROUTINE: EXTERNAL_FORCING_U
C     !INTERFACE:
      SUBROUTINE EXTERNAL_FORCING_U(
     I           iMin,iMax, jMin,jMax, bi,bj, kLev,
     I           myTime, myThid )
C     !DESCRIPTION: \bv
C     *==========================================================*
C     | S/R EXTERNAL_FORCING_U
C     | o Contains problem specific forcing for zonal velocity.
C     *==========================================================*
C     | Adds terms to gU for forcing by external sources
C     | e.g. wind stress, bottom friction etc ...
C     *==========================================================*
C     \ev

C     !USES:
      IMPLICIT NONE
C     == Global data ==
#include "SIZE.h"
#include "EEPARAMS.h"
#include "PARAMS.h"
#include "GRID.h"
#include "DYNVARS.h"
#include "FFIELDS.h"

C     !INPUT/OUTPUT PARAMETERS:
C     == Routine arguments ==
C     iMin,iMax :: Working range of x-index for applying forcing.
C     jMin,jMax :: Working range of y-index for applying forcing.
C     bi,bj     :: Current tile indices
C     kLev      :: Current vertical level index
C     myTime    :: Current time in simulation
C     myThid    :: Thread Id number
      INTEGER iMin, iMax, jMin, jMax, kLev, bi, bj
      _RL myTime
      INTEGER myThid

C     !LOCAL VARIABLES:
C     == Local variables ==
C     i,j       :: Loop counters
C     kSurface  :: index of surface layer
      INTEGER i, j
      INTEGER kSurface
CEOP

      IF ( fluidIsAir ) THEN
       kSurface = 0
      ELSEIF ( usingPCoords ) THEN
       kSurface = Nr
      ELSE
       kSurface = 1
      ENDIF

C--   Forcing term
#ifdef ALLOW_AIM
      IF ( useAIM ) CALL AIM_TENDENCY_APPLY_U(
     &                      iMin,iMax, jMin,jMax, bi,bj, kLev,
     &                      myTime, myThid )
#endif /* ALLOW_AIM */

#ifdef ALLOW_FIZHI
      IF ( useFIZHI ) CALL FIZHI_TENDENCY_APPLY_U(
     &                      iMin,iMax, jMin,jMax, bi,bj, kLev,
     &                      myTime, myThid )
#endif /* ALLOW_FIZHI */

C     Add windstress momentum impulse into the top-layer
      IF ( kLev .EQ. kSurface ) THEN
c      DO j=1,sNy
C-jmc: Without CD-scheme, this is OK ; but with CD-scheme, needs to cover [0:sNy+1]
       DO j=0,sNy+1
        DO i=1,sNx+1
         gU(i,j,kLev,bi,bj) = gU(i,j,kLev,bi,bj)
     &   +foFacMom*surfaceForcingU(i,j,bi,bj)
     &   *recip_drF(kLev)*_recip_hFacW(i,j,kLev,bi,bj)
        ENDDO
       ENDDO
      ENDIF

#ifdef ALLOW_EDDYPSI
       CALL TAUEDDY_EXTERNAL_FORCING_U(
     I           iMin,iMax, jMin,jMax, bi,bj, kLev,
     I           myTime, myThid )
#endif

#ifdef ALLOW_RBCS
      IF (useRBCS) THEN
        CALL RBCS_ADD_TENDENCY( bi, bj, klev, -1,
     &                          myTime, myThid )
      ENDIF
#endif

#ifdef ALLOW_OBCS
      IF (useOBCS) THEN
       CALL OBCS_SPONGE_U(
     I           iMin,iMax, jMin,jMax, bi,bj, kLev,
     I           myTime, myThid )
      ENDIF
#endif

#ifdef ALLOW_MYPACKAGE
      IF ( useMYPACKAGE ) CALL MYPACKAGE_TENDENCY_APPLY_U(
     &                      iMin,iMax, jMin,jMax, bi,bj, kLev,
     &                      myTime, myThid )
#endif /* ALLOW_MYPACKAGE */

      RETURN
      END

C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
CBOP
C     !ROUTINE: EXTERNAL_FORCING_V
C     !INTERFACE:
      SUBROUTINE EXTERNAL_FORCING_V(
     I           iMin,iMax, jMin,jMax, bi,bj, kLev,
     I           myTime, myThid )
C     !DESCRIPTION: \bv
C     *==========================================================*
C     | S/R EXTERNAL_FORCING_V
C     | o Contains problem specific forcing for merid velocity.
C     *==========================================================*
C     | Adds terms to gV for forcing by external sources
C     | e.g. wind stress, bottom friction etc ...
C     *==========================================================*
C     \ev

C     !USES:
      IMPLICIT NONE
C     == Global data ==
#include "SIZE.h"
#include "EEPARAMS.h"
#include "PARAMS.h"
#include "GRID.h"
#include "DYNVARS.h"
#include "FFIELDS.h"

C     !INPUT/OUTPUT PARAMETERS:
C     == Routine arguments ==
C     iMin,iMax :: Working range of x-index for applying forcing.
C     jMin,jMax :: Working range of y-index for applying forcing.
C     bi,bj     :: Current tile indices
C     kLev      :: Current vertical level index
C     myTime    :: Current time in simulation
C     myThid    :: Thread Id number
      INTEGER iMin, iMax, jMin, jMax, kLev, bi, bj
      _RL myTime
      INTEGER myThid

C     !LOCAL VARIABLES:
C     == Local variables ==
C     i,j       :: Loop counters
C     kSurface  :: index of surface layer
      INTEGER i, j
      INTEGER kSurface
CEOP

      IF ( fluidIsAir ) THEN
       kSurface = 0
      ELSEIF ( usingPCoords ) THEN
       kSurface = Nr
      ELSE
       kSurface = 1
      ENDIF

C--   Forcing term
#ifdef ALLOW_AIM
      IF ( useAIM ) CALL AIM_TENDENCY_APPLY_V(
     &                      iMin,iMax, jMin,jMax, bi,bj, kLev,
     &                      myTime, myThid )
#endif /* ALLOW_AIM */

#ifdef ALLOW_FIZHI
      IF ( useFIZHI ) CALL FIZHI_TENDENCY_APPLY_V(
     &                      iMin,iMax, jMin,jMax, bi,bj, kLev,
     &                      myTime, myThid )
#endif /* ALLOW_FIZHI */

C     Add windstress momentum impulse into the top-layer
      IF ( kLev .EQ. kSurface ) THEN
       DO j=1,sNy+1
c       DO i=1,sNx
C-jmc: Without CD-scheme, this is OK ; but with CD-scheme, needs to cover [0:sNx+1]
        DO i=0,sNx+1
         gV(i,j,kLev,bi,bj) = gV(i,j,kLev,bi,bj)
     &   +foFacMom*surfaceForcingV(i,j,bi,bj)
     &   *recip_drF(kLev)*_recip_hFacS(i,j,kLev,bi,bj)
        ENDDO
       ENDDO
      ENDIF

#ifdef ALLOW_EDDYPSI
       CALL TAUEDDY_EXTERNAL_FORCING_V(
     I           iMin,iMax, jMin,jMax, bi,bj, kLev,
     I           myTime, myThid )
#endif

#ifdef ALLOW_RBCS
      IF (useRBCS) THEN
        CALL RBCS_ADD_TENDENCY( bi, bj, klev, -2,
     &                          myTime, myThid )
      ENDIF
#endif

#ifdef ALLOW_OBCS
      IF (useOBCS) THEN
       CALL OBCS_SPONGE_V(
     I           iMin,iMax, jMin,jMax, bi,bj, kLev,
     I           myTime, myThid )
      ENDIF
#endif

#ifdef ALLOW_MYPACKAGE
      IF ( useMYPACKAGE ) CALL MYPACKAGE_TENDENCY_APPLY_V(
     &                      iMin,iMax, jMin,jMax, bi,bj, kLev,
     &                      myTime, myThid )
#endif /* ALLOW_MYPACKAGE */

      RETURN
      END

C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
CBOP
C     !ROUTINE: EXTERNAL_FORCING_T
C     !INTERFACE:
      SUBROUTINE EXTERNAL_FORCING_T(
     I           iMin,iMax, jMin,jMax, bi,bj, kLev,
     I           myTime, myThid )
C     !DESCRIPTION: \bv
C     *==========================================================*
C     | S/R EXTERNAL_FORCING_T
C     | o Contains problem specific forcing for temperature.
C     *==========================================================*
C     | Adds terms to gT for forcing by external sources
C     | e.g. heat flux, climatalogical relaxation, etc ...
C     *==========================================================*
C     \ev

C     !USES:
      IMPLICIT NONE
C     == Global data ==
#include "SIZE.h"
#include "EEPARAMS.h"
#include "PARAMS.h"
#include "GRID.h"
#include "DYNVARS.h"
#include "FFIELDS.h"
#include "SURFACE.h"

C     !INPUT/OUTPUT PARAMETERS:
C     == Routine arguments ==
C     iMin,iMax :: Working range of x-index for applying forcing.
C     jMin,jMax :: Working range of y-index for applying forcing.
C     bi,bj     :: Current tile indices
C     kLev      :: Current vertical level index
C     myTime    :: Current time in simulation
C     myThid    :: Thread Id number
      INTEGER iMin, iMax, jMin, jMax, kLev, bi, bj
      _RL myTime
      INTEGER myThid

C     !LOCAL VARIABLES:
C     == Local variables ==
C     i,j       :: Loop counters
C     kSurface  :: index of surface layer
      INTEGER i, j
      INTEGER kSurface
CEOP
#ifdef SHORTWAVE_HEATING
      integer two
      _RL minusone
      parameter (two=2,minusone=-1.)
      _RL swfracb(two)
      INTEGER kp1
#endif

      IF ( fluidIsAir ) THEN
       kSurface = 0
      ELSEIF ( usingPCoords ) THEN
       kSurface = Nr
      ELSE
       kSurface = 1
      ENDIF

C--   Forcing term
#ifdef ALLOW_AIM
      IF ( useAIM ) CALL AIM_TENDENCY_APPLY_T(
     &                      iMin,iMax, jMin,jMax, bi,bj, kLev,
     &                      myTime, myThid )
#endif /* ALLOW_AIM */

#ifdef ALLOW_FIZHI
      IF ( useFIZHI ) CALL FIZHI_TENDENCY_APPLY_T(
     &                      iMin,iMax, jMin,jMax, bi,bj, kLev,
     &                      myTime, myThid )
#endif /* ALLOW_FIZHI */

#ifdef ALLOW_ADDFLUID
      IF ( selectAddFluid.NE.0 .AND. temp_addMass.NE.UNSET_RL ) THEN
       IF ( ( selectAddFluid.GE.1 .AND. nonlinFreeSurf.GT.0 )
     &      .OR. convertFW2Salt.EQ.-1. _d 0 ) THEN
         DO j=1,sNy
          DO i=1,sNx
            gT(i,j,kLev,bi,bj) = gT(i,j,kLev,bi,bj)
     &        + addMass(i,j,kLev,bi,bj)*mass2rUnit
     &          *( temp_addMass - theta(i,j,kLev,bi,bj) )
     &          *recip_rA(i,j,bi,bj)
     &          *recip_drF(kLev)*_recip_hFacC(i,j,kLev,bi,bj)
C    &          *recip_deepFac2C(kLev)*recip_rhoFacC(kLev)
          ENDDO
         ENDDO
       ELSE
         DO j=1,sNy
          DO i=1,sNx
            gT(i,j,kLev,bi,bj) = gT(i,j,kLev,bi,bj)
     &        + addMass(i,j,kLev,bi,bj)*mass2rUnit
     &          *( temp_addMass - tRef(kLev) )
     &          *recip_rA(i,j,bi,bj)
     &          *recip_drF(kLev)*_recip_hFacC(i,j,kLev,bi,bj)
C    &          *recip_deepFac2C(kLev)*recip_rhoFacC(kLev)
          ENDDO
         ENDDO
       ENDIF
      ENDIF
#endif /* ALLOW_ADDFLUID */

C     Add heat in top-layer
      IF ( kLev .EQ. kSurface ) THEN
       DO j=1,sNy
        DO i=1,sNx
         gT(i,j,kLev,bi,bj)=gT(i,j,kLev,bi,bj)
     &     +surfaceForcingT(i,j,bi,bj)
     &     *recip_drF(kLev)*_recip_hFacC(i,j,kLev,bi,bj)
        ENDDO
       ENDDO
      ENDIF

      IF (linFSConserveTr) THEN
       DO j=1,sNy
        DO i=1,sNx
          IF (kLev .EQ. ksurfC(i,j,bi,bj)) THEN
            gT(i,j,kLev,bi,bj)=gT(i,j,kLev,bi,bj)
     &        +TsurfCor*recip_drF(kLev)*_recip_hFacC(i,j,kLev,bi,bj)
          ENDIF
        ENDDO
       ENDDO
      ENDIF

#ifdef ALLOW_SHELFICE
      IF ( useShelfIce )
     &     CALL SHELFICE_FORCING_T(
     I     iMin,iMax, jMin,jMax, bi,bj, kLev,
     I     myTime, myThid )
#endif /* ALLOW_SHELFICE */

#ifdef ALLOW_ICEFRONT
      IF ( useICEFRONT )
     &     CALL ICEFRONT_TENDENCY_APPLY_T(
     &     bi,bj, kLev, myTime, myThid )
#endif /* ALLOW_ICEFRONT */

#ifdef SHORTWAVE_HEATING
C Penetrating SW radiation
c     IF ( usePenetratingSW ) THEN
       swfracb(1)=abs(rF(klev))
       swfracb(2)=abs(rF(klev+1))
       CALL SWFRAC(
     I             two, minusone,
     U             swfracb,
     I             myTime, 1, myThid )
       kp1 = klev+1
       IF (klev.EQ.Nr) THEN
        kp1 = klev
        swfracb(2)=0. _d 0
       ENDIF
       DO j=1,sNy
        DO i=1,sNx
         gT(i,j,klev,bi,bj) = gT(i,j,klev,bi,bj)
     &   -Qsw(i,j,bi,bj)*(swfracb(1)*maskC(i,j,klev,bi,bj)
     &                   -swfracb(2)*maskC(i,j,kp1, bi,bj))
     &    *recip_Cp*mass2rUnit
     &    *recip_drF(klev)*_recip_hFacC(i,j,kLev,bi,bj)
        ENDDO
       ENDDO
c     ENDIF
#endif

#ifdef ALLOW_RBCS
       IF (useRBCS) THEN
          CALL RBCS_ADD_TENDENCY(bi,bj,klev, 1,
     &                            myTime, myThid )
       ENDIF
#endif

#ifdef ALLOW_OBCS
      IF (useOBCS) THEN
       CALL OBCS_SPONGE_T(
     I           iMin,iMax, jMin,jMax, bi,bj, kLev,
     I           myTime, myThid )
      ENDIF
#endif

#ifdef ALLOW_MYPACKAGE
      IF ( useMYPACKAGE ) CALL MYPACKAGE_TENDENCY_APPLY_T(
     &                      iMin,iMax, jMin,jMax, bi,bj, kLev,
     &                      myTime, myThid )
#endif /* ALLOW_MYPACKAGE */

      RETURN
      END

C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
CBOP
C     !ROUTINE: EXTERNAL_FORCING_S
C     !INTERFACE:
      SUBROUTINE EXTERNAL_FORCING_S(
     I           iMin,iMax, jMin,jMax, bi,bj, kLev,
     I           myTime, myThid )

C     !DESCRIPTION: \bv
C     *==========================================================*
C     | S/R EXTERNAL_FORCING_S
C     | o Contains problem specific forcing for merid velocity.
C     *==========================================================*
C     | Adds terms to gS for forcing by external sources
C     | e.g. fresh-water flux, climatalogical relaxation, etc ...
C     *==========================================================*
C     \ev

C     !USES:
      IMPLICIT NONE
C     == Global data ==
#include "SIZE.h"
#include "EEPARAMS.h"
#include "PARAMS.h"
#include "GRID.h"
#include "DYNVARS.h"
#include "FFIELDS.h"
#include "SURFACE.h"

C     !INPUT/OUTPUT PARAMETERS:
C     == Routine arguments ==
C     iMin,iMax :: Working range of x-index for applying forcing.
C     jMin,jMax :: Working range of y-index for applying forcing.
C     bi,bj     :: Current tile indices
C     kLev      :: Current vertical level index
C     myTime    :: Current time in simulation
C     myThid    :: Thread Id number
      INTEGER iMin, iMax, jMin, jMax, kLev, bi, bj
      _RL myTime
      INTEGER myThid

C     !LOCAL VARIABLES:
C     == Local variables ==
C     i,j       :: Loop counters
C     kSurface  :: index of surface layer
      INTEGER i, j
      INTEGER kSurface
CEOP

      IF ( fluidIsAir ) THEN
       kSurface = 0
      ELSEIF ( usingPCoords ) THEN
       kSurface = Nr
      ELSE
       kSurface = 1
      ENDIF

C--   Forcing term
#ifdef ALLOW_AIM
      IF ( useAIM ) CALL AIM_TENDENCY_APPLY_S(
     &                      iMin,iMax, jMin,jMax, bi,bj, kLev,
     &                      myTime, myThid )
#endif /* ALLOW_AIM */

#ifdef ALLOW_FIZHI
      IF ( useFIZHI ) CALL FIZHI_TENDENCY_APPLY_S(
     &                      iMin,iMax, jMin,jMax, bi,bj, kLev,
     &                      myTime, myThid )
#endif /* ALLOW_FIZHI */

#ifdef ALLOW_ADDFLUID
      IF ( selectAddFluid.NE.0 .AND. salt_addMass.NE.UNSET_RL ) THEN
       IF ( ( selectAddFluid.GE.1 .AND. nonlinFreeSurf.GT.0 )
     &      .OR. convertFW2Salt.EQ.-1. _d 0 ) THEN
         DO j=1,sNy
          DO i=1,sNx
            gS(i,j,kLev,bi,bj) = gS(i,j,kLev,bi,bj)
     &        + addMass(i,j,kLev,bi,bj)*mass2rUnit
     &          *( salt_addMass - salt(i,j,kLev,bi,bj) )
     &          *recip_rA(i,j,bi,bj)
     &          *recip_drF(kLev)*_recip_hFacC(i,j,kLev,bi,bj)
C    &          *recip_deepFac2C(kLev)*recip_rhoFacC(kLev)
          ENDDO
         ENDDO
       ELSE
         DO j=1,sNy
          DO i=1,sNx
            gS(i,j,kLev,bi,bj) = gS(i,j,kLev,bi,bj)
     &        + addMass(i,j,kLev,bi,bj)*mass2rUnit
     &          *( salt_addMass - sRef(kLev) )
     &          *recip_rA(i,j,bi,bj)
     &          *recip_drF(kLev)*_recip_hFacC(i,j,kLev,bi,bj)
C    &          *recip_deepFac2C(kLev)*recip_rhoFacC(kLev)
          ENDDO
         ENDDO
       ENDIF
      ENDIF
#endif /* ALLOW_ADDFLUID */

C     Add fresh-water in top-layer
      IF ( kLev .EQ. kSurface ) THEN
       DO j=1,sNy
        DO i=1,sNx
         gS(i,j,kLev,bi,bj)=gS(i,j,kLev,bi,bj)
     &     +surfaceForcingS(i,j,bi,bj)
     &     *recip_drF(kLev)*_recip_hFacC(i,j,kLev,bi,bj)
        ENDDO
       ENDDO
      ENDIF

      IF (linFSConserveTr) THEN
       DO j=1,sNy
        DO i=1,sNx
          IF (kLev .EQ. ksurfC(i,j,bi,bj)) THEN
            gS(i,j,kLev,bi,bj)=gS(i,j,kLev,bi,bj)
     &        +SsurfCor*recip_drF(kLev)*_recip_hFacC(i,j,kLev,bi,bj)
          ENDIF
        ENDDO
       ENDDO
      ENDIF

#ifdef ALLOW_SHELFICE
      IF ( useShelfIce )
     &     CALL SHELFICE_FORCING_S(
     I     iMin,iMax, jMin,jMax, bi,bj, kLev,
     I     myTime, myThid )
#endif /* ALLOW_SHELFICE */

#ifdef ALLOW_ICEFRONT
      IF ( useICEFRONT )
     &     CALL ICEFRONT_TENDENCY_APPLY_S(
     &     bi,bj, kLev, myTime, myThid )
#endif /* ALLOW_ICEFRONT */

#ifdef ALLOW_SALT_PLUME
      IF ( useSALT_PLUME )
     &     CALL SALT_PLUME_TENDENCY_APPLY_S(
     I     iMin,iMax, jMin,jMax, bi,bj, kLev,
     I     myTime, myThid )
#endif /* ALLOW_SALT_PLUME */

#ifdef ALLOW_RBCS
       IF (useRBCS) THEN
          CALL RBCS_ADD_TENDENCY(bi,bj,klev, 2,
     &                            myTime, myThid )
       ENDIF
#endif /* ALLOW_RBCS */

#ifdef ALLOW_OBCS
      IF (useOBCS) THEN
       CALL OBCS_SPONGE_S(
     I           iMin,iMax, jMin,jMax, bi,bj, kLev,
     I           myTime, myThid )
      ENDIF
#endif /* ALLOW_OBCS */

#ifdef ALLOW_MYPACKAGE
      IF ( useMYPACKAGE ) CALL MYPACKAGE_TENDENCY_APPLY_S(
     &                      iMin,iMax, jMin,jMax, bi,bj, kLev,
     &                      myTime, myThid )
#endif /* ALLOW_MYPACKAGE */

      RETURN
      END
1	jmc	1.58	C $Header: /u/gcmpack/MITgcm/model/src/external_forcing.F,v 1.57 2010/04/26 20:37:02 dimitri Exp $
2	adcroft	1.12	C $Name: $
3	cnh	1.1
4	edhill	1.20	#include "PACKAGES_CONFIG.h"
5	cnh	1.1	#include "CPP_OPTIONS.h"
6
7	cnh	1.13	CBOP
8			C !ROUTINE: EXTERNAL_FORCING_U
9			C !INTERFACE:
10	cnh	1.1	SUBROUTINE EXTERNAL_FORCING_U(
11	jmc	1.31	I iMin,iMax, jMin,jMax, bi,bj, kLev,
12			I myTime, myThid )
13	cnh	1.13	C !DESCRIPTION: \bv
14			C ==========================================================
15	jmc	1.31	C \| S/R EXTERNAL_FORCING_U
16			C \| o Contains problem specific forcing for zonal velocity.
17	cnh	1.13	C ==========================================================
18	jmc	1.31	C \| Adds terms to gU for forcing by external sources
19			C \| e.g. wind stress, bottom friction etc ...
20	cnh	1.13	C ==========================================================
21			C \ev
22
23			C !USES:
24	cnh	1.2	IMPLICIT NONE
25	cnh	1.1	C == Global data ==
26			#include "SIZE.h"
27			#include "EEPARAMS.h"
28			#include "PARAMS.h"
29			#include "GRID.h"
30			#include "DYNVARS.h"
31	cnh	1.2	#include "FFIELDS.h"
32	cnh	1.13
33			C !INPUT/OUTPUT PARAMETERS:
34	cnh	1.1	C == Routine arguments ==
35	jmc	1.31	C iMin,iMax :: Working range of x-index for applying forcing.
36			C jMin,jMax :: Working range of y-index for applying forcing.
37			C bi,bj :: Current tile indices
38			C kLev :: Current vertical level index
39			C myTime :: Current time in simulation
40			C myThid :: Thread Id number
41	cnh	1.1	INTEGER iMin, iMax, jMin, jMax, kLev, bi, bj
42	jmc	1.31	_RL myTime
43	adcroft	1.4	INTEGER myThid
44	cnh	1.1
45	cnh	1.13	C !LOCAL VARIABLES:
46	cnh	1.2	C == Local variables ==
47	jmc	1.31	C i,j :: Loop counters
48			C kSurface :: index of surface layer
49			INTEGER i, j
50	mlosch	1.17	INTEGER kSurface
51	cnh	1.13	CEOP
52	cnh	1.2
53	jmc	1.28	IF ( fluidIsAir ) THEN
54	jmc	1.21	kSurface = 0
55	jmc	1.28	ELSEIF ( usingPCoords ) THEN
56	mlosch	1.17	kSurface = Nr
57	jmc	1.28	ELSE
58	mlosch	1.17	kSurface = 1
59	jmc	1.28	ENDIF
60	mlosch	1.17
61	cnh	1.2	C-- Forcing term
62	jmc	1.21	#ifdef ALLOW_AIM
63			IF ( useAIM ) CALL AIM_TENDENCY_APPLY_U(
64			& iMin,iMax, jMin,jMax, bi,bj, kLev,
65	jmc	1.31	& myTime, myThid )
66	jmc	1.21	#endif /* ALLOW_AIM */
67	jmc	1.31
68	molod	1.23	#ifdef ALLOW_FIZHI
69			IF ( useFIZHI ) CALL FIZHI_TENDENCY_APPLY_U(
70			& iMin,iMax, jMin,jMax, bi,bj, kLev,
71	jmc	1.31	& myTime, myThid )
72	molod	1.23	#endif /* ALLOW_FIZHI */
73	jmc	1.21
74	cnh	1.2	C Add windstress momentum impulse into the top-layer
75	mlosch	1.17	IF ( kLev .EQ. kSurface ) THEN
76	jmc	1.32	c DO j=1,sNy
77			C-jmc: Without CD-scheme, this is OK ; but with CD-scheme, needs to cover [0:sNy+1]
78			DO j=0,sNy+1
79	jmc	1.31	DO i=1,sNx+1
80	cnh	1.2	gU(i,j,kLev,bi,bj) = gU(i,j,kLev,bi,bj)
81	jmc	1.26	& +foFacMom*surfaceForcingU(i,j,bi,bj)
82	heimbach	1.38	& recip_drF(kLev)_recip_hFacW(i,j,kLev,bi,bj)
83	cnh	1.2	ENDDO
84			ENDDO
85			ENDIF
86
87	gforget	1.53	#ifdef ALLOW_EDDYPSI
88	heimbach	1.29	CALL TAUEDDY_EXTERNAL_FORCING_U(
89	jmc	1.31	I iMin,iMax, jMin,jMax, bi,bj, kLev,
90			I myTime, myThid )
91	heimbach	1.29	#endif
92
93	jmc	1.58	#ifdef ALLOW_RBCS
94			IF (useRBCS) THEN
95			CALL RBCS_ADD_TENDENCY( bi, bj, klev, -1,
96			& myTime, myThid )
97			ENDIF
98			#endif
99
100	jmc	1.31	#ifdef ALLOW_OBCS
101	heimbach	1.16	IF (useOBCS) THEN
102			CALL OBCS_SPONGE_U(
103	jmc	1.31	I iMin,iMax, jMin,jMax, bi,bj, kLev,
104			I myTime, myThid )
105	heimbach	1.16	ENDIF
106	heimbach	1.14	#endif
107
108	jmc	1.52	#ifdef ALLOW_MYPACKAGE
109			IF ( useMYPACKAGE ) CALL MYPACKAGE_TENDENCY_APPLY_U(
110			& iMin,iMax, jMin,jMax, bi,bj, kLev,
111			& myTime, myThid )
112			#endif /* ALLOW_MYPACKAGE */
113
114	cnh	1.1	RETURN
115			END
116	jmc	1.31
117			C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-\|--+----\|
118	cnh	1.13	CBOP
119			C !ROUTINE: EXTERNAL_FORCING_V
120			C !INTERFACE:
121	cnh	1.1	SUBROUTINE EXTERNAL_FORCING_V(
122	jmc	1.31	I iMin,iMax, jMin,jMax, bi,bj, kLev,
123			I myTime, myThid )
124	cnh	1.13	C !DESCRIPTION: \bv
125			C ==========================================================
126	jmc	1.31	C \| S/R EXTERNAL_FORCING_V
127			C \| o Contains problem specific forcing for merid velocity.
128	cnh	1.13	C ==========================================================
129	jmc	1.31	C \| Adds terms to gV for forcing by external sources
130			C \| e.g. wind stress, bottom friction etc ...
131	cnh	1.13	C ==========================================================
132			C \ev
133
134			C !USES:
135	cnh	1.2	IMPLICIT NONE
136	cnh	1.1	C == Global data ==
137			#include "SIZE.h"
138			#include "EEPARAMS.h"
139			#include "PARAMS.h"
140			#include "GRID.h"
141			#include "DYNVARS.h"
142	cnh	1.2	#include "FFIELDS.h"
143
144	cnh	1.13	C !INPUT/OUTPUT PARAMETERS:
145	cnh	1.1	C == Routine arguments ==
146	jmc	1.31	C iMin,iMax :: Working range of x-index for applying forcing.
147			C jMin,jMax :: Working range of y-index for applying forcing.
148			C bi,bj :: Current tile indices
149			C kLev :: Current vertical level index
150			C myTime :: Current time in simulation
151			C myThid :: Thread Id number
152	cnh	1.1	INTEGER iMin, iMax, jMin, jMax, kLev, bi, bj
153	jmc	1.31	_RL myTime
154	adcroft	1.4	INTEGER myThid
155	cnh	1.13
156			C !LOCAL VARIABLES:
157	cnh	1.2	C == Local variables ==
158	jmc	1.31	C i,j :: Loop counters
159			C kSurface :: index of surface layer
160			INTEGER i, j
161	mlosch	1.17	INTEGER kSurface
162	cnh	1.13	CEOP
163	cnh	1.2
164	jmc	1.28	IF ( fluidIsAir ) THEN
165	jmc	1.21	kSurface = 0
166	jmc	1.28	ELSEIF ( usingPCoords ) THEN
167	mlosch	1.17	kSurface = Nr
168	jmc	1.28	ELSE
169	mlosch	1.17	kSurface = 1
170	jmc	1.28	ENDIF
171	mlosch	1.17
172	cnh	1.2	C-- Forcing term
173	jmc	1.21	#ifdef ALLOW_AIM
174			IF ( useAIM ) CALL AIM_TENDENCY_APPLY_V(
175			& iMin,iMax, jMin,jMax, bi,bj, kLev,
176	jmc	1.31	& myTime, myThid )
177	jmc	1.21	#endif /* ALLOW_AIM */
178
179	molod	1.23	#ifdef ALLOW_FIZHI
180			IF ( useFIZHI ) CALL FIZHI_TENDENCY_APPLY_V(
181			& iMin,iMax, jMin,jMax, bi,bj, kLev,
182	jmc	1.31	& myTime, myThid )
183	molod	1.23	#endif /* ALLOW_FIZHI */
184	jmc	1.31
185	cnh	1.2	C Add windstress momentum impulse into the top-layer
186	mlosch	1.17	IF ( kLev .EQ. kSurface ) THEN
187	jmc	1.31	DO j=1,sNy+1
188	jmc	1.32	c DO i=1,sNx
189			C-jmc: Without CD-scheme, this is OK ; but with CD-scheme, needs to cover [0:sNx+1]
190			DO i=0,sNx+1
191	cnh	1.2	gV(i,j,kLev,bi,bj) = gV(i,j,kLev,bi,bj)
192	jmc	1.26	& +foFacMom*surfaceForcingV(i,j,bi,bj)
193	heimbach	1.38	& recip_drF(kLev)_recip_hFacS(i,j,kLev,bi,bj)
194	cnh	1.2	ENDDO
195			ENDDO
196			ENDIF
197	cnh	1.1
198	gforget	1.53	#ifdef ALLOW_EDDYPSI
199	heimbach	1.29	CALL TAUEDDY_EXTERNAL_FORCING_V(
200	jmc	1.31	I iMin,iMax, jMin,jMax, bi,bj, kLev,
201			I myTime, myThid )
202	heimbach	1.29	#endif
203
204	jmc	1.58	#ifdef ALLOW_RBCS
205			IF (useRBCS) THEN
206			CALL RBCS_ADD_TENDENCY( bi, bj, klev, -2,
207			& myTime, myThid )
208			ENDIF
209			#endif
210
211	jmc	1.31	#ifdef ALLOW_OBCS
212	heimbach	1.16	IF (useOBCS) THEN
213			CALL OBCS_SPONGE_V(
214	jmc	1.31	I iMin,iMax, jMin,jMax, bi,bj, kLev,
215			I myTime, myThid )
216	heimbach	1.16	ENDIF
217	heimbach	1.14	#endif
218
219	jmc	1.52	#ifdef ALLOW_MYPACKAGE
220			IF ( useMYPACKAGE ) CALL MYPACKAGE_TENDENCY_APPLY_V(
221			& iMin,iMax, jMin,jMax, bi,bj, kLev,
222			& myTime, myThid )
223			#endif /* ALLOW_MYPACKAGE */
224
225	cnh	1.1	RETURN
226			END
227	jmc	1.31
228			C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-\|--+----\|
229	cnh	1.13	CBOP
230			C !ROUTINE: EXTERNAL_FORCING_T
231			C !INTERFACE:
232	cnh	1.1	SUBROUTINE EXTERNAL_FORCING_T(
233	jmc	1.31	I iMin,iMax, jMin,jMax, bi,bj, kLev,
234			I myTime, myThid )
235	cnh	1.13	C !DESCRIPTION: \bv
236			C ==========================================================
237	jmc	1.31	C \| S/R EXTERNAL_FORCING_T
238			C \| o Contains problem specific forcing for temperature.
239	cnh	1.13	C ==========================================================
240	jmc	1.31	C \| Adds terms to gT for forcing by external sources
241			C \| e.g. heat flux, climatalogical relaxation, etc ...
242	cnh	1.13	C ==========================================================
243			C \ev
244
245			C !USES:
246	cnh	1.2	IMPLICIT NONE
247	cnh	1.1	C == Global data ==
248			#include "SIZE.h"
249			#include "EEPARAMS.h"
250			#include "PARAMS.h"
251			#include "GRID.h"
252			#include "DYNVARS.h"
253			#include "FFIELDS.h"
254	dfer	1.40	#include "SURFACE.h"
255	heimbach	1.7
256	cnh	1.13	C !INPUT/OUTPUT PARAMETERS:
257	cnh	1.1	C == Routine arguments ==
258	jmc	1.31	C iMin,iMax :: Working range of x-index for applying forcing.
259			C jMin,jMax :: Working range of y-index for applying forcing.
260			C bi,bj :: Current tile indices
261			C kLev :: Current vertical level index
262			C myTime :: Current time in simulation
263			C myThid :: Thread Id number
264	cnh	1.1	INTEGER iMin, iMax, jMin, jMax, kLev, bi, bj
265	jmc	1.31	_RL myTime
266	adcroft	1.4	INTEGER myThid
267	cnh	1.1
268	cnh	1.13	C !LOCAL VARIABLES:
269	cnh	1.2	C == Local variables ==
270	jmc	1.31	C i,j :: Loop counters
271			C kSurface :: index of surface layer
272			INTEGER i, j
273	mlosch	1.17	INTEGER kSurface
274	jmc	1.31	CEOP
275	jmc	1.24	#ifdef SHORTWAVE_HEATING
276			integer two
277			_RL minusone
278			parameter (two=2,minusone=-1.)
279			_RL swfracb(two)
280			INTEGER kp1
281			#endif
282	cnh	1.2
283	jmc	1.28	IF ( fluidIsAir ) THEN
284	jmc	1.21	kSurface = 0
285	jmc	1.28	ELSEIF ( usingPCoords ) THEN
286	mlosch	1.17	kSurface = Nr
287	jmc	1.28	ELSE
288	mlosch	1.17	kSurface = 1
289	jmc	1.28	ENDIF
290	mlosch	1.17
291	cnh	1.2	C-- Forcing term
292	jmc	1.21	#ifdef ALLOW_AIM
293			IF ( useAIM ) CALL AIM_TENDENCY_APPLY_T(
294			& iMin,iMax, jMin,jMax, bi,bj, kLev,
295	jmc	1.31	& myTime, myThid )
296	jmc	1.21	#endif /* ALLOW_AIM */
297
298	molod	1.23	#ifdef ALLOW_FIZHI
299			IF ( useFIZHI ) CALL FIZHI_TENDENCY_APPLY_T(
300			& iMin,iMax, jMin,jMax, bi,bj, kLev,
301	jmc	1.31	& myTime, myThid )
302	molod	1.23	#endif /* ALLOW_FIZHI */
303	heimbach	1.25
304	jmc	1.54	#ifdef ALLOW_ADDFLUID
305	dimitri	1.57	IF ( selectAddFluid.NE.0 .AND. temp_addMass.NE.UNSET_RL ) THEN
306	jmc	1.54	IF ( ( selectAddFluid.GE.1 .AND. nonlinFreeSurf.GT.0 )
307			& .OR. convertFW2Salt.EQ.-1. _d 0 ) THEN
308			DO j=1,sNy
309			DO i=1,sNx
310			gT(i,j,kLev,bi,bj) = gT(i,j,kLev,bi,bj)
311			& + addMass(i,j,kLev,bi,bj)*mass2rUnit
312	dimitri	1.57	& *( temp_addMass - theta(i,j,kLev,bi,bj) )
313	jmc	1.54	& *recip_rA(i,j,bi,bj)
314			& recip_drF(kLev)_recip_hFacC(i,j,kLev,bi,bj)
315			C & recip_deepFac2C(kLev)recip_rhoFacC(kLev)
316			ENDDO
317			ENDDO
318			ELSE
319			DO j=1,sNy
320			DO i=1,sNx
321			gT(i,j,kLev,bi,bj) = gT(i,j,kLev,bi,bj)
322			& + addMass(i,j,kLev,bi,bj)*mass2rUnit
323	dimitri	1.57	& *( temp_addMass - tRef(kLev) )
324	jmc	1.54	& *recip_rA(i,j,bi,bj)
325			& recip_drF(kLev)_recip_hFacC(i,j,kLev,bi,bj)
326			C & recip_deepFac2C(kLev)recip_rhoFacC(kLev)
327			ENDDO
328			ENDDO
329			ENDIF
330			ENDIF
331			#endif /* ALLOW_ADDFLUID */
332
333	cnh	1.2	C Add heat in top-layer
334	mlosch	1.17	IF ( kLev .EQ. kSurface ) THEN
335	jmc	1.31	DO j=1,sNy
336			DO i=1,sNx
337	cnh	1.2	gT(i,j,kLev,bi,bj)=gT(i,j,kLev,bi,bj)
338	jmc	1.26	& +surfaceForcingT(i,j,bi,bj)
339	heimbach	1.38	& recip_drF(kLev)_recip_hFacC(i,j,kLev,bi,bj)
340	cnh	1.2	ENDDO
341			ENDDO
342			ENDIF
343	adcroft	1.5
344	dfer	1.40	IF (linFSConserveTr) THEN
345			DO j=1,sNy
346			DO i=1,sNx
347			IF (kLev .EQ. ksurfC(i,j,bi,bj)) THEN
348			gT(i,j,kLev,bi,bj)=gT(i,j,kLev,bi,bj)
349			& +TsurfCorrecip_drF(kLev)_recip_hFacC(i,j,kLev,bi,bj)
350			ENDIF
351			ENDDO
352			ENDDO
353			ENDIF
354
355	mlosch	1.37	#ifdef ALLOW_SHELFICE
356			IF ( useShelfIce )
357			& CALL SHELFICE_FORCING_T(
358			I iMin,iMax, jMin,jMax, bi,bj, kLev,
359			I myTime, myThid )
360			#endif /* ALLOW_SHELFICE */
361
362	dimitri	1.55	#ifdef ALLOW_ICEFRONT
363	dimitri	1.56	IF ( useICEFRONT )
364			& CALL ICEFRONT_TENDENCY_APPLY_T(
365			& bi,bj, kLev, myTime, myThid )
366	dimitri	1.55	#endif /* ALLOW_ICEFRONT */
367
368	adcroft	1.5	#ifdef SHORTWAVE_HEATING
369			C Penetrating SW radiation
370	jmc	1.31	c IF ( usePenetratingSW ) THEN
371			swfracb(1)=abs(rF(klev))
372			swfracb(2)=abs(rF(klev+1))
373			CALL SWFRAC(
374	jmc	1.42	I two, minusone,
375			U swfracb,
376			I myTime, 1, myThid )
377	jmc	1.31	kp1 = klev+1
378			IF (klev.EQ.Nr) THEN
379	jmc	1.24	kp1 = klev
380			swfracb(2)=0. _d 0
381	jmc	1.31	ENDIF
382			DO j=1,sNy
383			DO i=1,sNx
384			gT(i,j,klev,bi,bj) = gT(i,j,klev,bi,bj)
385	jmc	1.24	& -Qsw(i,j,bi,bj)(swfracb(1)maskC(i,j,klev,bi,bj)
386			& -swfracb(2)*maskC(i,j,kp1, bi,bj))
387	jmc	1.47	& recip_Cpmass2rUnit
388	heimbach	1.38	& recip_drF(klev)_recip_hFacC(i,j,kLev,bi,bj)
389	jmc	1.31	ENDDO
390	adcroft	1.5	ENDDO
391	jmc	1.31	c ENDIF
392	adcroft	1.5	#endif
393	heimbach	1.14
394	stephd	1.35	#ifdef ALLOW_RBCS
395	jmc	1.47	IF (useRBCS) THEN
396			CALL RBCS_ADD_TENDENCY(bi,bj,klev, 1,
397	stephd	1.35	& myTime, myThid )
398	jmc	1.47	ENDIF
399	stephd	1.35	#endif
400
401	jmc	1.31	#ifdef ALLOW_OBCS
402	heimbach	1.16	IF (useOBCS) THEN
403			CALL OBCS_SPONGE_T(
404	jmc	1.31	I iMin,iMax, jMin,jMax, bi,bj, kLev,
405			I myTime, myThid )
406	heimbach	1.16	ENDIF
407	heimbach	1.14	#endif
408
409	jmc	1.52	#ifdef ALLOW_MYPACKAGE
410			IF ( useMYPACKAGE ) CALL MYPACKAGE_TENDENCY_APPLY_T(
411			& iMin,iMax, jMin,jMax, bi,bj, kLev,
412			& myTime, myThid )
413			#endif /* ALLOW_MYPACKAGE */
414
415	cnh	1.1	RETURN
416			END
417	jmc	1.31
418			C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-\|--+----\|
419	cnh	1.13	CBOP
420			C !ROUTINE: EXTERNAL_FORCING_S
421			C !INTERFACE:
422	cnh	1.1	SUBROUTINE EXTERNAL_FORCING_S(
423	jmc	1.31	I iMin,iMax, jMin,jMax, bi,bj, kLev,
424			I myTime, myThid )
425	cnh	1.13
426			C !DESCRIPTION: \bv
427			C ==========================================================
428	jmc	1.31	C \| S/R EXTERNAL_FORCING_S
429			C \| o Contains problem specific forcing for merid velocity.
430	cnh	1.13	C ==========================================================
431	jmc	1.31	C \| Adds terms to gS for forcing by external sources
432			C \| e.g. fresh-water flux, climatalogical relaxation, etc ...
433	cnh	1.13	C ==========================================================
434			C \ev
435
436			C !USES:
437	cnh	1.2	IMPLICIT NONE
438	cnh	1.1	C == Global data ==
439			#include "SIZE.h"
440			#include "EEPARAMS.h"
441			#include "PARAMS.h"
442			#include "GRID.h"
443			#include "DYNVARS.h"
444	cnh	1.2	#include "FFIELDS.h"
445	dfer	1.40	#include "SURFACE.h"
446	cnh	1.1
447	cnh	1.13	C !INPUT/OUTPUT PARAMETERS:
448	cnh	1.1	C == Routine arguments ==
449	jmc	1.31	C iMin,iMax :: Working range of x-index for applying forcing.
450			C jMin,jMax :: Working range of y-index for applying forcing.
451			C bi,bj :: Current tile indices
452			C kLev :: Current vertical level index
453			C myTime :: Current time in simulation
454			C myThid :: Thread Id number
455	cnh	1.1	INTEGER iMin, iMax, jMin, jMax, kLev, bi, bj
456	jmc	1.31	_RL myTime
457	adcroft	1.4	INTEGER myThid
458	cnh	1.2
459	cnh	1.13	C !LOCAL VARIABLES:
460	cnh	1.2	C == Local variables ==
461	jmc	1.31	C i,j :: Loop counters
462			C kSurface :: index of surface layer
463			INTEGER i, j
464	mlosch	1.17	INTEGER kSurface
465	cnh	1.13	CEOP
466	cnh	1.2
467	jmc	1.28	IF ( fluidIsAir ) THEN
468	jmc	1.21	kSurface = 0
469	jmc	1.28	ELSEIF ( usingPCoords ) THEN
470	mlosch	1.17	kSurface = Nr
471	jmc	1.28	ELSE
472	mlosch	1.17	kSurface = 1
473	jmc	1.28	ENDIF
474	mlosch	1.17
475	cnh	1.2	C-- Forcing term
476	jmc	1.21	#ifdef ALLOW_AIM
477			IF ( useAIM ) CALL AIM_TENDENCY_APPLY_S(
478			& iMin,iMax, jMin,jMax, bi,bj, kLev,
479	jmc	1.31	& myTime, myThid )
480	jmc	1.21	#endif /* ALLOW_AIM */
481
482	molod	1.23	#ifdef ALLOW_FIZHI
483			IF ( useFIZHI ) CALL FIZHI_TENDENCY_APPLY_S(
484			& iMin,iMax, jMin,jMax, bi,bj, kLev,
485	jmc	1.31	& myTime, myThid )
486	molod	1.23	#endif /* ALLOW_FIZHI */
487	heimbach	1.25
488	jmc	1.54	#ifdef ALLOW_ADDFLUID
489	dimitri	1.57	IF ( selectAddFluid.NE.0 .AND. salt_addMass.NE.UNSET_RL ) THEN
490	jmc	1.54	IF ( ( selectAddFluid.GE.1 .AND. nonlinFreeSurf.GT.0 )
491			& .OR. convertFW2Salt.EQ.-1. _d 0 ) THEN
492			DO j=1,sNy
493			DO i=1,sNx
494			gS(i,j,kLev,bi,bj) = gS(i,j,kLev,bi,bj)
495			& + addMass(i,j,kLev,bi,bj)*mass2rUnit
496	dimitri	1.57	& *( salt_addMass - salt(i,j,kLev,bi,bj) )
497	jmc	1.54	& *recip_rA(i,j,bi,bj)
498			& recip_drF(kLev)_recip_hFacC(i,j,kLev,bi,bj)
499			C & recip_deepFac2C(kLev)recip_rhoFacC(kLev)
500			ENDDO
501			ENDDO
502			ELSE
503			DO j=1,sNy
504			DO i=1,sNx
505			gS(i,j,kLev,bi,bj) = gS(i,j,kLev,bi,bj)
506			& + addMass(i,j,kLev,bi,bj)*mass2rUnit
507	dimitri	1.57	& *( salt_addMass - sRef(kLev) )
508	jmc	1.54	& *recip_rA(i,j,bi,bj)
509			& recip_drF(kLev)_recip_hFacC(i,j,kLev,bi,bj)
510			C & recip_deepFac2C(kLev)recip_rhoFacC(kLev)
511			ENDDO
512			ENDDO
513			ENDIF
514			ENDIF
515			#endif /* ALLOW_ADDFLUID */
516
517	cnh	1.2	C Add fresh-water in top-layer
518	mlosch	1.17	IF ( kLev .EQ. kSurface ) THEN
519	jmc	1.31	DO j=1,sNy
520			DO i=1,sNx
521	cnh	1.2	gS(i,j,kLev,bi,bj)=gS(i,j,kLev,bi,bj)
522	jmc	1.26	& +surfaceForcingS(i,j,bi,bj)
523	heimbach	1.38	& recip_drF(kLev)_recip_hFacC(i,j,kLev,bi,bj)
524	cnh	1.2	ENDDO
525			ENDDO
526			ENDIF
527	heimbach	1.14
528	dfer	1.40	IF (linFSConserveTr) THEN
529			DO j=1,sNy
530			DO i=1,sNx
531			IF (kLev .EQ. ksurfC(i,j,bi,bj)) THEN
532			gS(i,j,kLev,bi,bj)=gS(i,j,kLev,bi,bj)
533			& +SsurfCorrecip_drF(kLev)_recip_hFacC(i,j,kLev,bi,bj)
534			ENDIF
535			ENDDO
536			ENDDO
537			ENDIF
538
539	mlosch	1.37	#ifdef ALLOW_SHELFICE
540			IF ( useShelfIce )
541			& CALL SHELFICE_FORCING_S(
542			I iMin,iMax, jMin,jMax, bi,bj, kLev,
543			I myTime, myThid )
544			#endif /* ALLOW_SHELFICE */
545
546	dimitri	1.55	#ifdef ALLOW_ICEFRONT
547	dimitri	1.56	IF ( useICEFRONT )
548			& CALL ICEFRONT_TENDENCY_APPLY_S(
549			& bi,bj, kLev, myTime, myThid )
550	dimitri	1.55	#endif /* ALLOW_ICEFRONT */
551
552	dimitri	1.43	#ifdef ALLOW_SALT_PLUME
553	dimitri	1.51	IF ( useSALT_PLUME )
554	dimitri	1.50	& CALL SALT_PLUME_TENDENCY_APPLY_S(
555			I iMin,iMax, jMin,jMax, bi,bj, kLev,
556			I myTime, myThid )
557	dimitri	1.43	#endif /* ALLOW_SALT_PLUME */
558
559	stephd	1.35	#ifdef ALLOW_RBCS
560	jmc	1.47	IF (useRBCS) THEN
561			CALL RBCS_ADD_TENDENCY(bi,bj,klev, 2,
562	stephd	1.35	& myTime, myThid )
563	jmc	1.47	ENDIF
564	dimitri	1.43	#endif /* ALLOW_RBCS */
565	stephd	1.35
566	jmc	1.31	#ifdef ALLOW_OBCS
567	heimbach	1.16	IF (useOBCS) THEN
568			CALL OBCS_SPONGE_S(
569	jmc	1.31	I iMin,iMax, jMin,jMax, bi,bj, kLev,
570			I myTime, myThid )
571	heimbach	1.16	ENDIF
572	dimitri	1.43	#endif /* ALLOW_OBCS */
573	cnh	1.1
574	jmc	1.52	#ifdef ALLOW_MYPACKAGE
575			IF ( useMYPACKAGE ) CALL MYPACKAGE_TENDENCY_APPLY_S(
576			& iMin,iMax, jMin,jMax, bi,bj, kLev,
577			& myTime, myThid )
578			#endif /* ALLOW_MYPACKAGE */
579
580	cnh	1.1	RETURN
581			END