model/src/external_forcing.F

C $Header: /u/gcmpack/MITgcm/model/src/external_forcing.F,v 1.18 2003/02/18 05:33:54 dimitri Exp $
C $Name:  $

#include "CPP_OPTIONS.h"
#ifdef ALLOW_OBCS
# include "OBCS_OPTIONS.h"
#endif

CBOP
C     !ROUTINE: EXTERNAL_FORCING_U
C     !INTERFACE:
      SUBROUTINE EXTERNAL_FORCING_U(
     I           iMin, iMax, jMin, jMax,bi,bj,kLev,
     I           myCurrentTime,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 - Working range of tile for applying forcing.
C     iMax
C     jMin
C     jMax
C     kLev
      INTEGER iMin, iMax, jMin, jMax, kLev, bi, bj
      _RL myCurrentTime
      INTEGER myThid

C     !LOCAL VARIABLES:
C     == Local variables ==
C     Loop counters
      INTEGER I, J
C     number of surface interface layer
      INTEGER kSurface
CEOP

      if ( buoyancyRelation .eq. 'OCEANICP' ) then
       kSurface = Nr
      else
       kSurface = 1
      endif

C--   Forcing term
C     Add windstress momentum impulse into the top-layer
      IF ( kLev .EQ. kSurface ) THEN
       DO j=jMin,jMax
        DO i=iMin,iMax
         gU(i,j,kLev,bi,bj) = gU(i,j,kLev,bi,bj)
     &   +foFacMom*surfaceTendencyU(i,j,bi,bj)
     &   *_maskW(i,j,kLev,bi,bj)
        ENDDO
       ENDDO
      ENDIF

#if (defined (ALLOW_OBCS) && defined (ALLOW_OBCS_SPONGE))
      IF (useOBCS) THEN
       CALL OBCS_SPONGE_U(
     I           iMin, iMax, jMin, jMax,bi,bj,kLev,
     I           myCurrentTime,myThid)
      ENDIF
#endif

      RETURN
      END
CBOP
C     !ROUTINE: EXTERNAL_FORCING_V
C     !INTERFACE:
      SUBROUTINE EXTERNAL_FORCING_V(
     I           iMin, iMax, jMin, jMax,bi,bj,kLev,
     I           myCurrentTime,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 - Working range of tile for applying forcing.
C     iMax
C     jMin
C     jMax
C     kLev
      INTEGER iMin, iMax, jMin, jMax, kLev, bi, bj
      _RL myCurrentTime
      INTEGER myThid

C     !LOCAL VARIABLES:
C     == Local variables ==
C     Loop counters
      INTEGER I, J
C     number of surface interface layer
      INTEGER kSurface
CEOP

      if ( buoyancyRelation .eq. 'OCEANICP' ) then
       kSurface = Nr
      else
       kSurface = 1
      endif

C--   Forcing term
C     Add windstress momentum impulse into the top-layer
      IF ( kLev .EQ. kSurface ) THEN
       DO j=jMin,jMax
        DO i=iMin,iMax
         gV(i,j,kLev,bi,bj) = gV(i,j,kLev,bi,bj)
     &   +foFacMom*surfaceTendencyV(i,j,bi,bj)
     &   *_maskS(i,j,kLev,bi,bj)
        ENDDO
       ENDDO
      ENDIF

#if (defined (ALLOW_OBCS) && defined (ALLOW_OBCS_SPONGE))
      IF (useOBCS) THEN
       CALL OBCS_SPONGE_V(
     I           iMin, iMax, jMin, jMax,bi,bj,kLev,
     I           myCurrentTime,myThid)
      ENDIF
#endif

      RETURN
      END
CBOP
C     !ROUTINE: EXTERNAL_FORCING_T
C     !INTERFACE:
      SUBROUTINE EXTERNAL_FORCING_T(
     I           iMin, iMax, jMin, jMax,bi,bj,kLev,
     I           myCurrentTime,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..............   
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"
#ifdef SHORTWAVE_HEATING
      integer two
      _RL minusone
      parameter (two=2,minusone=-1.)
      _RL swfracb(two)
#endif

C     !INPUT/OUTPUT PARAMETERS:
C     == Routine arguments ==
C     iMin - Working range of tile for applying forcing.
C     iMax
C     jMin
C     jMax
C     kLev
      INTEGER iMin, iMax, jMin, jMax, kLev, bi, bj
      _RL myCurrentTime
      INTEGER myThid
CEndOfInterface

C     !LOCAL VARIABLES:
C     == Local variables ==
C     Loop counters
      INTEGER I, J
C     number of surface interface layer
      INTEGER kSurface
CEOP

      if ( buoyancyRelation .eq. 'OCEANICP' ) then
       kSurface = Nr
      else
       kSurface = 1
      endif

C--   Forcing term
C     Add heat in top-layer
      IF ( kLev .EQ. kSurface ) THEN
       DO j=jMin,jMax
        DO i=iMin,iMax
         gT(i,j,kLev,bi,bj)=gT(i,j,kLev,bi,bj)
     &     +maskC(i,j,kLev,bi,bj)*surfaceTendencyT(i,j,bi,bj)
        ENDDO
       ENDDO
      ENDIF

#ifdef SHORTWAVE_HEATING
C Penetrating SW radiation
      swfracb(1)=abs(rF(klev))
      swfracb(2)=abs(rF(klev+1))
      call SWFRAC(
     I     two,minusone,
     I     myCurrentTime,myThid,
     U     swfracb)
      DO j=jMin,jMax
       DO i=iMin,iMax
        gT(i,j,klev,bi,bj) = gT(i,j,klev,bi,bj) 
     &   -maskC(i,j,klev,bi,bj)*Qsw(i,j,bi,bj)*(swfracb(1)-swfracb(2))
     &    *recip_Cp*recip_rhoConst*recip_drF(klev)
       ENDDO
      ENDDO
#endif

#if (defined (ALLOW_OBCS) && defined (ALLOW_OBCS_SPONGE))
      IF (useOBCS) THEN
       CALL OBCS_SPONGE_T(
     I           iMin, iMax, jMin, jMax,bi,bj,kLev,
     I           myCurrentTime,myThid)
      ENDIF
#endif

      RETURN
      END
CBOP
C     !ROUTINE: EXTERNAL_FORCING_S
C     !INTERFACE:
      SUBROUTINE EXTERNAL_FORCING_S(
     I           iMin, iMax, jMin, jMax,bi,bj,kLev,
     I           myCurrentTime,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.......   
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 - Working range of tile for applying forcing.
C     iMax
C     jMin
C     jMax
C     kLev
      INTEGER iMin, iMax, jMin, jMax, kLev, bi, bj
      _RL myCurrentTime
      INTEGER myThid

C     !LOCAL VARIABLES:
C     == Local variables ==
C     Loop counters
      INTEGER I, J
C     number of surface interface layer
      INTEGER kSurface
CEOP

      if ( buoyancyRelation .eq. 'OCEANICP' ) then
       kSurface = Nr
      else
       kSurface = 1
      endif


C--   Forcing term
C     Add fresh-water in top-layer
      IF ( kLev .EQ. kSurface ) THEN
       DO j=jMin,jMax
        DO i=iMin,iMax
         gS(i,j,kLev,bi,bj)=gS(i,j,kLev,bi,bj)
     &   +maskC(i,j,kLev,bi,bj)*surfaceTendencyS(i,j,bi,bj)
        ENDDO
       ENDDO
      ENDIF

#if (defined (ALLOW_OBCS) && defined (ALLOW_OBCS_SPONGE))
      IF (useOBCS) THEN
       CALL OBCS_SPONGE_S(
     I           iMin, iMax, jMin, jMax,bi,bj,kLev,
     I           myCurrentTime,myThid)
      ENDIF
#endif

      RETURN
      END
1	heimbach	1.19	C $Header: /u/gcmpack/MITgcm/model/src/external_forcing.F,v 1.18 2003/02/18 05:33:54 dimitri Exp $
2	adcroft	1.12	C $Name: $
3	cnh	1.1
4			#include "CPP_OPTIONS.h"
5	heimbach	1.19	#ifdef ALLOW_OBCS
6			# include "OBCS_OPTIONS.h"
7			#endif
8	cnh	1.1
9	cnh	1.13	CBOP
10			C !ROUTINE: EXTERNAL_FORCING_U
11			C !INTERFACE:
12	cnh	1.1	SUBROUTINE EXTERNAL_FORCING_U(
13			I iMin, iMax, jMin, jMax,bi,bj,kLev,
14			I myCurrentTime,myThid)
15	cnh	1.13	C !DESCRIPTION: \bv
16			C ==========================================================
17			C \| S/R EXTERNAL_FORCING_U
18			C \| o Contains problem specific forcing for zonal velocity.
19			C ==========================================================
20			C \| Adds terms to gU for forcing by external sources
21			C \| e.g. wind stress, bottom friction etc..................
22			C ==========================================================
23			C \ev
24
25			C !USES:
26	cnh	1.2	IMPLICIT NONE
27	cnh	1.1	C == Global data ==
28			#include "SIZE.h"
29			#include "EEPARAMS.h"
30			#include "PARAMS.h"
31			#include "GRID.h"
32			#include "DYNVARS.h"
33	cnh	1.2	#include "FFIELDS.h"
34	cnh	1.13
35			C !INPUT/OUTPUT PARAMETERS:
36	cnh	1.1	C == Routine arguments ==
37			C iMin - Working range of tile for applying forcing.
38			C iMax
39			C jMin
40			C jMax
41			C kLev
42			INTEGER iMin, iMax, jMin, jMax, kLev, bi, bj
43	adcroft	1.4	_RL myCurrentTime
44			INTEGER myThid
45	cnh	1.1
46	cnh	1.13	C !LOCAL VARIABLES:
47	cnh	1.2	C == Local variables ==
48			C Loop counters
49			INTEGER I, J
50	mlosch	1.17	C number of surface interface layer
51			INTEGER kSurface
52	cnh	1.13	CEOP
53	cnh	1.2
54	mlosch	1.17	if ( buoyancyRelation .eq. 'OCEANICP' ) then
55			kSurface = Nr
56			else
57			kSurface = 1
58			endif
59
60	cnh	1.2	C-- Forcing term
61			C Add windstress momentum impulse into the top-layer
62	mlosch	1.17	IF ( kLev .EQ. kSurface ) THEN
63	cnh	1.2	DO j=jMin,jMax
64			DO i=iMin,iMax
65			gU(i,j,kLev,bi,bj) = gU(i,j,kLev,bi,bj)
66	heimbach	1.7	& +foFacMom*surfaceTendencyU(i,j,bi,bj)
67	adcroft	1.3	& *_maskW(i,j,kLev,bi,bj)
68	cnh	1.2	ENDDO
69			ENDDO
70			ENDIF
71
72	heimbach	1.16	#if (defined (ALLOW_OBCS) && defined (ALLOW_OBCS_SPONGE))
73			IF (useOBCS) THEN
74			CALL OBCS_SPONGE_U(
75			I iMin, iMax, jMin, jMax,bi,bj,kLev,
76			I myCurrentTime,myThid)
77			ENDIF
78	heimbach	1.14	#endif
79
80	cnh	1.1	RETURN
81			END
82	cnh	1.13	CBOP
83			C !ROUTINE: EXTERNAL_FORCING_V
84			C !INTERFACE:
85	cnh	1.1	SUBROUTINE EXTERNAL_FORCING_V(
86			I iMin, iMax, jMin, jMax,bi,bj,kLev,
87			I myCurrentTime,myThid)
88	cnh	1.13	C !DESCRIPTION: \bv
89			C ==========================================================
90			C \| S/R EXTERNAL_FORCING_V
91			C \| o Contains problem specific forcing for merid velocity.
92			C ==========================================================
93			C \| Adds terms to gV for forcing by external sources
94			C \| e.g. wind stress, bottom friction etc..................
95			C ==========================================================
96			C \ev
97
98			C !USES:
99	cnh	1.2	IMPLICIT NONE
100	cnh	1.1	C == Global data ==
101			#include "SIZE.h"
102			#include "EEPARAMS.h"
103			#include "PARAMS.h"
104			#include "GRID.h"
105			#include "DYNVARS.h"
106	cnh	1.2	#include "FFIELDS.h"
107
108	cnh	1.13	C !INPUT/OUTPUT PARAMETERS:
109	cnh	1.1	C == Routine arguments ==
110			C iMin - Working range of tile for applying forcing.
111			C iMax
112			C jMin
113			C jMax
114			C kLev
115			INTEGER iMin, iMax, jMin, jMax, kLev, bi, bj
116	adcroft	1.4	_RL myCurrentTime
117			INTEGER myThid
118	cnh	1.13
119			C !LOCAL VARIABLES:
120	cnh	1.2	C == Local variables ==
121			C Loop counters
122			INTEGER I, J
123	mlosch	1.17	C number of surface interface layer
124			INTEGER kSurface
125	cnh	1.13	CEOP
126	cnh	1.2
127	mlosch	1.17	if ( buoyancyRelation .eq. 'OCEANICP' ) then
128			kSurface = Nr
129			else
130			kSurface = 1
131			endif
132
133	cnh	1.2	C-- Forcing term
134			C Add windstress momentum impulse into the top-layer
135	mlosch	1.17	IF ( kLev .EQ. kSurface ) THEN
136	cnh	1.2	DO j=jMin,jMax
137			DO i=iMin,iMax
138			gV(i,j,kLev,bi,bj) = gV(i,j,kLev,bi,bj)
139	heimbach	1.7	& +foFacMom*surfaceTendencyV(i,j,bi,bj)
140	adcroft	1.3	& *_maskS(i,j,kLev,bi,bj)
141	cnh	1.2	ENDDO
142			ENDDO
143			ENDIF
144	cnh	1.1
145	heimbach	1.16	#if (defined (ALLOW_OBCS) && defined (ALLOW_OBCS_SPONGE))
146			IF (useOBCS) THEN
147			CALL OBCS_SPONGE_V(
148			I iMin, iMax, jMin, jMax,bi,bj,kLev,
149			I myCurrentTime,myThid)
150			ENDIF
151	heimbach	1.14	#endif
152
153	cnh	1.1	RETURN
154			END
155	cnh	1.13	CBOP
156			C !ROUTINE: EXTERNAL_FORCING_T
157			C !INTERFACE:
158	cnh	1.1	SUBROUTINE EXTERNAL_FORCING_T(
159			I iMin, iMax, jMin, jMax,bi,bj,kLev,
160			I myCurrentTime,myThid)
161	cnh	1.13	C !DESCRIPTION: \bv
162			C ==========================================================
163			C \| S/R EXTERNAL_FORCING_T
164			C \| o Contains problem specific forcing for temperature.
165			C ==========================================================
166			C \| Adds terms to gT for forcing by external sources
167			C \| e.g. heat flux, climatalogical relaxation..............
168			C ==========================================================
169			C \ev
170
171			C !USES:
172	cnh	1.2	IMPLICIT NONE
173	cnh	1.1	C == Global data ==
174			#include "SIZE.h"
175			#include "EEPARAMS.h"
176			#include "PARAMS.h"
177			#include "GRID.h"
178			#include "DYNVARS.h"
179			#include "FFIELDS.h"
180	heimbach	1.7	#ifdef SHORTWAVE_HEATING
181	heimbach	1.8	integer two
182			_RL minusone
183			parameter (two=2,minusone=-1.)
184			_RL swfracb(two)
185	heimbach	1.7	#endif
186
187	cnh	1.13	C !INPUT/OUTPUT PARAMETERS:
188	cnh	1.1	C == Routine arguments ==
189			C iMin - Working range of tile for applying forcing.
190			C iMax
191			C jMin
192			C jMax
193			C kLev
194			INTEGER iMin, iMax, jMin, jMax, kLev, bi, bj
195	adcroft	1.4	_RL myCurrentTime
196			INTEGER myThid
197	cnh	1.1	CEndOfInterface
198
199	cnh	1.13	C !LOCAL VARIABLES:
200	cnh	1.2	C == Local variables ==
201			C Loop counters
202			INTEGER I, J
203	mlosch	1.17	C number of surface interface layer
204			INTEGER kSurface
205	cnh	1.13	CEOP
206	cnh	1.2
207	mlosch	1.17	if ( buoyancyRelation .eq. 'OCEANICP' ) then
208			kSurface = Nr
209			else
210			kSurface = 1
211			endif
212
213	cnh	1.2	C-- Forcing term
214			C Add heat in top-layer
215	mlosch	1.17	IF ( kLev .EQ. kSurface ) THEN
216	cnh	1.2	DO j=jMin,jMax
217			DO i=iMin,iMax
218			gT(i,j,kLev,bi,bj)=gT(i,j,kLev,bi,bj)
219	adcroft	1.12	& +maskC(i,j,kLev,bi,bj)*surfaceTendencyT(i,j,bi,bj)
220	cnh	1.2	ENDDO
221			ENDDO
222			ENDIF
223	adcroft	1.5
224			#ifdef SHORTWAVE_HEATING
225			C Penetrating SW radiation
226	heimbach	1.8	swfracb(1)=abs(rF(klev))
227			swfracb(2)=abs(rF(klev+1))
228			call SWFRAC(
229			I two,minusone,
230			I myCurrentTime,myThid,
231	dimitri	1.18	U swfracb)
232	adcroft	1.5	DO j=jMin,jMax
233			DO i=iMin,iMax
234	adcroft	1.12	gT(i,j,klev,bi,bj) = gT(i,j,klev,bi,bj)
235			& -maskC(i,j,klev,bi,bj)Qsw(i,j,bi,bj)(swfracb(1)-swfracb(2))
236	mlosch	1.17	& recip_Cprecip_rhoConst*recip_drF(klev)
237	adcroft	1.5	ENDDO
238			ENDDO
239			#endif
240	heimbach	1.14
241	heimbach	1.16	#if (defined (ALLOW_OBCS) && defined (ALLOW_OBCS_SPONGE))
242			IF (useOBCS) THEN
243			CALL OBCS_SPONGE_T(
244			I iMin, iMax, jMin, jMax,bi,bj,kLev,
245			I myCurrentTime,myThid)
246			ENDIF
247	heimbach	1.14	#endif
248
249	cnh	1.1	RETURN
250			END
251	cnh	1.13	CBOP
252			C !ROUTINE: EXTERNAL_FORCING_S
253			C !INTERFACE:
254	cnh	1.1	SUBROUTINE EXTERNAL_FORCING_S(
255			I iMin, iMax, jMin, jMax,bi,bj,kLev,
256			I myCurrentTime,myThid)
257	cnh	1.13
258			C !DESCRIPTION: \bv
259			C ==========================================================
260			C \| S/R EXTERNAL_FORCING_S
261			C \| o Contains problem specific forcing for merid velocity.
262			C ==========================================================
263			C \| Adds terms to gS for forcing by external sources
264			C \| e.g. fresh-water flux, climatalogical relaxation.......
265			C ==========================================================
266			C \ev
267
268			C !USES:
269	cnh	1.2	IMPLICIT NONE
270	cnh	1.1	C == Global data ==
271			#include "SIZE.h"
272			#include "EEPARAMS.h"
273			#include "PARAMS.h"
274			#include "GRID.h"
275			#include "DYNVARS.h"
276	cnh	1.2	#include "FFIELDS.h"
277	cnh	1.1
278	cnh	1.13	C !INPUT/OUTPUT PARAMETERS:
279	cnh	1.1	C == Routine arguments ==
280			C iMin - Working range of tile for applying forcing.
281			C iMax
282			C jMin
283			C jMax
284			C kLev
285			INTEGER iMin, iMax, jMin, jMax, kLev, bi, bj
286	adcroft	1.4	_RL myCurrentTime
287			INTEGER myThid
288	cnh	1.2
289	cnh	1.13	C !LOCAL VARIABLES:
290	cnh	1.2	C == Local variables ==
291			C Loop counters
292			INTEGER I, J
293	mlosch	1.17	C number of surface interface layer
294			INTEGER kSurface
295	cnh	1.13	CEOP
296	cnh	1.2
297	mlosch	1.17	if ( buoyancyRelation .eq. 'OCEANICP' ) then
298			kSurface = Nr
299			else
300			kSurface = 1
301			endif
302
303
304	cnh	1.2	C-- Forcing term
305			C Add fresh-water in top-layer
306	mlosch	1.17	IF ( kLev .EQ. kSurface ) THEN
307	cnh	1.2	DO j=jMin,jMax
308			DO i=iMin,iMax
309			gS(i,j,kLev,bi,bj)=gS(i,j,kLev,bi,bj)
310	adcroft	1.12	& +maskC(i,j,kLev,bi,bj)*surfaceTendencyS(i,j,bi,bj)
311	cnh	1.2	ENDDO
312			ENDDO
313			ENDIF
314	heimbach	1.14
315	heimbach	1.16	#if (defined (ALLOW_OBCS) && defined (ALLOW_OBCS_SPONGE))
316			IF (useOBCS) THEN
317			CALL OBCS_SPONGE_S(
318			I iMin, iMax, jMin, jMax,bi,bj,kLev,
319			I myCurrentTime,myThid)
320			ENDIF
321	heimbach	1.14	#endif
322	cnh	1.1
323			RETURN
324			END