model/src/external_forcing.F

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