model/src/external_forcing.F

C     $Header: /u/gcmpack/models/MITgcmUV/model/src/external_forcing.F,v 1.10 2001/02/04 14:38:47 cnh Exp $
C $Name: checkpoint37 $

#include "CPP_OPTIONS.h"

CStartOfInterface
      SUBROUTINE EXTERNAL_FORCING_U(
     I           iMin, iMax, jMin, jMax,bi,bj,kLev,
     I           myCurrentTime,myThid)
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     \==========================================================/
      IMPLICIT NONE

C     == Global data ==
#include "SIZE.h"
#include "EEPARAMS.h"
#include "PARAMS.h"
#include "GRID.h"
#include "DYNVARS.h"
#include "FFIELDS.h"
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     Loop counters
      INTEGER I, J

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

      RETURN
      END
CStartOfInterface
      SUBROUTINE EXTERNAL_FORCING_V(
     I           iMin, iMax, jMin, jMax,bi,bj,kLev,
     I           myCurrentTime,myThid)
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     \==========================================================/
      IMPLICIT NONE

C     == Global data ==
#include "SIZE.h"
#include "EEPARAMS.h"
#include "PARAMS.h"
#include "GRID.h"
#include "DYNVARS.h"
#include "FFIELDS.h"


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     Loop counters
      INTEGER I, J

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

      RETURN
      END
CStartOfInterface
      SUBROUTINE EXTERNAL_FORCING_T(
     I           iMin, iMax, jMin, jMax,bi,bj,kLev,
     I           maskC,
     I           myCurrentTime,myThid)
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     \==========================================================/
      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     == Routine arguments ==
C     iMin - Working range of tile for applying forcing.
C     iMax
C     jMin
C     jMax
C     kLev
      _RS maskC (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
      INTEGER iMin, iMax, jMin, jMax, kLev, bi, bj
      _RL myCurrentTime
      INTEGER myThid
CEndOfInterface

C     == Local variables ==
C     Loop counters
      INTEGER I, J

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)*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)*Qsw(i,j,bi,bj)*(swfracb(1)-swfracb(2))
     &    *recip_Cp*recip_rhoNil*recip_dRf(klev)
       ENDDO
      ENDDO
#endif
      RETURN
      END
CStartOfInterface
      SUBROUTINE EXTERNAL_FORCING_S(
     I           iMin, iMax, jMin, jMax,bi,bj,kLev,
     I           maskC,
     I           myCurrentTime,myThid)
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     \==========================================================/
      IMPLICIT NONE

C     == Global data ==
#include "SIZE.h"
#include "EEPARAMS.h"
#include "PARAMS.h"
#include "GRID.h"
#include "DYNVARS.h"
#include "FFIELDS.h"

C     == Routine arguments ==
C     iMin - Working range of tile for applying forcing.
C     iMax
C     jMin
C     jMax
C     kLev
      _RS maskC (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
      INTEGER iMin, iMax, jMin, jMax, kLev, bi, bj
      _RL myCurrentTime
      INTEGER myThid
CEndOfInterface

C     == Local variables ==
C     Loop counters
      INTEGER I, J

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)*surfaceTendencyS(i,j,bi,bj)
        ENDDO
       ENDDO
      ENDIF

      RETURN
      END
