1 |
C $Header: /u/gcmpack/MITgcm/pkg/ecco/cost_gencost_customize.F,v 1.22 2015/11/13 20:15:27 atn Exp $ |
2 |
C $Name: $ |
3 |
|
4 |
#include "ECCO_OPTIONS.h" |
5 |
#ifdef ALLOW_SEAICE |
6 |
# include "SEAICE_OPTIONS.h" |
7 |
#endif |
8 |
#ifdef ALLOW_EXF |
9 |
# include "EXF_OPTIONS.h" |
10 |
#endif |
11 |
#ifdef ALLOW_CTRL |
12 |
# include "CTRL_OPTIONS.h" |
13 |
#endif |
14 |
#ifdef ALLOW_GMREDI |
15 |
# include "GMREDI_OPTIONS.h" |
16 |
#endif |
17 |
|
18 |
subroutine cost_gencost_customize( mythid ) |
19 |
|
20 |
c ================================================================== |
21 |
c SUBROUTINE cost_gencost_customize |
22 |
c ================================================================== |
23 |
|
24 |
implicit none |
25 |
|
26 |
c == global variables == |
27 |
|
28 |
#include "EEPARAMS.h" |
29 |
#include "SIZE.h" |
30 |
#include "GRID.h" |
31 |
#include "PARAMS.h" |
32 |
#include "DYNVARS.h" |
33 |
#include "FFIELDS.h" |
34 |
#ifdef ALLOW_ECCO |
35 |
# include "ecco.h" |
36 |
#endif |
37 |
#ifdef ALLOW_SEAICE |
38 |
# include "SEAICE_SIZE.h" |
39 |
# include "SEAICE.h" |
40 |
#endif |
41 |
#ifdef ALLOW_EXF |
42 |
# include "EXF_FIELDS.h" |
43 |
#endif |
44 |
#ifdef ALLOW_CTRL |
45 |
# include "CTRL_FIELDS.h" |
46 |
#endif |
47 |
|
48 |
c == routine arguments == |
49 |
|
50 |
integer mythid |
51 |
|
52 |
#ifdef ALLOW_GENCOST_CONTRIBUTION |
53 |
c == local variables == |
54 |
|
55 |
integer bi,bj |
56 |
integer i,j,k |
57 |
#ifdef ALLOW_GENCOST3D |
58 |
integer k2,kk |
59 |
#endif |
60 |
#ifdef ALLOW_EXF |
61 |
_RL uBarC, vBarC |
62 |
_RL zontau (1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
63 |
_RL mertau (1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
64 |
_RL zonwind (1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
65 |
_RL merwind (1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
66 |
#endif |
67 |
integer itlo,ithi |
68 |
integer jtlo,jthi |
69 |
integer jmin,jmax |
70 |
integer imin,imax |
71 |
|
72 |
c == end of interface == |
73 |
|
74 |
jtlo = mybylo(mythid) |
75 |
jthi = mybyhi(mythid) |
76 |
itlo = mybxlo(mythid) |
77 |
ithi = mybxhi(mythid) |
78 |
jmin = 1 |
79 |
jmax = sny |
80 |
imin = 1 |
81 |
imax = snx |
82 |
|
83 |
|
84 |
#ifdef ALLOW_EXF |
85 |
c rotated to EW/NS tracer point |
86 |
do bj = jtlo,jthi |
87 |
do bi = itlo,ithi |
88 |
do j = jmin,jmax |
89 |
do i = imin,imax |
90 |
uBarC = 0.5 _d 0 |
91 |
& *(ustress(i,j,bi,bj)+ustress(i+1,j,bi,bj)) |
92 |
vBarC = 0.5 _d 0 |
93 |
& *(vstress(i,j,bi,bj)+vstress(i,j+1,bi,bj)) |
94 |
zontau(i,j,bi,bj) = angleCosC(i,j,bi,bj)*uBarC |
95 |
& -angleSinC(i,j,bi,bj)*vBarC |
96 |
mertau(i,j,bi,bj) = angleSinC(i,j,bi,bj)*uBarC |
97 |
& +angleCosC(i,j,bi,bj)*vBarC |
98 |
enddo |
99 |
enddo |
100 |
enddo |
101 |
enddo |
102 |
|
103 |
c the following should be identical to the above |
104 |
c CALL ROTATE_UV2EN_RL(ustress,vstress,zontau,mertau, |
105 |
c & .TRUE.,.TRUE.,.TRUE.,1,myThid) |
106 |
|
107 |
CALL ROTATE_UV2EN_RL(uwind,vwind,zonwind,merwind, |
108 |
& .TRUE.,.FALSE.,.TRUE.,1,myThid) |
109 |
#endif |
110 |
|
111 |
do k=1,NGENCOST |
112 |
do bj = jtlo,jthi |
113 |
do bi = itlo,ithi |
114 |
do j = jmin,jmax |
115 |
do i = imin,imax |
116 |
|
117 |
if (gencost_barfile(k)(1:5).EQ.'m_eta') then |
118 |
gencost_modfld(i,j,bi,bj,k) = |
119 |
& m_eta(i,j,bi,bj)*maskC(i,j,1,bi,bj) |
120 |
elseif (gencost_barfile(k)(1:9).EQ.'m_boxmean') then |
121 |
gencost_modfld(i,j,bi,bj,k) = |
122 |
& gencost_storefld(i,j,bi,bj,k) |
123 |
elseif (gencost_barfile(k)(1:5).EQ.'m_sst') then |
124 |
gencost_modfld(i,j,bi,bj,k) = |
125 |
& THETA(i,j,1,bi,bj)*maskC(i,j,1,bi,bj) |
126 |
elseif (gencost_barfile(k)(1:5).EQ.'m_sss') then |
127 |
gencost_modfld(i,j,bi,bj,k) = |
128 |
& SALT(i,j,1,bi,bj)*maskC(i,j,1,bi,bj) |
129 |
elseif (gencost_barfile(k)(1:4).EQ.'m_bp') then |
130 |
gencost_modfld(i,j,bi,bj,k) = |
131 |
& phiHydLow(i,j,bi,bj)*maskC(i,j,1,bi,bj) |
132 |
#ifdef ALLOW_GEOTHERMAL_FLUX |
133 |
elseif (gencost_barfile(k)(1:16).EQ.'m_geothermalflux') then |
134 |
gencost_modfld(i,j,bi,bj,k) = |
135 |
& geothermalFlux(i,j,bi,bj)*maskC(i,j,1,bi,bj) |
136 |
#endif |
137 |
#ifdef ALLOW_EXF |
138 |
elseif (gencost_barfile(k)(1:9).EQ.'m_ustress') then |
139 |
gencost_modfld(i,j,bi,bj,k) = |
140 |
& zontau(i,j,bi,bj)*maskC(i,j,1,bi,bj) |
141 |
elseif (gencost_barfile(k)(1:9).EQ.'m_vstress') then |
142 |
gencost_modfld(i,j,bi,bj,k) = |
143 |
& mertau(i,j,bi,bj)*maskC(i,j,1,bi,bj) |
144 |
elseif (gencost_barfile(k)(1:7).EQ.'m_uwind') then |
145 |
gencost_modfld(i,j,bi,bj,k) = |
146 |
& zonwind(i,j,bi,bj)*maskC(i,j,1,bi,bj) |
147 |
elseif (gencost_barfile(k)(1:7).EQ.'m_vwind') then |
148 |
gencost_modfld(i,j,bi,bj,k) = |
149 |
& merwind(i,j,bi,bj)*maskC(i,j,1,bi,bj) |
150 |
elseif (gencost_barfile(k)(1:7).EQ.'m_atemp') then |
151 |
gencost_modfld(i,j,bi,bj,k) = |
152 |
& atemp(i,j,bi,bj)*maskC(i,j,1,bi,bj) |
153 |
elseif (gencost_barfile(k)(1:5).EQ.'m_aqh') then |
154 |
gencost_modfld(i,j,bi,bj,k) = |
155 |
& aqh(i,j,bi,bj)*maskC(i,j,1,bi,bj) |
156 |
elseif (gencost_barfile(k)(1:8).EQ.'m_precip') then |
157 |
gencost_modfld(i,j,bi,bj,k) = |
158 |
& precip(i,j,bi,bj)*maskC(i,j,1,bi,bj) |
159 |
elseif (gencost_barfile(k)(1:8).EQ.'m_swdown') then |
160 |
gencost_modfld(i,j,bi,bj,k) = |
161 |
& swdown(i,j,bi,bj)*maskC(i,j,1,bi,bj) |
162 |
elseif (gencost_barfile(k)(1:8).EQ.'m_lwdown') then |
163 |
gencost_modfld(i,j,bi,bj,k) = |
164 |
& lwdown(i,j,bi,bj)*maskC(i,j,1,bi,bj) |
165 |
elseif (gencost_barfile(k)(1:8).EQ.'m_wspeed') then |
166 |
gencost_modfld(i,j,bi,bj,k) = |
167 |
& wspeed(i,j,bi,bj)*maskC(i,j,1,bi,bj) |
168 |
#endif |
169 |
#ifdef ALLOW_CTRL |
170 |
#ifdef ALLOW_BOTTOMDRAG_CONTROL |
171 |
elseif (gencost_barfile(k)(1:12).EQ.'m_bottomdrag') then |
172 |
gencost_modfld(i,j,bi,bj,k) = |
173 |
& bottomDragFld(i,j,bi,bj)*maskC(i,j,1,bi,bj) |
174 |
#endif |
175 |
#endif |
176 |
#ifdef ALLOW_SEAICE |
177 |
elseif ( (gencost_name(k).EQ.'siv4-conc').OR. |
178 |
& (gencost_barfile(k)(1:8).EQ.'m_siarea') ) then |
179 |
gencost_modfld(i,j,bi,bj,k) = |
180 |
& area(i,j,bi,bj)*maskC(i,j,1,bi,bj) |
181 |
elseif (gencost_name(k).EQ.'siv4-deconc') then |
182 |
gencost_modfld(i,j,bi,bj,k) = |
183 |
& theta(i,j,1,bi,bj)*maskC(i,j,1,bi,bj) |
184 |
elseif ( (gencost_name(k).EQ.'siv4-exconc').OR. |
185 |
& (gencost_barfile(k)(1:8).EQ.'m_siheff') ) then |
186 |
gencost_modfld(i,j,bi,bj,k) = |
187 |
& heff(i,j,bi,bj)*maskC(i,j,1,bi,bj) |
188 |
elseif (gencost_barfile(k)(1:9).EQ.'m_sihsnow') then |
189 |
gencost_modfld(i,j,bi,bj,k) = |
190 |
& hsnow(i,j,bi,bj)*maskC(i,j,1,bi,bj) |
191 |
#endif |
192 |
#ifdef ALLOW_GENCOST3D |
193 |
elseif (gencost_barfile(k)(1:7).EQ.'m_theta') then |
194 |
kk=gencost_pointer3d(k) |
195 |
do k2=1,nr |
196 |
gencost_mod3d(i,j,k2,bi,bj,kk) = |
197 |
& theta(i,j,k2,bi,bj)*maskC(i,j,k2,bi,bj) |
198 |
enddo |
199 |
elseif (gencost_barfile(k)(1:6).EQ.'m_salt') then |
200 |
kk=gencost_pointer3d(k) |
201 |
do k2=1,nr |
202 |
gencost_mod3d(i,j,k2,bi,bj,kk) = |
203 |
& salt(i,j,k2,bi,bj)*maskC(i,j,k2,bi,bj) |
204 |
enddo |
205 |
elseif (gencost_barfile(k)(1:4).EQ.'m_UE') then |
206 |
kk=gencost_pointer3d(k) |
207 |
do k2=1,nr |
208 |
gencost_mod3d(i,j,k2,bi,bj,kk) = |
209 |
& m_UE(i,j,k2,bi,bj)*maskC(i,j,k2,bi,bj) |
210 |
enddo |
211 |
elseif (gencost_barfile(k)(1:4).EQ.'m_VN') then |
212 |
kk=gencost_pointer3d(k) |
213 |
do k2=1,nr |
214 |
gencost_mod3d(i,j,k2,bi,bj,kk) = |
215 |
& m_VN(i,j,k2,bi,bj)*maskC(i,j,k2,bi,bj) |
216 |
enddo |
217 |
elseif (gencost_barfile(k)(1:7).EQ.'m_trVol') then |
218 |
kk=gencost_pointer3d(k) |
219 |
do k2=1,nr |
220 |
gencost_mod3d(i,j,k2,bi,bj,kk) = trVol(i,j,k2,bi,bj) |
221 |
enddo |
222 |
elseif (gencost_barfile(k)(1:8).EQ.'m_trHeat') then |
223 |
kk=gencost_pointer3d(k) |
224 |
do k2=1,nr |
225 |
gencost_mod3d(i,j,k2,bi,bj,kk) = trHeat(i,j,k2,bi,bj) |
226 |
enddo |
227 |
elseif (gencost_barfile(k)(1:8).EQ.'m_trSalt') then |
228 |
kk=gencost_pointer3d(k) |
229 |
do k2=1,nr |
230 |
gencost_mod3d(i,j,k2,bi,bj,kk) = trSalt(i,j,k2,bi,bj) |
231 |
enddo |
232 |
#if (defined (ALLOW_3D_DIFFKR) || defined (ALLOW_DIFFKR_CONTROL)) |
233 |
elseif (gencost_barfile(k)(1:8).EQ.'m_diffkr') then |
234 |
kk=gencost_pointer3d(k) |
235 |
do k2=1,nr |
236 |
gencost_mod3d(i,j,k2,bi,bj,kk) = |
237 |
& diffkr(i,j,k2,bi,bj)*maskC(i,j,k2,bi,bj) |
238 |
enddo |
239 |
#endif |
240 |
#ifdef ALLOW_CTRL |
241 |
#ifdef ALLOW_KAPGM_CONTROL |
242 |
elseif (gencost_barfile(k)(1:7).EQ.'m_kapgm') then |
243 |
kk=gencost_pointer3d(k) |
244 |
do k2=1,nr |
245 |
gencost_mod3d(i,j,k2,bi,bj,kk) = |
246 |
& kapgm(i,j,k2,bi,bj)*maskC(i,j,k2,bi,bj) |
247 |
enddo |
248 |
#endif |
249 |
#ifdef ALLOW_KAPREDI_CONTROL |
250 |
elseif (gencost_barfile(k)(1:9).EQ.'m_kapredi') then |
251 |
kk=gencost_pointer3d(k) |
252 |
do k2=1,nr |
253 |
gencost_mod3d(i,j,k2,bi,bj,kk) = |
254 |
& kapredi(i,j,k2,bi,bj)*maskC(i,j,k2,bi,bj) |
255 |
enddo |
256 |
#endif |
257 |
#endif |
258 |
#endif |
259 |
endif |
260 |
|
261 |
enddo |
262 |
enddo |
263 |
enddo |
264 |
enddo |
265 |
enddo |
266 |
|
267 |
#endif /* ALLOW_GENCOST_CONTRIBUTION */ |
268 |
|
269 |
end |