model/src/external_forcing.F

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