model/src/external_forcing.F

C $Header: /u/gcmpack/models/MITgcmUV/model/src/external_forcing.F,v 1.3 1998/12/15 00:20:34 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
       DO j=jMin,jMax
        DO i=iMin,iMax
         gU(i,j,kLev,bi,bj) = gU(i,j,kLev,bi,bj)
     &   +foFacMom*fu(i,j,bi,bj)
     &   *horiVertRatio*recip_rhoNil*recip_dRf(kLev)
     &   *_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*fv(i,j,bi,bj)
     &   *horiVertRatio*recip_rhoNil*recip_dRf(kLev)
     &   *_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"

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)*(
     &   -lambdaThetaClimRelax*(theta(i,j,kLev,bi,bj)-SST(i,j,bi,bj))
     &   -Qnet(i,j,bi,bj)*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)*(
     &   -lambdaSaltClimRelax*(salt(i,j,kLev,bi,bj)-SSS(i,j,bi,bj))
#ifndef USE_NATURAL_BCS
     &   +EmPmR(i,j,bi,bj)*recip_dRf(1)*35.
#endif
     &   )
        ENDDO
       ENDDO
      ENDIF

      RETURN
      END
1	adcroft	1.4	C $Header: /u/gcmpack/models/MITgcmUV/model/src/external_forcing.F,v 1.3 1998/12/15 00:20:34 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
26			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	adcroft	1.3	& +foFacMom*fu(i,j,bi,bj)
48			& horiVertRatiorecip_rhoNil*recip_dRf(kLev)
49			& *_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			DO j=jMin,jMax
96			DO i=iMin,iMax
97			gV(i,j,kLev,bi,bj) = gV(i,j,kLev,bi,bj)
98	adcroft	1.3	& +foFacMom*fv(i,j,bi,bj)
99			& horiVertRatiorecip_rhoNil*recip_dRf(kLev)
100			& *_maskS(i,j,kLev,bi,bj)
101	cnh	1.2	ENDDO
102			ENDDO
103			ENDIF
104	cnh	1.1
105			RETURN
106			END
107			CStartOfInterface
108			SUBROUTINE EXTERNAL_FORCING_T(
109			I iMin, iMax, jMin, jMax,bi,bj,kLev,
110	cnh	1.2	I maskC,
111	cnh	1.1	I myCurrentTime,myThid)
112			C /==========================================================\
113			C \| S/R EXTERNAL_FORCING_T \|
114			C \| o Contains problem specific forcing for temperature. \|
115			C \|==========================================================\|
116			C \| Adds terms to gT for forcing by external sources \|
117			C \| e.g. heat flux, climatalogical relaxation.............. \|
118			C \==========================================================/
119	cnh	1.2	IMPLICIT NONE
120	cnh	1.1
121			C == Global data ==
122			#include "SIZE.h"
123			#include "EEPARAMS.h"
124			#include "PARAMS.h"
125			#include "GRID.h"
126			#include "DYNVARS.h"
127			#include "FFIELDS.h"
128
129			C == Routine arguments ==
130			C iMin - Working range of tile for applying forcing.
131			C iMax
132			C jMin
133			C jMax
134			C kLev
135	cnh	1.2	_RS maskC (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
136	cnh	1.1	INTEGER iMin, iMax, jMin, jMax, kLev, bi, bj
137	adcroft	1.4	_RL myCurrentTime
138			INTEGER myThid
139	cnh	1.1	CEndOfInterface
140
141	cnh	1.2	C == Local variables ==
142			C Loop counters
143			INTEGER I, J
144
145			C-- Forcing term
146			C Add heat in top-layer
147			IF ( kLev .EQ. 1 ) THEN
148			DO j=jMin,jMax
149			DO i=iMin,iMax
150			gT(i,j,kLev,bi,bj)=gT(i,j,kLev,bi,bj)
151			& +maskC(i,j)*(
152			& -lambdaThetaClimRelax*(theta(i,j,kLev,bi,bj)-SST(i,j,bi,bj))
153	adcroft	1.3	& -Qnet(i,j,bi,bj)recip_Cprecip_rhoNil*recip_dRf(kLev) )
154	cnh	1.2	ENDDO
155			ENDDO
156			ENDIF
157
158	cnh	1.1	RETURN
159			END
160			CStartOfInterface
161			SUBROUTINE EXTERNAL_FORCING_S(
162			I iMin, iMax, jMin, jMax,bi,bj,kLev,
163	cnh	1.2	I maskC,
164	cnh	1.1	I myCurrentTime,myThid)
165			C /==========================================================\
166			C \| S/R EXTERNAL_FORCING_S \|
167			C \| o Contains problem specific forcing for merid velocity. \|
168			C \|==========================================================\|
169			C \| Adds terms to gS for forcing by external sources \|
170			C \| e.g. fresh-water flux, climatalogical relaxation....... \|
171			C \==========================================================/
172	cnh	1.2	IMPLICIT NONE
173	cnh	1.1
174			C == Global data ==
175			#include "SIZE.h"
176			#include "EEPARAMS.h"
177			#include "PARAMS.h"
178			#include "GRID.h"
179			#include "DYNVARS.h"
180	cnh	1.2	#include "FFIELDS.h"
181	cnh	1.1
182			C == Routine arguments ==
183			C iMin - Working range of tile for applying forcing.
184			C iMax
185			C jMin
186			C jMax
187			C kLev
188	cnh	1.2	_RS maskC (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
189	cnh	1.1	INTEGER iMin, iMax, jMin, jMax, kLev, bi, bj
190	adcroft	1.4	_RL myCurrentTime
191			INTEGER myThid
192	cnh	1.1	CEndOfInterface
193	cnh	1.2
194			C == Local variables ==
195			C Loop counters
196			INTEGER I, J
197
198			C-- Forcing term
199			C Add fresh-water in top-layer
200			IF ( kLev .EQ. 1 ) THEN
201			DO j=jMin,jMax
202			DO i=iMin,iMax
203			gS(i,j,kLev,bi,bj)=gS(i,j,kLev,bi,bj)
204			& +maskC(i,j)*(
205			& -lambdaSaltClimRelax*(salt(i,j,kLev,bi,bj)-SSS(i,j,bi,bj))
206	adcroft	1.3	#ifndef USE_NATURAL_BCS
207			& +EmPmR(i,j,bi,bj)recip_dRf(1)35.
208			#endif
209			& )
210	cnh	1.2	ENDDO
211			ENDDO
212			ENDIF
213	cnh	1.1
214			RETURN
215			END