model/src/external_forcing.F

C     $Header: /u/gcmpack/models/MITgcmUV/model/src/external_forcing.F,v 1.7 2000/09/11 20:45:57 heimbach Exp $

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