/[MITgcm]/MITgcm/model/src/external_forcing.F
ViewVC logotype

Annotation of /MITgcm/model/src/external_forcing.F

Parent Directory Parent Directory | Revision Log Revision Log | View Revision Graph Revision Graph

Revision 1.13 - (hide annotations) (download)
Wed Sep 26 18:09:14 2001 UTC (22 years, 8 months ago) by cnh
Branch: MAIN
CVS Tags: checkpoint44e_post, checkpoint44f_post, checkpoint43a-release1mods, chkpt44d_post, checkpoint44e_pre, release1_b1, checkpoint43, release1_chkpt44d_post, release1-branch_tutorials, chkpt44a_post, checkpoint44h_pre, chkpt44c_pre, ecco_c44_e17, ecco_c44_e16, checkpoint44g_post, release1-branch-end, checkpoint44b_post, chkpt44a_pre, ecco-branch-mod1, ecco-branch-mod2, ecco-branch-mod3, ecco-branch-mod4, ecco-branch-mod5, release1_beta1, checkpoint44b_pre, checkpoint42, checkpoint41, checkpoint44, chkpt44c_post, checkpoint44f_pre, release1-branch_branchpoint
Branch point for: release1_final, release1-branch, release1, ecco-branch, release1_coupled
Changes since 1.12: +72 -42 lines 
Bringing comments up to data and formatting for document extraction.
1 cnh 1.13 C $Header: /u/gcmpack/models/MITgcmUV/model/src/external_forcing.F,v 1.12 2001/05/29 14:01:37 adcroft 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 cnh 1.1 RETURN
62     END
63 cnh 1.13 CBOP
64     C !ROUTINE: EXTERNAL_FORCING_V
65     C !INTERFACE:
66 cnh 1.1 SUBROUTINE EXTERNAL_FORCING_V(
67     I iMin, iMax, jMin, jMax,bi,bj,kLev,
68     I myCurrentTime,myThid)
69 cnh 1.13 C !DESCRIPTION: \bv
70     C *==========================================================*
71     C | S/R EXTERNAL_FORCING_V
72     C | o Contains problem specific forcing for merid velocity.
73     C *==========================================================*
74     C | Adds terms to gV for forcing by external sources
75     C | e.g. wind stress, bottom friction etc..................
76     C *==========================================================*
77     C \ev
78    
79     C !USES:
80 cnh 1.2 IMPLICIT NONE
81 cnh 1.1 C == Global data ==
82     #include "SIZE.h"
83     #include "EEPARAMS.h"
84     #include "PARAMS.h"
85     #include "GRID.h"
86     #include "DYNVARS.h"
87 cnh 1.2 #include "FFIELDS.h"
88    
89 cnh 1.13 C !INPUT/OUTPUT PARAMETERS:
90 cnh 1.1 C == Routine arguments ==
91     C iMin - Working range of tile for applying forcing.
92     C iMax
93     C jMin
94     C jMax
95     C kLev
96     INTEGER iMin, iMax, jMin, jMax, kLev, bi, bj
97 adcroft 1.4 _RL myCurrentTime
98     INTEGER myThid
99 cnh 1.13
100     C !LOCAL VARIABLES:
101 cnh 1.2 C == Local variables ==
102     C Loop counters
103     INTEGER I, J
104 cnh 1.13 CEOP
105 cnh 1.2
106     C-- Forcing term
107     C Add windstress momentum impulse into the top-layer
108     IF ( kLev .EQ. 1 ) THEN
109     DO j=jMin,jMax
110     DO i=iMin,iMax
111     gV(i,j,kLev,bi,bj) = gV(i,j,kLev,bi,bj)
112 heimbach 1.7 & +foFacMom*surfaceTendencyV(i,j,bi,bj)
113 adcroft 1.3 & *_maskS(i,j,kLev,bi,bj)
114 cnh 1.2 ENDDO
115     ENDDO
116     ENDIF
117 cnh 1.1
118     RETURN
119     END
120 cnh 1.13 CBOP
121     C !ROUTINE: EXTERNAL_FORCING_T
122     C !INTERFACE:
123 cnh 1.1 SUBROUTINE EXTERNAL_FORCING_T(
124     I iMin, iMax, jMin, jMax,bi,bj,kLev,
125     I myCurrentTime,myThid)
126 cnh 1.13 C !DESCRIPTION: \bv
127     C *==========================================================*
128     C | S/R EXTERNAL_FORCING_T
129     C | o Contains problem specific forcing for temperature.
130     C *==========================================================*
131     C | Adds terms to gT for forcing by external sources
132     C | e.g. heat flux, climatalogical relaxation..............
133     C *==========================================================*
134     C \ev
135    
136     C !USES:
137 cnh 1.2 IMPLICIT NONE
138 cnh 1.1 C == Global data ==
139     #include "SIZE.h"
140     #include "EEPARAMS.h"
141     #include "PARAMS.h"
142     #include "GRID.h"
143     #include "DYNVARS.h"
144     #include "FFIELDS.h"
145 heimbach 1.7 #ifdef SHORTWAVE_HEATING
146 heimbach 1.8 integer two
147     _RL minusone
148     parameter (two=2,minusone=-1.)
149     _RL swfracb(two)
150 heimbach 1.7 #endif
151    
152 cnh 1.13 C !INPUT/OUTPUT PARAMETERS:
153 cnh 1.1 C == Routine arguments ==
154     C iMin - Working range of tile for applying forcing.
155     C iMax
156     C jMin
157     C jMax
158     C kLev
159     INTEGER iMin, iMax, jMin, jMax, kLev, bi, bj
160 adcroft 1.4 _RL myCurrentTime
161     INTEGER myThid
162 cnh 1.1 CEndOfInterface
163    
164 cnh 1.13 C !LOCAL VARIABLES:
165 cnh 1.2 C == Local variables ==
166     C Loop counters
167     INTEGER I, J
168 cnh 1.13 CEOP
169 cnh 1.2
170     C-- Forcing term
171     C Add heat in top-layer
172     IF ( kLev .EQ. 1 ) THEN
173     DO j=jMin,jMax
174     DO i=iMin,iMax
175     gT(i,j,kLev,bi,bj)=gT(i,j,kLev,bi,bj)
176 adcroft 1.12 & +maskC(i,j,kLev,bi,bj)*surfaceTendencyT(i,j,bi,bj)
177 cnh 1.2 ENDDO
178     ENDDO
179     ENDIF
180 adcroft 1.5
181     #ifdef SHORTWAVE_HEATING
182     C Penetrating SW radiation
183 heimbach 1.8 swfracb(1)=abs(rF(klev))
184     swfracb(2)=abs(rF(klev+1))
185     call SWFRAC(
186     I two,minusone,
187     I myCurrentTime,myThid,
188     O swfracb)
189 adcroft 1.5 DO j=jMin,jMax
190     DO i=iMin,iMax
191 adcroft 1.12 gT(i,j,klev,bi,bj) = gT(i,j,klev,bi,bj)
192     & -maskC(i,j,klev,bi,bj)*Qsw(i,j,bi,bj)*(swfracb(1)-swfracb(2))
193     & *recip_Cp*recip_rhoNil*recip_drF(klev)
194 adcroft 1.5 ENDDO
195     ENDDO
196     #endif
197 cnh 1.1 RETURN
198     END
199 cnh 1.13 CBOP
200     C !ROUTINE: EXTERNAL_FORCING_S
201     C !INTERFACE:
202 cnh 1.1 SUBROUTINE EXTERNAL_FORCING_S(
203     I iMin, iMax, jMin, jMax,bi,bj,kLev,
204     I myCurrentTime,myThid)
205 cnh 1.13
206     C !DESCRIPTION: \bv
207     C *==========================================================*
208     C | S/R EXTERNAL_FORCING_S
209     C | o Contains problem specific forcing for merid velocity.
210     C *==========================================================*
211     C | Adds terms to gS for forcing by external sources
212     C | e.g. fresh-water flux, climatalogical relaxation.......
213     C *==========================================================*
214     C \ev
215    
216     C !USES:
217 cnh 1.2 IMPLICIT NONE
218 cnh 1.1 C == Global data ==
219     #include "SIZE.h"
220     #include "EEPARAMS.h"
221     #include "PARAMS.h"
222     #include "GRID.h"
223     #include "DYNVARS.h"
224 cnh 1.2 #include "FFIELDS.h"
225 cnh 1.1
226 cnh 1.13 C !INPUT/OUTPUT PARAMETERS:
227 cnh 1.1 C == Routine arguments ==
228     C iMin - Working range of tile for applying forcing.
229     C iMax
230     C jMin
231     C jMax
232     C kLev
233     INTEGER iMin, iMax, jMin, jMax, kLev, bi, bj
234 adcroft 1.4 _RL myCurrentTime
235     INTEGER myThid
236 cnh 1.2
237 cnh 1.13 C !LOCAL VARIABLES:
238 cnh 1.2 C == Local variables ==
239     C Loop counters
240     INTEGER I, J
241 cnh 1.13 CEOP
242 cnh 1.2
243     C-- Forcing term
244     C Add fresh-water in top-layer
245     IF ( kLev .EQ. 1 ) THEN
246     DO j=jMin,jMax
247     DO i=iMin,iMax
248     gS(i,j,kLev,bi,bj)=gS(i,j,kLev,bi,bj)
249 adcroft 1.12 & +maskC(i,j,kLev,bi,bj)*surfaceTendencyS(i,j,bi,bj)
250 cnh 1.2 ENDDO
251     ENDDO
252     ENDIF
253 cnh 1.1
254     RETURN
255     END
  ViewVC Help
Powered by ViewVC 1.1.22