model/src/external_forcing.F

C $Header: /u/gcmpack/models/MITgcmUV/model/src/external_forcing.F,v 1.14 2002/03/24 02:18:36 heimbach Exp $
C $Name:  $

#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           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
CEOP

C--   Forcing term
C     Add windstress momentum impulse into the top-layer
      IF ( kLev .EQ. 1 ) 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

#ifdef ALLOW_OBCS
C     IF (useOBCS) THEN
C      CALL OBCS_SPONGE_U(
C    I           iMin, iMax, jMin, jMax,bi,bj,kLev,
C    I           myCurrentTime,myThid)
C     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
CEOP

C--   Forcing term
C     Add windstress momentum impulse into the top-layer
      IF ( kLev .EQ. 1 ) 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

#ifdef ALLOW_OBCS
C     IF (useOBCS) THEN
C      CALL OBCS_SPONGE_V(
C    I           iMin, iMax, jMin, jMax,bi,bj,kLev,
C    I           myCurrentTime,myThid)
C     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
CEOP

C--   Forcing term
C     Add heat in top-layer
      IF ( kLev .EQ. 1 ) 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,
     O     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_rhoNil*recip_drF(klev)
       ENDDO
      ENDDO
#endif

#ifdef ALLOW_OBCS
C     IF (useOBCS) THEN
C      CALL OBCS_SPONGE_T(
C    I           iMin, iMax, jMin, jMax,bi,bj,kLev,
C    I           myCurrentTime,myThid)
C     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
CEOP

C--   Forcing term
C     Add fresh-water in top-layer
      IF ( kLev .EQ. 1 ) 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

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

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