1	heimbach	1.11	C $Header: /u/gcmpack/models/MITgcmUV/model/src/external_forcing.F,v 1.10 2001/02/04 14:38:47 cnh Exp $
2			C $Name: checkpoint37 $
3	cnh	1.1
4			#include "CPP_OPTIONS.h"
5
6			CStartOfInterface
7			SUBROUTINE EXTERNAL_FORCING_U(
8			I iMin, iMax, jMin, jMax,bi,bj,kLev,
9			I myCurrentTime,myThid)
10			C /==========================================================\
11			C \| S/R EXTERNAL_FORCING_U \|
12			C \| o Contains problem specific forcing for zonal velocity. \|
13			C \|==========================================================\|
14			C \| Adds terms to gU for forcing by external sources \|
15			C \| e.g. wind stress, bottom friction etc.................. \|
16			C \==========================================================/
17	cnh	1.2	IMPLICIT NONE
18	cnh	1.1
19			C == Global data ==
20			#include "SIZE.h"
21			#include "EEPARAMS.h"
22			#include "PARAMS.h"
23			#include "GRID.h"
24			#include "DYNVARS.h"
25	cnh	1.2	#include "FFIELDS.h"
26	cnh	1.1	C == Routine arguments ==
27			C iMin - Working range of tile for applying forcing.
28			C iMax
29			C jMin
30			C jMax
31			C kLev
32			INTEGER iMin, iMax, jMin, jMax, kLev, bi, bj
33	adcroft	1.4	_RL myCurrentTime
34			INTEGER myThid
35	cnh	1.1	CEndOfInterface
36
37	cnh	1.2	C == Local variables ==
38			C Loop counters
39			INTEGER I, J
40
41			C-- Forcing term
42			C Add windstress momentum impulse into the top-layer
43			IF ( kLev .EQ. 1 ) THEN
44			DO j=jMin,jMax
45			DO i=iMin,iMax
46			gU(i,j,kLev,bi,bj) = gU(i,j,kLev,bi,bj)
47	heimbach	1.7	& +foFacMom*surfaceTendencyU(i,j,bi,bj)
48	adcroft	1.3	& *_maskW(i,j,kLev,bi,bj)
49	cnh	1.2	ENDDO
50			ENDDO
51			ENDIF
52
53	cnh	1.1	RETURN
54			END
55			CStartOfInterface
56			SUBROUTINE EXTERNAL_FORCING_V(
57			I iMin, iMax, jMin, jMax,bi,bj,kLev,
58			I myCurrentTime,myThid)
59			C /==========================================================\
60			C \| S/R EXTERNAL_FORCING_V \|
61			C \| o Contains problem specific forcing for merid velocity. \|
62			C \|==========================================================\|
63			C \| Adds terms to gV for forcing by external sources \|
64			C \| e.g. wind stress, bottom friction etc.................. \|
65			C \==========================================================/
66	cnh	1.2	IMPLICIT NONE
67	cnh	1.1
68			C == Global data ==
69			#include "SIZE.h"
70			#include "EEPARAMS.h"
71			#include "PARAMS.h"
72			#include "GRID.h"
73			#include "DYNVARS.h"
74	cnh	1.2	#include "FFIELDS.h"
75
76	cnh	1.1
77			C == Routine arguments ==
78			C iMin - Working range of tile for applying forcing.
79			C iMax
80			C jMin
81			C jMax
82			C kLev
83			INTEGER iMin, iMax, jMin, jMax, kLev, bi, bj
84	adcroft	1.4	_RL myCurrentTime
85			INTEGER myThid
86	cnh	1.1	CEndOfInterface
87	cnh	1.2	C == Local variables ==
88			C Loop counters
89			INTEGER I, J
90
91			C-- Forcing term
92			C Add windstress momentum impulse into the top-layer
93			IF ( kLev .EQ. 1 ) THEN
94			DO j=jMin,jMax
95			DO i=iMin,iMax
96			gV(i,j,kLev,bi,bj) = gV(i,j,kLev,bi,bj)
97	heimbach	1.7	& +foFacMom*surfaceTendencyV(i,j,bi,bj)
98	adcroft	1.3	& *_maskS(i,j,kLev,bi,bj)
99	cnh	1.2	ENDDO
100			ENDDO
101			ENDIF
102	cnh	1.1
103			RETURN
104			END
105			CStartOfInterface
106			SUBROUTINE EXTERNAL_FORCING_T(
107			I iMin, iMax, jMin, jMax,bi,bj,kLev,
108	cnh	1.2	I maskC,
109	cnh	1.1	I myCurrentTime,myThid)
110			C /==========================================================\
111			C \| S/R EXTERNAL_FORCING_T \|
112			C \| o Contains problem specific forcing for temperature. \|
113			C \|==========================================================\|
114			C \| Adds terms to gT for forcing by external sources \|
115			C \| e.g. heat flux, climatalogical relaxation.............. \|
116			C \==========================================================/
117	cnh	1.2	IMPLICIT NONE
118	cnh	1.1
119			C == Global data ==
120			#include "SIZE.h"
121			#include "EEPARAMS.h"
122			#include "PARAMS.h"
123			#include "GRID.h"
124			#include "DYNVARS.h"
125			#include "FFIELDS.h"
126	heimbach	1.7	#ifdef SHORTWAVE_HEATING
127	heimbach	1.8	integer two
128			_RL minusone
129			parameter (two=2,minusone=-1.)
130			_RL swfracb(two)
131	heimbach	1.7	#endif
132
133	cnh	1.1
134			C == Routine arguments ==
135			C iMin - Working range of tile for applying forcing.
136			C iMax
137			C jMin
138			C jMax
139			C kLev
140	cnh	1.2	_RS maskC (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
141	cnh	1.1	INTEGER iMin, iMax, jMin, jMax, kLev, bi, bj
142	adcroft	1.4	_RL myCurrentTime
143			INTEGER myThid
144	cnh	1.1	CEndOfInterface
145
146	cnh	1.2	C == Local variables ==
147			C Loop counters
148			INTEGER I, J
149
150			C-- Forcing term
151			C Add heat in top-layer
152			IF ( kLev .EQ. 1 ) THEN
153			DO j=jMin,jMax
154			DO i=iMin,iMax
155			gT(i,j,kLev,bi,bj)=gT(i,j,kLev,bi,bj)
156	heimbach	1.7	& +maskC(i,j)*surfaceTendencyT(i,j,bi,bj)
157	cnh	1.2	ENDDO
158			ENDDO
159			ENDIF
160	adcroft	1.5
161			#ifdef SHORTWAVE_HEATING
162			C Penetrating SW radiation
163	heimbach	1.8	swfracb(1)=abs(rF(klev))
164			swfracb(2)=abs(rF(klev+1))
165			call SWFRAC(
166			I two,minusone,
167			I myCurrentTime,myThid,
168			O swfracb)
169	adcroft	1.5	DO j=jMin,jMax
170			DO i=iMin,iMax
171	heimbach	1.7	gT(i,j,klev,bi,bj) = gT(i,j,klev,bi,bj)
172	adcroft	1.9	& -maskC(i,j)Qsw(i,j,bi,bj)(swfracb(1)-swfracb(2))
173	heimbach	1.11	& recip_Cprecip_rhoNil*recip_dRf(klev)
174	adcroft	1.5	ENDDO
175			ENDDO
176			#endif
177	cnh	1.1	RETURN
178			END
179			CStartOfInterface
180			SUBROUTINE EXTERNAL_FORCING_S(
181			I iMin, iMax, jMin, jMax,bi,bj,kLev,
182	cnh	1.2	I maskC,
183	cnh	1.1	I myCurrentTime,myThid)
184			C /==========================================================\
185			C \| S/R EXTERNAL_FORCING_S \|
186			C \| o Contains problem specific forcing for merid velocity. \|
187			C \|==========================================================\|
188			C \| Adds terms to gS for forcing by external sources \|
189			C \| e.g. fresh-water flux, climatalogical relaxation....... \|
190			C \==========================================================/
191	cnh	1.2	IMPLICIT NONE
192	cnh	1.1
193			C == Global data ==
194			#include "SIZE.h"
195			#include "EEPARAMS.h"
196			#include "PARAMS.h"
197			#include "GRID.h"
198			#include "DYNVARS.h"
199	cnh	1.2	#include "FFIELDS.h"
200	cnh	1.1
201			C == Routine arguments ==
202			C iMin - Working range of tile for applying forcing.
203			C iMax
204			C jMin
205			C jMax
206			C kLev
207	cnh	1.2	_RS maskC (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
208	cnh	1.1	INTEGER iMin, iMax, jMin, jMax, kLev, bi, bj
209	adcroft	1.4	_RL myCurrentTime
210			INTEGER myThid
211	cnh	1.1	CEndOfInterface
212	cnh	1.2
213			C == Local variables ==
214			C Loop counters
215			INTEGER I, J
216
217			C-- Forcing term
218			C Add fresh-water in top-layer
219			IF ( kLev .EQ. 1 ) THEN
220			DO j=jMin,jMax
221			DO i=iMin,iMax
222			gS(i,j,kLev,bi,bj)=gS(i,j,kLev,bi,bj)
223	heimbach	1.7	& +maskC(i,j)*surfaceTendencyS(i,j,bi,bj)
224	cnh	1.2	ENDDO
225			ENDDO
226			ENDIF
227	cnh	1.1
228			RETURN
229			END