model/src/external_forcing.F

C $Header: /u/gcmpack/MITgcm/model/src/external_forcing.F,v 1.30 2005/03/01 18:55:13 heimbach 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
       DO j=1,sNy
        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

#if (defined (ALLOW_TAU_EDDY))
       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

      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
        DO i=1,sNx
         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

#if (defined (ALLOW_TAU_EDDY))
       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

      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"

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 */

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

#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,
     I     myTime,myThid,
     U     swfracb)
       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*recip_rhoConst
     &    *recip_drF(klev)*recip_hFacC(i,j,kLev,bi,bj)
        ENDDO
       ENDDO
c     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

      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"

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 */

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

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

      RETURN
      END
1	jmc	1.31	C $Header: /u/gcmpack/MITgcm/model/src/external_forcing.F,v 1.30 2005/03/01 18:55:13 heimbach 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.31	DO j=1,sNy
77			DO i=1,sNx+1
78	cnh	1.2	gU(i,j,kLev,bi,bj) = gU(i,j,kLev,bi,bj)
79	jmc	1.26	& +foFacMom*surfaceForcingU(i,j,bi,bj)
80			& recip_drF(kLev)recip_hFacW(i,j,kLev,bi,bj)
81	cnh	1.2	ENDDO
82			ENDDO
83			ENDIF
84
85	heimbach	1.30	#if (defined (ALLOW_TAU_EDDY))
86	heimbach	1.29	CALL TAUEDDY_EXTERNAL_FORCING_U(
87	jmc	1.31	I iMin,iMax, jMin,jMax, bi,bj, kLev,
88			I myTime, myThid )
89	heimbach	1.29	#endif
90
91	jmc	1.31	#ifdef ALLOW_OBCS
92	heimbach	1.16	IF (useOBCS) THEN
93			CALL OBCS_SPONGE_U(
94	jmc	1.31	I iMin,iMax, jMin,jMax, bi,bj, kLev,
95			I myTime, myThid )
96	heimbach	1.16	ENDIF
97	heimbach	1.14	#endif
98
99	cnh	1.1	RETURN
100			END
101	jmc	1.31
102			C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-\|--+----\|
103	cnh	1.13	CBOP
104			C !ROUTINE: EXTERNAL_FORCING_V
105			C !INTERFACE:
106	cnh	1.1	SUBROUTINE EXTERNAL_FORCING_V(
107	jmc	1.31	I iMin,iMax, jMin,jMax, bi,bj, kLev,
108			I myTime, myThid )
109	cnh	1.13	C !DESCRIPTION: \bv
110			C ==========================================================
111	jmc	1.31	C \| S/R EXTERNAL_FORCING_V
112			C \| o Contains problem specific forcing for merid velocity.
113	cnh	1.13	C ==========================================================
114	jmc	1.31	C \| Adds terms to gV for forcing by external sources
115			C \| e.g. wind stress, bottom friction etc ...
116	cnh	1.13	C ==========================================================
117			C \ev
118
119			C !USES:
120	cnh	1.2	IMPLICIT NONE
121	cnh	1.1	C == Global data ==
122			#include "SIZE.h"
123			#include "EEPARAMS.h"
124			#include "PARAMS.h"
125			#include "GRID.h"
126			#include "DYNVARS.h"
127	cnh	1.2	#include "FFIELDS.h"
128
129	cnh	1.13	C !INPUT/OUTPUT PARAMETERS:
130	cnh	1.1	C == Routine arguments ==
131	jmc	1.31	C iMin,iMax :: Working range of x-index for applying forcing.
132			C jMin,jMax :: Working range of y-index for applying forcing.
133			C bi,bj :: Current tile indices
134			C kLev :: Current vertical level index
135			C myTime :: Current time in simulation
136			C myThid :: Thread Id number
137	cnh	1.1	INTEGER iMin, iMax, jMin, jMax, kLev, bi, bj
138	jmc	1.31	_RL myTime
139	adcroft	1.4	INTEGER myThid
140	cnh	1.13
141			C !LOCAL VARIABLES:
142	cnh	1.2	C == Local variables ==
143	jmc	1.31	C i,j :: Loop counters
144			C kSurface :: index of surface layer
145			INTEGER i, j
146	mlosch	1.17	INTEGER kSurface
147	cnh	1.13	CEOP
148	cnh	1.2
149	jmc	1.28	IF ( fluidIsAir ) THEN
150	jmc	1.21	kSurface = 0
151	jmc	1.28	ELSEIF ( usingPCoords ) THEN
152	mlosch	1.17	kSurface = Nr
153	jmc	1.28	ELSE
154	mlosch	1.17	kSurface = 1
155	jmc	1.28	ENDIF
156	mlosch	1.17
157	cnh	1.2	C-- Forcing term
158	jmc	1.21	#ifdef ALLOW_AIM
159			IF ( useAIM ) CALL AIM_TENDENCY_APPLY_V(
160			& iMin,iMax, jMin,jMax, bi,bj, kLev,
161	jmc	1.31	& myTime, myThid )
162	jmc	1.21	#endif /* ALLOW_AIM */
163
164	molod	1.23	#ifdef ALLOW_FIZHI
165			IF ( useFIZHI ) CALL FIZHI_TENDENCY_APPLY_V(
166			& iMin,iMax, jMin,jMax, bi,bj, kLev,
167	jmc	1.31	& myTime, myThid )
168	molod	1.23	#endif /* ALLOW_FIZHI */
169	jmc	1.31
170	cnh	1.2	C Add windstress momentum impulse into the top-layer
171	mlosch	1.17	IF ( kLev .EQ. kSurface ) THEN
172	jmc	1.31	DO j=1,sNy+1
173			DO i=1,sNx
174	cnh	1.2	gV(i,j,kLev,bi,bj) = gV(i,j,kLev,bi,bj)
175	jmc	1.26	& +foFacMom*surfaceForcingV(i,j,bi,bj)
176			& recip_drF(kLev)recip_hFacS(i,j,kLev,bi,bj)
177	cnh	1.2	ENDDO
178			ENDDO
179			ENDIF
180	cnh	1.1
181	heimbach	1.30	#if (defined (ALLOW_TAU_EDDY))
182	heimbach	1.29	CALL TAUEDDY_EXTERNAL_FORCING_V(
183	jmc	1.31	I iMin,iMax, jMin,jMax, bi,bj, kLev,
184			I myTime, myThid )
185	heimbach	1.29	#endif
186
187	jmc	1.31	#ifdef ALLOW_OBCS
188	heimbach	1.16	IF (useOBCS) THEN
189			CALL OBCS_SPONGE_V(
190	jmc	1.31	I iMin,iMax, jMin,jMax, bi,bj, kLev,
191			I myTime, myThid )
192	heimbach	1.16	ENDIF
193	heimbach	1.14	#endif
194
195	cnh	1.1	RETURN
196			END
197	jmc	1.31
198			C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-\|--+----\|
199	cnh	1.13	CBOP
200			C !ROUTINE: EXTERNAL_FORCING_T
201			C !INTERFACE:
202	cnh	1.1	SUBROUTINE EXTERNAL_FORCING_T(
203	jmc	1.31	I iMin,iMax, jMin,jMax, bi,bj, kLev,
204			I myTime, myThid )
205	cnh	1.13	C !DESCRIPTION: \bv
206			C ==========================================================
207	jmc	1.31	C \| S/R EXTERNAL_FORCING_T
208			C \| o Contains problem specific forcing for temperature.
209	cnh	1.13	C ==========================================================
210	jmc	1.31	C \| Adds terms to gT for forcing by external sources
211			C \| e.g. heat flux, climatalogical relaxation, etc ...
212	cnh	1.13	C ==========================================================
213			C \ev
214
215			C !USES:
216	cnh	1.2	IMPLICIT NONE
217	cnh	1.1	C == Global data ==
218			#include "SIZE.h"
219			#include "EEPARAMS.h"
220			#include "PARAMS.h"
221			#include "GRID.h"
222			#include "DYNVARS.h"
223			#include "FFIELDS.h"
224	heimbach	1.7
225	cnh	1.13	C !INPUT/OUTPUT PARAMETERS:
226	cnh	1.1	C == Routine arguments ==
227	jmc	1.31	C iMin,iMax :: Working range of x-index for applying forcing.
228			C jMin,jMax :: Working range of y-index for applying forcing.
229			C bi,bj :: Current tile indices
230			C kLev :: Current vertical level index
231			C myTime :: Current time in simulation
232			C myThid :: Thread Id number
233	cnh	1.1	INTEGER iMin, iMax, jMin, jMax, kLev, bi, bj
234	jmc	1.31	_RL myTime
235	adcroft	1.4	INTEGER myThid
236	cnh	1.1
237	cnh	1.13	C !LOCAL VARIABLES:
238	cnh	1.2	C == Local variables ==
239	jmc	1.31	C i,j :: Loop counters
240			C kSurface :: index of surface layer
241			INTEGER i, j
242	mlosch	1.17	INTEGER kSurface
243	jmc	1.31	CEOP
244	jmc	1.24	#ifdef SHORTWAVE_HEATING
245			integer two
246			_RL minusone
247			parameter (two=2,minusone=-1.)
248			_RL swfracb(two)
249			INTEGER kp1
250			#endif
251	cnh	1.2
252	jmc	1.28	IF ( fluidIsAir ) THEN
253	jmc	1.21	kSurface = 0
254	jmc	1.28	ELSEIF ( usingPCoords ) THEN
255	mlosch	1.17	kSurface = Nr
256	jmc	1.28	ELSE
257	mlosch	1.17	kSurface = 1
258	jmc	1.28	ENDIF
259	mlosch	1.17
260	cnh	1.2	C-- Forcing term
261	jmc	1.21	#ifdef ALLOW_AIM
262			IF ( useAIM ) CALL AIM_TENDENCY_APPLY_T(
263			& iMin,iMax, jMin,jMax, bi,bj, kLev,
264	jmc	1.31	& myTime, myThid )
265	jmc	1.21	#endif /* ALLOW_AIM */
266
267	molod	1.23	#ifdef ALLOW_FIZHI
268			IF ( useFIZHI ) CALL FIZHI_TENDENCY_APPLY_T(
269			& iMin,iMax, jMin,jMax, bi,bj, kLev,
270	jmc	1.31	& myTime, myThid )
271	molod	1.23	#endif /* ALLOW_FIZHI */
272	heimbach	1.25
273	cnh	1.2	C Add heat in top-layer
274	mlosch	1.17	IF ( kLev .EQ. kSurface ) THEN
275	jmc	1.31	DO j=1,sNy
276			DO i=1,sNx
277	cnh	1.2	gT(i,j,kLev,bi,bj)=gT(i,j,kLev,bi,bj)
278	jmc	1.26	& +surfaceForcingT(i,j,bi,bj)
279			& recip_drF(kLev)recip_hFacC(i,j,kLev,bi,bj)
280	cnh	1.2	ENDDO
281			ENDDO
282			ENDIF
283	adcroft	1.5
284			#ifdef SHORTWAVE_HEATING
285			C Penetrating SW radiation
286	jmc	1.31	c IF ( usePenetratingSW ) THEN
287			swfracb(1)=abs(rF(klev))
288			swfracb(2)=abs(rF(klev+1))
289			CALL SWFRAC(
290	heimbach	1.8	I two,minusone,
291	jmc	1.31	I myTime,myThid,
292	dimitri	1.18	U swfracb)
293	jmc	1.31	kp1 = klev+1
294			IF (klev.EQ.Nr) THEN
295	jmc	1.24	kp1 = klev
296			swfracb(2)=0. _d 0
297	jmc	1.31	ENDIF
298			DO j=1,sNy
299			DO i=1,sNx
300			gT(i,j,klev,bi,bj) = gT(i,j,klev,bi,bj)
301	jmc	1.24	& -Qsw(i,j,bi,bj)(swfracb(1)maskC(i,j,klev,bi,bj)
302			& -swfracb(2)*maskC(i,j,kp1, bi,bj))
303	jmc	1.27	& recip_Cprecip_rhoConst
304			& recip_drF(klev)recip_hFacC(i,j,kLev,bi,bj)
305	jmc	1.31	ENDDO
306	adcroft	1.5	ENDDO
307	jmc	1.31	c ENDIF
308	adcroft	1.5	#endif
309	heimbach	1.14
310	jmc	1.31	#ifdef ALLOW_OBCS
311	heimbach	1.16	IF (useOBCS) THEN
312			CALL OBCS_SPONGE_T(
313	jmc	1.31	I iMin,iMax, jMin,jMax, bi,bj, kLev,
314			I myTime, myThid )
315	heimbach	1.16	ENDIF
316	heimbach	1.14	#endif
317
318	cnh	1.1	RETURN
319			END
320	jmc	1.31
321			C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-\|--+----\|
322	cnh	1.13	CBOP
323			C !ROUTINE: EXTERNAL_FORCING_S
324			C !INTERFACE:
325	cnh	1.1	SUBROUTINE EXTERNAL_FORCING_S(
326	jmc	1.31	I iMin,iMax, jMin,jMax, bi,bj, kLev,
327			I myTime, myThid )
328	cnh	1.13
329			C !DESCRIPTION: \bv
330			C ==========================================================
331	jmc	1.31	C \| S/R EXTERNAL_FORCING_S
332			C \| o Contains problem specific forcing for merid velocity.
333	cnh	1.13	C ==========================================================
334	jmc	1.31	C \| Adds terms to gS for forcing by external sources
335			C \| e.g. fresh-water flux, climatalogical relaxation, etc ...
336	cnh	1.13	C ==========================================================
337			C \ev
338
339			C !USES:
340	cnh	1.2	IMPLICIT NONE
341	cnh	1.1	C == Global data ==
342			#include "SIZE.h"
343			#include "EEPARAMS.h"
344			#include "PARAMS.h"
345			#include "GRID.h"
346			#include "DYNVARS.h"
347	cnh	1.2	#include "FFIELDS.h"
348	cnh	1.1
349	cnh	1.13	C !INPUT/OUTPUT PARAMETERS:
350	cnh	1.1	C == Routine arguments ==
351	jmc	1.31	C iMin,iMax :: Working range of x-index for applying forcing.
352			C jMin,jMax :: Working range of y-index for applying forcing.
353			C bi,bj :: Current tile indices
354			C kLev :: Current vertical level index
355			C myTime :: Current time in simulation
356			C myThid :: Thread Id number
357	cnh	1.1	INTEGER iMin, iMax, jMin, jMax, kLev, bi, bj
358	jmc	1.31	_RL myTime
359	adcroft	1.4	INTEGER myThid
360	cnh	1.2
361	cnh	1.13	C !LOCAL VARIABLES:
362	cnh	1.2	C == Local variables ==
363	jmc	1.31	C i,j :: Loop counters
364			C kSurface :: index of surface layer
365			INTEGER i, j
366	mlosch	1.17	INTEGER kSurface
367	cnh	1.13	CEOP
368	cnh	1.2
369	jmc	1.28	IF ( fluidIsAir ) THEN
370	jmc	1.21	kSurface = 0
371	jmc	1.28	ELSEIF ( usingPCoords ) THEN
372	mlosch	1.17	kSurface = Nr
373	jmc	1.28	ELSE
374	mlosch	1.17	kSurface = 1
375	jmc	1.28	ENDIF
376	mlosch	1.17
377	cnh	1.2	C-- Forcing term
378	jmc	1.21	#ifdef ALLOW_AIM
379			IF ( useAIM ) CALL AIM_TENDENCY_APPLY_S(
380			& iMin,iMax, jMin,jMax, bi,bj, kLev,
381	jmc	1.31	& myTime, myThid )
382	jmc	1.21	#endif /* ALLOW_AIM */
383
384	molod	1.23	#ifdef ALLOW_FIZHI
385			IF ( useFIZHI ) CALL FIZHI_TENDENCY_APPLY_S(
386			& iMin,iMax, jMin,jMax, bi,bj, kLev,
387	jmc	1.31	& myTime, myThid )
388	molod	1.23	#endif /* ALLOW_FIZHI */
389	heimbach	1.25
390	cnh	1.2	C Add fresh-water in top-layer
391	mlosch	1.17	IF ( kLev .EQ. kSurface ) THEN
392	jmc	1.31	DO j=1,sNy
393			DO i=1,sNx
394	cnh	1.2	gS(i,j,kLev,bi,bj)=gS(i,j,kLev,bi,bj)
395	jmc	1.26	& +surfaceForcingS(i,j,bi,bj)
396			& recip_drF(kLev)recip_hFacC(i,j,kLev,bi,bj)
397	cnh	1.2	ENDDO
398			ENDDO
399			ENDIF
400	heimbach	1.14
401	jmc	1.31	#ifdef ALLOW_OBCS
402	heimbach	1.16	IF (useOBCS) THEN
403			CALL OBCS_SPONGE_S(
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	cnh	1.1
409			RETURN
410			END