1 |
subroutine mdbldepth( mytime, mythid, kmtj, dvsq, dbloc, ritop, |
2 |
$ustar, bo, bosol, coriol, ikey, hbl, bfsfc, stable, casea, kbl, |
3 |
$rib, sigma ) |
4 |
C*************************************************************** |
5 |
C*************************************************************** |
6 |
C** This routine was generated by the ** |
7 |
C** Tangent linear and Adjoint Model Compiler, TAMC 5.2.14 ** |
8 |
C*************************************************************** |
9 |
C*************************************************************** |
10 |
C============================================== |
11 |
C all entries are defined explicitly |
12 |
C============================================== |
13 |
implicit none |
14 |
|
15 |
C============================================== |
16 |
C define parameters |
17 |
C============================================== |
18 |
double precision eins |
19 |
parameter ( eins = 1. ) |
20 |
integer olx |
21 |
parameter ( olx = 3 ) |
22 |
integer oly |
23 |
parameter ( oly = 3 ) |
24 |
integer snx |
25 |
parameter ( snx = 20 ) |
26 |
integer sny |
27 |
parameter ( sny = 40 ) |
28 |
integer imt |
29 |
parameter ( imt = (snx+2*olx)*(sny+2*oly) ) |
30 |
double precision minusone |
31 |
parameter ( minusone = -1. ) |
32 |
integer nr |
33 |
parameter ( nr = 15 ) |
34 |
integer nsx |
35 |
parameter ( nsx = 1 ) |
36 |
integer nsy |
37 |
parameter ( nsy = 1 ) |
38 |
double precision p5 |
39 |
parameter ( p5 = 0.5 ) |
40 |
|
41 |
C============================================== |
42 |
C define common blocks |
43 |
C============================================== |
44 |
common /cadbfsfd/ bfsfch |
45 |
double precision bfsfch(1196,36) |
46 |
|
47 |
common /cadbfsfe/ bfsfci |
48 |
double precision bfsfci(1196,36) |
49 |
|
50 |
common /cadbfsff/ bfsfcj |
51 |
double precision bfsfcj(1196,36) |
52 |
|
53 |
common /cadhbm/ hblh |
54 |
double precision hblh(1196,36) |
55 |
|
56 |
common /cadhbn/ hbli |
57 |
double precision hbli(1196,36) |
58 |
|
59 |
common /cadhbo/ hblj |
60 |
double precision hblj(1196,36) |
61 |
|
62 |
common /cadkbm/ kblh |
63 |
integer kblh(1196,36) |
64 |
|
65 |
common /kmixcom/ epsln, phepsi, epsilon, vonk, db_dz, conc1, |
66 |
$conam, concm, conc2, zetam, conas, concs, conc3, zetas |
67 |
double precision conam |
68 |
double precision conas |
69 |
double precision conc1 |
70 |
double precision conc2 |
71 |
double precision conc3 |
72 |
double precision concm |
73 |
double precision concs |
74 |
double precision db_dz |
75 |
double precision epsilon |
76 |
double precision epsln |
77 |
double precision phepsi |
78 |
double precision vonk |
79 |
double precision zetam |
80 |
double precision zetas |
81 |
|
82 |
common /kpp_bldepth1/ ricr, cekman, cmonob, concv, vtc |
83 |
double precision cekman |
84 |
double precision cmonob |
85 |
double precision concv |
86 |
double precision ricr |
87 |
double precision vtc |
88 |
|
89 |
common /kpp_bldepth2/ hbf |
90 |
double precision hbf |
91 |
|
92 |
common /kpp_parm_r/ minkpphbl |
93 |
double precision minkpphbl |
94 |
|
95 |
common /kpp_r1/ pmask, zgrid, hwide |
96 |
double precision hwide(0:nr+1) |
97 |
double precision pmask(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
98 |
double precision zgrid(0:nr+1) |
99 |
|
100 |
C============================================== |
101 |
C define arguments |
102 |
C============================================== |
103 |
double precision bfsfc(imt) |
104 |
double precision bo(imt) |
105 |
double precision bosol(imt) |
106 |
double precision casea(imt) |
107 |
double precision coriol(imt) |
108 |
double precision dbloc(imt,nr) |
109 |
double precision dvsq(imt,nr) |
110 |
double precision hbl(imt) |
111 |
integer ikey |
112 |
integer kbl(imt) |
113 |
integer kmtj(imt) |
114 |
integer mythid |
115 |
double precision mytime |
116 |
double precision rib(imt,nr) |
117 |
double precision ritop(imt,nr) |
118 |
double precision sigma(imt) |
119 |
double precision stable(imt) |
120 |
double precision ustar(imt) |
121 |
|
122 |
C============================================== |
123 |
C define local variables |
124 |
C============================================== |
125 |
double precision bvsq |
126 |
double precision hekman |
127 |
double precision hlimit |
128 |
double precision hmonob |
129 |
integer i |
130 |
integer ip1 |
131 |
integer kl |
132 |
double precision tempvar1 |
133 |
double precision tempvar2 |
134 |
double precision vtsq |
135 |
double precision wm(imt) |
136 |
double precision worka(imt) |
137 |
double precision ws(imt) |
138 |
|
139 |
C********************************************** |
140 |
C executable statements of routine |
141 |
C********************************************** |
142 |
do i = 1, imt |
143 |
rib(i,1) = 0. |
144 |
kbl(i) = max(kmtj(i),1) |
145 |
hbl(i) = -zgrid(kbl(i)) |
146 |
end do |
147 |
do kl = 2, nr |
148 |
do i = 1, imt |
149 |
worka(i) = zgrid(kl) |
150 |
end do |
151 |
call swfrac( imt,hbf,mytime,mythid,worka ) |
152 |
do i = 1, imt |
153 |
casea(i) = -zgrid(kl) |
154 |
bfsfc(i) = bo(i)+bosol(i)*(1.-worka(i)) |
155 |
stable(i) = p5+sign(p5,bfsfc(i)) |
156 |
sigma(i) = stable(i)+(1.-stable(i))*epsilon |
157 |
end do |
158 |
call wscale( sigma,casea,ustar,bfsfc,wm,ws ) |
159 |
do i = 1, imt |
160 |
bvsq = p5*(dbloc(i,kl-1)/(zgrid(kl-1)-zgrid(kl))+dbloc(i,kl)/ |
161 |
$(zgrid(kl)-zgrid(kl+1))) |
162 |
if (bvsq .eq. 0.) then |
163 |
vtsq = 0. |
164 |
else |
165 |
vtsq = -(zgrid(kl)*ws(i)*sqrt(abs(bvsq))*vtc) |
166 |
endif |
167 |
tempvar1 = dvsq(i,kl)+vtsq |
168 |
tempvar2 = max(tempvar1,phepsi) |
169 |
rib(i,kl) = ritop(i,kl)/tempvar2 |
170 |
end do |
171 |
end do |
172 |
do kl = 2, nr |
173 |
do i = 1, imt |
174 |
if (kbl(i) .eq. kmtj(i) .and. rib(i,kl) .gt. ricr) then |
175 |
kbl(i) = kl |
176 |
endif |
177 |
end do |
178 |
end do |
179 |
do ip1 = 1, 1196 |
180 |
kblh(ip1,ikey) = kbl(ip1) |
181 |
end do |
182 |
do i = 1, imt |
183 |
kl = kbl(i) |
184 |
if (kl .gt. 1 .and. kl .lt. kmtj(i)) then |
185 |
tempvar1 = rib(i,kl)-rib(i,kl-1) |
186 |
hbl(i) = (-zgrid(kl-1))+(zgrid(kl-1)-zgrid(kl))*(ricr-rib(i, |
187 |
$kl-1))/tempvar1 |
188 |
endif |
189 |
end do |
190 |
do ip1 = 1, 1196 |
191 |
hblj(ip1,ikey) = hbl(ip1) |
192 |
end do |
193 |
do i = 1, imt |
194 |
worka(i) = hbl(i) |
195 |
end do |
196 |
call swfrac( imt,minusone,mytime,mythid,worka ) |
197 |
do i = 1, imt |
198 |
bfsfc(i) = bo(i)+bosol(i)*(1.-worka(i)) |
199 |
end do |
200 |
do ip1 = 1, 1196 |
201 |
bfsfcj(ip1,ikey) = bfsfc(ip1) |
202 |
end do |
203 |
do i = 1, imt |
204 |
stable(i) = p5+sign(p5,bfsfc(i)) |
205 |
bfsfc(i) = sign(eins,bfsfc(i))*max(phepsi,abs(bfsfc(i))) |
206 |
end do |
207 |
do ip1 = 1, 1196 |
208 |
bfsfci(ip1,ikey) = bfsfc(ip1) |
209 |
end do |
210 |
do i = 1, imt |
211 |
if (bfsfc(i) .gt. 0.) then |
212 |
hekman = cekman*ustar(i)/max(abs(coriol(i)),phepsi) |
213 |
hmonob = cmonob*ustar(i)*ustar(i)*ustar(i)/vonk/bfsfc(i) |
214 |
hlimit = stable(i)*min(hekman,hmonob)+(stable(i)-1.)*zgrid(nr) |
215 |
hbl(i) = min(hbl(i),hlimit) |
216 |
endif |
217 |
end do |
218 |
do ip1 = 1, 1196 |
219 |
hbli(ip1,ikey) = hbl(ip1) |
220 |
end do |
221 |
do i = 1, imt |
222 |
hbl(i) = max(hbl(i),minkpphbl) |
223 |
kbl(i) = kmtj(i) |
224 |
end do |
225 |
do ip1 = 1, 1196 |
226 |
hblh(ip1,ikey) = hbl(ip1) |
227 |
end do |
228 |
do kl = 2, nr |
229 |
do i = 1, imt |
230 |
if (kbl(i) .eq. kmtj(i) .and. (-zgrid(kl)) .gt. hbl(i)) then |
231 |
kbl(i) = kl |
232 |
endif |
233 |
end do |
234 |
end do |
235 |
do i = 1, imt |
236 |
worka(i) = hbl(i) |
237 |
end do |
238 |
call swfrac( imt,minusone,mytime,mythid,worka ) |
239 |
do i = 1, imt |
240 |
bfsfc(i) = bo(i)+bosol(i)*(1.-worka(i)) |
241 |
end do |
242 |
do ip1 = 1, 1196 |
243 |
bfsfch(ip1,ikey) = bfsfc(ip1) |
244 |
end do |
245 |
do i = 1, imt |
246 |
stable(i) = p5+sign(p5,bfsfc(i)) |
247 |
bfsfc(i) = sign(eins,bfsfc(i))*max(phepsi,abs(bfsfc(i))) |
248 |
end do |
249 |
do i = 1, imt |
250 |
casea(i) = p5+sign(p5,(-zgrid(kbl(i)))-p5*hwide(kbl(i))-hbl(i)) |
251 |
end do |
252 |
end |
253 |
|
254 |
|
255 |
subroutine adbldepth( kmtj, dvsq, dbloc, ritop, ustar, bo, bosol, |
256 |
$coriol, ikey, addvsq, addbloc, adritop, adustar, adbo, adbosol, |
257 |
$adcoriol, adhbl, adbfsfc, adstable, adcasea, adrib, adsigma ) |
258 |
C*************************************************************** |
259 |
C*************************************************************** |
260 |
C** This routine was generated by the ** |
261 |
C** Tangent linear and Adjoint Model Compiler, TAMC 5.2.14 ** |
262 |
C*************************************************************** |
263 |
C*************************************************************** |
264 |
C============================================== |
265 |
C all entries are defined explicitly |
266 |
C============================================== |
267 |
implicit none |
268 |
|
269 |
C============================================== |
270 |
C define parameters |
271 |
C============================================== |
272 |
double precision eins |
273 |
parameter ( eins = 1. ) |
274 |
integer olx |
275 |
parameter ( olx = 3 ) |
276 |
integer oly |
277 |
parameter ( oly = 3 ) |
278 |
integer snx |
279 |
parameter ( snx = 20 ) |
280 |
integer sny |
281 |
parameter ( sny = 40 ) |
282 |
integer imt |
283 |
parameter ( imt = (snx+2*olx)*(sny+2*oly) ) |
284 |
double precision minusone |
285 |
parameter ( minusone = -1. ) |
286 |
integer nr |
287 |
parameter ( nr = 15 ) |
288 |
integer nsx |
289 |
parameter ( nsx = 1 ) |
290 |
integer nsy |
291 |
parameter ( nsy = 1 ) |
292 |
double precision p5 |
293 |
parameter ( p5 = 0.5 ) |
294 |
|
295 |
C============================================== |
296 |
C define common blocks |
297 |
C============================================== |
298 |
common /cadbfsfd/ bfsfch |
299 |
double precision bfsfch(1196,36) |
300 |
|
301 |
common /cadbfsfe/ bfsfci |
302 |
double precision bfsfci(1196,36) |
303 |
|
304 |
common /cadbfsff/ bfsfcj |
305 |
double precision bfsfcj(1196,36) |
306 |
|
307 |
common /cadhbm/ hblh |
308 |
double precision hblh(1196,36) |
309 |
|
310 |
common /cadhbn/ hbli |
311 |
double precision hbli(1196,36) |
312 |
|
313 |
common /cadhbo/ hblj |
314 |
double precision hblj(1196,36) |
315 |
|
316 |
common /cadkbm/ kblh |
317 |
integer kblh(1196,36) |
318 |
|
319 |
common /kmixcom/ epsln, phepsi, epsilon, vonk, db_dz, conc1, |
320 |
$conam, concm, conc2, zetam, conas, concs, conc3, zetas |
321 |
double precision conam |
322 |
double precision conas |
323 |
double precision conc1 |
324 |
double precision conc2 |
325 |
double precision conc3 |
326 |
double precision concm |
327 |
double precision concs |
328 |
double precision db_dz |
329 |
double precision epsilon |
330 |
double precision epsln |
331 |
double precision phepsi |
332 |
double precision vonk |
333 |
double precision zetam |
334 |
double precision zetas |
335 |
|
336 |
common /kpp_bldepth1/ ricr, cekman, cmonob, concv, vtc |
337 |
double precision cekman |
338 |
double precision cmonob |
339 |
double precision concv |
340 |
double precision ricr |
341 |
double precision vtc |
342 |
|
343 |
common /kpp_bldepth2/ hbf |
344 |
double precision hbf |
345 |
|
346 |
common /kpp_parm_r/ minkpphbl |
347 |
double precision minkpphbl |
348 |
|
349 |
common /kpp_r1/ pmask, zgrid, hwide |
350 |
double precision hwide(0:nr+1) |
351 |
double precision pmask(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
352 |
double precision zgrid(0:nr+1) |
353 |
|
354 |
C============================================== |
355 |
C define arguments |
356 |
C============================================== |
357 |
double precision adbfsfc(imt) |
358 |
double precision adbo(imt) |
359 |
double precision adbosol(imt) |
360 |
double precision adcasea(imt) |
361 |
double precision adcoriol(imt) |
362 |
double precision addbloc(imt,nr) |
363 |
double precision addvsq(imt,nr) |
364 |
double precision adhbl(imt) |
365 |
double precision adrib(imt,nr) |
366 |
double precision adritop(imt,nr) |
367 |
double precision adsigma(imt) |
368 |
double precision adstable(imt) |
369 |
double precision adustar(imt) |
370 |
double precision bo(imt) |
371 |
double precision bosol(imt) |
372 |
double precision coriol(imt) |
373 |
double precision dbloc(imt,nr) |
374 |
double precision dvsq(imt,nr) |
375 |
integer ikey |
376 |
integer kmtj(imt) |
377 |
double precision ritop(imt,nr) |
378 |
double precision ustar(imt) |
379 |
|
380 |
C============================================== |
381 |
C define local variables |
382 |
C============================================== |
383 |
double precision adbvsq |
384 |
double precision adhekman |
385 |
double precision adhlimit |
386 |
double precision adhmonob |
387 |
double precision adtempvar1 |
388 |
double precision adtempvar2 |
389 |
double precision advtsq |
390 |
double precision adwm(imt) |
391 |
double precision adworka(imt) |
392 |
double precision adws(imt) |
393 |
double precision bfsfc(imt) |
394 |
double precision bvsq |
395 |
double precision casea(imt) |
396 |
double precision hbl(imt) |
397 |
double precision hekman |
398 |
double precision hekmanh |
399 |
double precision hlimit |
400 |
double precision hmonob |
401 |
integer i |
402 |
integer ip1 |
403 |
integer kbl(imt) |
404 |
integer kl |
405 |
integer mythid |
406 |
double precision mytime |
407 |
double precision rib(imt,nr) |
408 |
double precision sigma(imt) |
409 |
double precision stable(imt) |
410 |
double precision tempvar1 |
411 |
double precision tempvar2 |
412 |
double precision vtsq |
413 |
double precision vtsqh |
414 |
double precision wm(imt) |
415 |
double precision worka(imt) |
416 |
double precision ws(imt) |
417 |
|
418 |
C---------------------------------------------- |
419 |
C RESET LOCAL ADJOINT VARIABLES |
420 |
C---------------------------------------------- |
421 |
adbvsq = 0.d0 |
422 |
adhekman = 0.d0 |
423 |
adhlimit = 0.d0 |
424 |
adhmonob = 0.d0 |
425 |
adtempvar1 = 0.d0 |
426 |
adtempvar2 = 0.d0 |
427 |
advtsq = 0.d0 |
428 |
do ip1 = 1, imt |
429 |
adwm(ip1) = 0.d0 |
430 |
end do |
431 |
do ip1 = 1, imt |
432 |
adworka(ip1) = 0.d0 |
433 |
end do |
434 |
do ip1 = 1, imt |
435 |
adws(ip1) = 0.d0 |
436 |
end do |
437 |
|
438 |
C---------------------------------------------- |
439 |
C ROUTINE BODY |
440 |
C---------------------------------------------- |
441 |
do i = 1, imt |
442 |
rib(i,1) = 0. |
443 |
end do |
444 |
do kl = 2, nr |
445 |
do i = 1, imt |
446 |
worka(i) = zgrid(kl) |
447 |
end do |
448 |
call swfrac( imt,hbf,mytime,mythid,worka ) |
449 |
do i = 1, imt |
450 |
casea(i) = -zgrid(kl) |
451 |
bfsfc(i) = bo(i)+bosol(i)*(1.-worka(i)) |
452 |
stable(i) = p5+sign(p5,bfsfc(i)) |
453 |
sigma(i) = stable(i)+(1.-stable(i))*epsilon |
454 |
end do |
455 |
call wscale( sigma,casea,ustar,bfsfc,wm,ws ) |
456 |
do i = 1, imt |
457 |
bvsq = p5*(dbloc(i,kl-1)/(zgrid(kl-1)-zgrid(kl))+dbloc(i,kl)/ |
458 |
$(zgrid(kl)-zgrid(kl+1))) |
459 |
if (bvsq .eq. 0.) then |
460 |
vtsq = 0. |
461 |
else |
462 |
vtsq = -(zgrid(kl)*ws(i)*sqrt(abs(bvsq))*vtc) |
463 |
endif |
464 |
tempvar1 = dvsq(i,kl)+vtsq |
465 |
tempvar2 = max(tempvar1,phepsi) |
466 |
rib(i,kl) = ritop(i,kl)/tempvar2 |
467 |
end do |
468 |
end do |
469 |
do ip1 = 1, imt |
470 |
kbl(ip1) = kblh(ip1,ikey) |
471 |
end do |
472 |
do ip1 = 1, imt |
473 |
bfsfc(ip1) = bfsfcj(ip1,ikey) |
474 |
end do |
475 |
do i = 1, imt |
476 |
stable(i) = p5+sign(p5,bfsfc(i)) |
477 |
end do |
478 |
do ip1 = 1, imt |
479 |
hbl(ip1) = hblh(ip1,ikey) |
480 |
end do |
481 |
do i = 1, imt |
482 |
worka(i) = hbl(i) |
483 |
end do |
484 |
call swfrac( imt,minusone,mytime,mythid,worka ) |
485 |
do ip1 = 1, imt |
486 |
bfsfc(ip1) = bfsfch(ip1,ikey) |
487 |
end do |
488 |
do i = 1, imt |
489 |
adcasea(i) = 0.d0 |
490 |
end do |
491 |
do i = 1, imt |
492 |
adbfsfc(i) = adbfsfc(i)*(1+(0.5-sign(0.5d0,phepsi-abs(bfsfc(i))) |
493 |
$)*sign(eins,bfsfc(i))*sign(1.d0,bfsfc(i))) |
494 |
adbfsfc(i) = 0.d0 |
495 |
adstable(i) = 0.d0 |
496 |
end do |
497 |
do i = 1, imt |
498 |
adbo(i) = adbo(i)+adbfsfc(i) |
499 |
adbosol(i) = adbosol(i)+adbfsfc(i)*(1.-worka(i)) |
500 |
adworka(i) = adworka(i)-adbfsfc(i)*bosol(i) |
501 |
adbfsfc(i) = 0.d0 |
502 |
end do |
503 |
do i = 1, imt |
504 |
worka(i) = hbl(i) |
505 |
end do |
506 |
call adswfrac( imt,minusone,worka,adworka ) |
507 |
do i = 1, imt |
508 |
adhbl(i) = adhbl(i)+adworka(i) |
509 |
adworka(i) = 0.d0 |
510 |
end do |
511 |
do ip1 = 1, imt |
512 |
hbl(ip1) = hbli(ip1,ikey) |
513 |
end do |
514 |
do i = 1, imt |
515 |
adhbl(i) = adhbl(i)*(0.5+sign(0.5d0,hbl(i)-minkpphbl)) |
516 |
end do |
517 |
do ip1 = 1, imt |
518 |
hbl(ip1) = hblj(ip1,ikey) |
519 |
end do |
520 |
do ip1 = 1, imt |
521 |
bfsfc(ip1) = bfsfci(ip1,ikey) |
522 |
end do |
523 |
do i = 1, imt |
524 |
adhekman = 0.d0 |
525 |
adhlimit = 0.d0 |
526 |
adhmonob = 0.d0 |
527 |
if (bfsfc(i) .gt. 0.) then |
528 |
hekman = cekman*ustar(i)/max(abs(coriol(i)),phepsi) |
529 |
hmonob = cmonob*ustar(i)*ustar(i)*ustar(i)/vonk/bfsfc(i) |
530 |
hlimit = stable(i)*min(hekman,hmonob)+(stable(i)-1.)*zgrid(nr) |
531 |
adhlimit = adhlimit+adhbl(i)*(0.5-sign(0.5d0,hlimit-hbl(i))) |
532 |
adhbl(i) = adhbl(i)*(0.5+sign(0.5d0,hlimit-hbl(i))) |
533 |
adhekman = adhekman+adhlimit*stable(i)*(0.5+sign(0.5d0,hmonob- |
534 |
$hekman)) |
535 |
adhmonob = adhmonob+adhlimit*stable(i)*(0.5-sign(0.5d0,hmonob- |
536 |
$hekman)) |
537 |
adstable(i) = adstable(i)+adhlimit*(zgrid(nr)+min(hekman, |
538 |
$hmonob)) |
539 |
adhlimit = 0.d0 |
540 |
adbfsfc(i) = adbfsfc(i)-adhmonob*(cmonob*ustar(i)*ustar(i)* |
541 |
$ustar(i)/vonk/(bfsfc(i)*bfsfc(i))) |
542 |
adustar(i) = adustar(i)+adhmonob*(3*cmonob*ustar(i)*ustar(i)/ |
543 |
$vonk/bfsfc(i)) |
544 |
adhmonob = 0.d0 |
545 |
hekmanh = abs(coriol(i)) |
546 |
adustar(i) = adustar(i)+adhekman*(cekman/max(hekmanh,phepsi)) |
547 |
adcoriol(i) = adcoriol(i)-adhekman*(cekman*ustar(i)*(0.5+ |
548 |
$sign(0.5d0,hekmanh-phepsi))/(max(hekmanh,phepsi)*max(hekmanh, |
549 |
$phepsi)))*sign(1.d0,coriol(i)) |
550 |
adhekman = 0.d0 |
551 |
endif |
552 |
end do |
553 |
do ip1 = 1, imt |
554 |
bfsfc(ip1) = bfsfcj(ip1,ikey) |
555 |
end do |
556 |
do i = 1, imt |
557 |
adbfsfc(i) = adbfsfc(i)*(1+(0.5-sign(0.5d0,phepsi-abs(bfsfc(i))) |
558 |
$)*sign(eins,bfsfc(i))*sign(1.d0,bfsfc(i))) |
559 |
adbfsfc(i) = 0.d0 |
560 |
adstable(i) = 0.d0 |
561 |
end do |
562 |
do ip1 = 1, imt |
563 |
hbl(ip1) = hblj(ip1,ikey) |
564 |
end do |
565 |
do i = 1, imt |
566 |
worka(i) = hbl(i) |
567 |
end do |
568 |
call swfrac( imt,minusone,mytime,mythid,worka ) |
569 |
do i = 1, imt |
570 |
adbo(i) = adbo(i)+adbfsfc(i) |
571 |
adbosol(i) = adbosol(i)+adbfsfc(i)*(1.-worka(i)) |
572 |
adworka(i) = adworka(i)-adbfsfc(i)*bosol(i) |
573 |
adbfsfc(i) = 0.d0 |
574 |
end do |
575 |
do ip1 = 1, imt |
576 |
hbl(ip1) = hblj(ip1,ikey) |
577 |
end do |
578 |
do i = 1, imt |
579 |
worka(i) = hbl(i) |
580 |
end do |
581 |
call adswfrac( imt,minusone,worka,adworka ) |
582 |
do i = 1, imt |
583 |
adhbl(i) = adhbl(i)+adworka(i) |
584 |
adworka(i) = 0.d0 |
585 |
end do |
586 |
do i = 1, imt |
587 |
adtempvar1 = 0.d0 |
588 |
kl = kbl(i) |
589 |
if (kl .gt. 1 .and. kl .lt. kmtj(i)) then |
590 |
tempvar1 = rib(i,kl)-rib(i,kl-1) |
591 |
adrib(i,kl-1) = adrib(i,kl-1)-adhbl(i)*((zgrid(kl-1)-zgrid(kl) |
592 |
$)/tempvar1) |
593 |
adtempvar1 = adtempvar1-adhbl(i)*((zgrid(kl-1)-zgrid(kl))* |
594 |
$(ricr-rib(i,kl-1))/(tempvar1*tempvar1)) |
595 |
adhbl(i) = 0.d0 |
596 |
adrib(i,kl-1) = adrib(i,kl-1)-adtempvar1 |
597 |
adrib(i,kl) = adrib(i,kl)+adtempvar1 |
598 |
adtempvar1 = 0.d0 |
599 |
endif |
600 |
end do |
601 |
do kl = nr, 2, -1 |
602 |
do i = 1, imt |
603 |
worka(i) = zgrid(kl) |
604 |
end do |
605 |
call swfrac( imt,hbf,mytime,mythid,worka ) |
606 |
do i = 1, imt |
607 |
casea(i) = -zgrid(kl) |
608 |
bfsfc(i) = bo(i)+bosol(i)*(1.-worka(i)) |
609 |
stable(i) = p5+sign(p5,bfsfc(i)) |
610 |
sigma(i) = stable(i)+(1.-stable(i))*epsilon |
611 |
end do |
612 |
call wscale( sigma,casea,ustar,bfsfc,wm,ws ) |
613 |
do i = 1, imt |
614 |
adbvsq = 0.d0 |
615 |
adtempvar1 = 0.d0 |
616 |
adtempvar2 = 0.d0 |
617 |
advtsq = 0.d0 |
618 |
bvsq = p5*(dbloc(i,kl-1)/(zgrid(kl-1)-zgrid(kl))+dbloc(i,kl)/ |
619 |
$(zgrid(kl)-zgrid(kl+1))) |
620 |
if (bvsq .eq. 0.) then |
621 |
vtsq = 0. |
622 |
else |
623 |
vtsq = -(zgrid(kl)*ws(i)*sqrt(abs(bvsq))*vtc) |
624 |
endif |
625 |
tempvar1 = dvsq(i,kl)+vtsq |
626 |
tempvar2 = max(tempvar1,phepsi) |
627 |
adritop(i,kl) = adritop(i,kl)+adrib(i,kl)/tempvar2 |
628 |
adtempvar2 = adtempvar2-adrib(i,kl)*(ritop(i,kl)/(tempvar2* |
629 |
$tempvar2)) |
630 |
adrib(i,kl) = 0.d0 |
631 |
adtempvar1 = adtempvar1+adtempvar2*(0.5+sign(0.5d0,tempvar1- |
632 |
$phepsi)) |
633 |
adtempvar2 = 0.d0 |
634 |
addvsq(i,kl) = addvsq(i,kl)+adtempvar1 |
635 |
advtsq = advtsq+adtempvar1 |
636 |
adtempvar1 = 0.d0 |
637 |
if (bvsq .eq. 0.) then |
638 |
advtsq = 0.d0 |
639 |
else |
640 |
vtsqh = abs(bvsq) |
641 |
adws(i) = adws(i)-advtsq*zgrid(kl)*vtc*sqrt(vtsqh) |
642 |
adbvsq = adbvsq-advtsq*zgrid(kl)*ws(i)*1./(2.*sqrt(vtsqh))* |
643 |
$vtc*sign(1.d0,bvsq) |
644 |
advtsq = 0.d0 |
645 |
endif |
646 |
addbloc(i,kl-1) = addbloc(i,kl-1)+adbvsq*(p5/(zgrid(kl-1)- |
647 |
$zgrid(kl))) |
648 |
addbloc(i,kl) = addbloc(i,kl)+adbvsq*(p5/(zgrid(kl)-zgrid(kl+ |
649 |
$1))) |
650 |
adbvsq = 0.d0 |
651 |
end do |
652 |
call adwscale( sigma,casea,ustar,bfsfc,adsigma,adcasea,adustar, |
653 |
$adbfsfc,adwm,adws ) |
654 |
do i = 1, imt |
655 |
adstable(i) = adstable(i)+adsigma(i)*(1-epsilon) |
656 |
adsigma(i) = 0.d0 |
657 |
adstable(i) = 0.d0 |
658 |
adbo(i) = adbo(i)+adbfsfc(i) |
659 |
adbosol(i) = adbosol(i)+adbfsfc(i)*(1.-worka(i)) |
660 |
adworka(i) = adworka(i)-adbfsfc(i)*bosol(i) |
661 |
adbfsfc(i) = 0.d0 |
662 |
end do |
663 |
do i = 1, imt |
664 |
worka(i) = zgrid(kl) |
665 |
end do |
666 |
call adswfrac( imt,hbf,worka,adworka ) |
667 |
end do |
668 |
|
669 |
end |
670 |
|
671 |
|
672 |
subroutine mdblmix( ustar, bfsfc, hbl, stable, casea, diffus, kbl, |
673 |
$ dkm1, blmc, ghat, sigma, ikey ) |
674 |
C*************************************************************** |
675 |
C*************************************************************** |
676 |
C** This routine was generated by the ** |
677 |
C** Tangent linear and Adjoint Model Compiler, TAMC 5.2.14 ** |
678 |
C*************************************************************** |
679 |
C*************************************************************** |
680 |
C============================================== |
681 |
C all entries are defined explicitly |
682 |
C============================================== |
683 |
implicit none |
684 |
|
685 |
C============================================== |
686 |
C define parameters |
687 |
C============================================== |
688 |
double precision eins |
689 |
parameter ( eins = 1. ) |
690 |
integer olx |
691 |
parameter ( olx = 3 ) |
692 |
integer oly |
693 |
parameter ( oly = 3 ) |
694 |
integer snx |
695 |
parameter ( snx = 20 ) |
696 |
integer sny |
697 |
parameter ( sny = 40 ) |
698 |
integer imt |
699 |
parameter ( imt = (snx+2*olx)*(sny+2*oly) ) |
700 |
integer mdiff |
701 |
parameter ( mdiff = 3 ) |
702 |
integer nr |
703 |
parameter ( nr = 15 ) |
704 |
integer nrp1 |
705 |
parameter ( nrp1 = nr+1 ) |
706 |
integer nsx |
707 |
parameter ( nsx = 1 ) |
708 |
integer nsy |
709 |
parameter ( nsy = 1 ) |
710 |
double precision p0 |
711 |
parameter ( p0 = 0. ) |
712 |
|
713 |
C============================================== |
714 |
C define common blocks |
715 |
C============================================== |
716 |
common /cadwm/ wmh |
717 |
double precision wmh(imt,36) |
718 |
|
719 |
common /cadws/ wsh |
720 |
double precision wsh(imt,36) |
721 |
|
722 |
common /kmixcbm/ cstar, cg |
723 |
double precision cg |
724 |
double precision cstar |
725 |
|
726 |
common /kmixcom/ epsln, phepsi, epsilon, vonk, db_dz, conc1, |
727 |
$conam, concm, conc2, zetam, conas, concs, conc3, zetas |
728 |
double precision conam |
729 |
double precision conas |
730 |
double precision conc1 |
731 |
double precision conc2 |
732 |
double precision conc3 |
733 |
double precision concm |
734 |
double precision concs |
735 |
double precision db_dz |
736 |
double precision epsilon |
737 |
double precision epsln |
738 |
double precision phepsi |
739 |
double precision vonk |
740 |
double precision zetam |
741 |
double precision zetas |
742 |
|
743 |
common /kpp_r1/ pmask, zgrid, hwide |
744 |
double precision hwide(0:nr+1) |
745 |
double precision pmask(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
746 |
double precision zgrid(0:nr+1) |
747 |
|
748 |
C============================================== |
749 |
C define arguments |
750 |
C============================================== |
751 |
double precision bfsfc(imt) |
752 |
double precision blmc(imt,nr,mdiff) |
753 |
double precision casea(imt) |
754 |
double precision diffus(imt,0:nrp1,mdiff) |
755 |
double precision dkm1(imt,mdiff) |
756 |
double precision ghat(imt,nr) |
757 |
double precision hbl(imt) |
758 |
integer ikey |
759 |
integer kbl(imt) |
760 |
double precision sigma(imt) |
761 |
double precision stable(imt) |
762 |
double precision ustar(imt) |
763 |
|
764 |
C============================================== |
765 |
C define local variables |
766 |
C============================================== |
767 |
double precision a1 |
768 |
double precision a2 |
769 |
double precision a3 |
770 |
double precision dat1m(imt) |
771 |
double precision dat1s(imt) |
772 |
double precision dat1t(imt) |
773 |
double precision delhat |
774 |
double precision difsh |
775 |
double precision difsp |
776 |
double precision difth |
777 |
double precision diftp |
778 |
double precision dvdzdn |
779 |
double precision dvdzup |
780 |
double precision f1 |
781 |
double precision gat1m(imt) |
782 |
double precision gat1s(imt) |
783 |
double precision gat1t(imt) |
784 |
double precision gm |
785 |
double precision gs |
786 |
double precision gt |
787 |
integer i |
788 |
integer ip1 |
789 |
integer ki |
790 |
integer kn |
791 |
double precision r |
792 |
double precision sig |
793 |
double precision tempvar |
794 |
double precision visch |
795 |
double precision viscp |
796 |
double precision wm(imt) |
797 |
double precision ws(imt) |
798 |
|
799 |
C********************************************** |
800 |
C executable statements of routine |
801 |
C********************************************** |
802 |
do i = 1, imt |
803 |
sigma(i) = stable(i)*1.+(1.-stable(i))*epsilon |
804 |
end do |
805 |
call wscale( sigma,hbl,ustar,bfsfc,wm,ws ) |
806 |
do i = 1, imt |
807 |
wm(i) = sign(eins,wm(i))*max(phepsi,abs(wm(i))) |
808 |
ws(i) = sign(eins,ws(i))*max(phepsi,abs(ws(i))) |
809 |
end do |
810 |
do ip1 = 1, imt |
811 |
wmh(ip1,ikey) = wm(ip1) |
812 |
end do |
813 |
do ip1 = 1, imt |
814 |
wsh(ip1,ikey) = ws(ip1) |
815 |
end do |
816 |
do i = 1, imt |
817 |
kn = int(casea(i)+phepsi)*(kbl(i)-1)+(1-int(casea(i)+phepsi))* |
818 |
$kbl(i) |
819 |
delhat = 0.5*hwide(kn)-zgrid(kn)-hbl(i) |
820 |
r = 1.-delhat/hwide(kn) |
821 |
dvdzup = (diffus(i,kn-1,1)-diffus(i,kn,1))/hwide(kn) |
822 |
dvdzdn = (diffus(i,kn,1)-diffus(i,kn+1,1))/hwide(kn+1) |
823 |
viscp = 0.5*((1.-r)*(dvdzup+abs(dvdzup))+r*(dvdzdn+abs(dvdzdn))) |
824 |
dvdzup = (diffus(i,kn-1,2)-diffus(i,kn,2))/hwide(kn) |
825 |
dvdzdn = (diffus(i,kn,2)-diffus(i,kn+1,2))/hwide(kn+1) |
826 |
difsp = 0.5*((1.-r)*(dvdzup+abs(dvdzup))+r*(dvdzdn+abs(dvdzdn))) |
827 |
dvdzup = (diffus(i,kn-1,3)-diffus(i,kn,3))/hwide(kn) |
828 |
dvdzdn = (diffus(i,kn,3)-diffus(i,kn+1,3))/hwide(kn+1) |
829 |
diftp = 0.5*((1.-r)*(dvdzup+abs(dvdzup))+r*(dvdzdn+abs(dvdzdn))) |
830 |
visch = diffus(i,kn,1)+viscp*delhat |
831 |
difsh = diffus(i,kn,2)+difsp*delhat |
832 |
difth = diffus(i,kn,3)+diftp*delhat |
833 |
f1 = stable(i)*conc1*bfsfc(i)/max(ustar(i)**4,phepsi) |
834 |
gat1m(i) = visch/hbl(i)/wm(i) |
835 |
dat1m(i) = (-(viscp/wm(i)))+f1*visch |
836 |
dat1m(i) = min(dat1m(i),p0) |
837 |
gat1s(i) = difsh/hbl(i)/ws(i) |
838 |
dat1s(i) = (-(difsp/ws(i)))+f1*difsh |
839 |
dat1s(i) = min(dat1s(i),p0) |
840 |
gat1t(i) = difth/hbl(i)/ws(i) |
841 |
dat1t(i) = (-(diftp/ws(i)))+f1*difth |
842 |
dat1t(i) = min(dat1t(i),p0) |
843 |
end do |
844 |
do ki = 1, nr |
845 |
do i = 1, imt |
846 |
sig = ((-zgrid(ki))+0.5*hwide(ki))/hbl(i) |
847 |
sigma(i) = stable(i)*sig+(1.-stable(i))*min(sig,epsilon) |
848 |
end do |
849 |
call wscale( sigma,hbl,ustar,bfsfc,wm,ws ) |
850 |
do i = 1, imt |
851 |
sig = ((-zgrid(ki))+0.5*hwide(ki))/hbl(i) |
852 |
a1 = sig-2. |
853 |
a2 = 3.-2.*sig |
854 |
a3 = sig-1. |
855 |
gm = a1+a2*gat1m(i)+a3*dat1m(i) |
856 |
gs = a1+a2*gat1s(i)+a3*dat1s(i) |
857 |
gt = a1+a2*gat1t(i)+a3*dat1t(i) |
858 |
blmc(i,ki,1) = hbl(i)*wm(i)*sig*(1.+sig*gm) |
859 |
blmc(i,ki,2) = hbl(i)*ws(i)*sig*(1.+sig*gs) |
860 |
blmc(i,ki,3) = hbl(i)*ws(i)*sig*(1.+sig*gt) |
861 |
tempvar = ws(i)*hbl(i) |
862 |
ghat(i,ki) = (1.-stable(i))*cg/max(phepsi,tempvar) |
863 |
end do |
864 |
end do |
865 |
do i = 1, imt |
866 |
sig = -(zgrid(kbl(i)-1)/hbl(i)) |
867 |
sigma(i) = stable(i)*sig+(1.-stable(i))*min(sig,epsilon) |
868 |
end do |
869 |
call wscale( sigma,hbl,ustar,bfsfc,wm,ws ) |
870 |
do i = 1, imt |
871 |
sig = -(zgrid(kbl(i)-1)/hbl(i)) |
872 |
a1 = sig-2. |
873 |
a2 = 3.-2.*sig |
874 |
a3 = sig-1. |
875 |
gm = a1+a2*gat1m(i)+a3*dat1m(i) |
876 |
gs = a1+a2*gat1s(i)+a3*dat1s(i) |
877 |
gt = a1+a2*gat1t(i)+a3*dat1t(i) |
878 |
dkm1(i,1) = hbl(i)*wm(i)*sig*(1.+sig*gm) |
879 |
dkm1(i,2) = hbl(i)*ws(i)*sig*(1.+sig*gs) |
880 |
dkm1(i,3) = hbl(i)*ws(i)*sig*(1.+sig*gt) |
881 |
end do |
882 |
end |
883 |
|
884 |
|
885 |
subroutine adblmix( ustar, bfsfc, hbl, stable, casea, diffus, kbl, |
886 |
$ ikey, adustar, adbfsfc, adhbl, adstable, adcasea, addiffus, |
887 |
$addkm1, adblmc, adghat, adsigma ) |
888 |
C*************************************************************** |
889 |
C*************************************************************** |
890 |
C** This routine was generated by the ** |
891 |
C** Tangent linear and Adjoint Model Compiler, TAMC 5.2.14 ** |
892 |
C*************************************************************** |
893 |
C*************************************************************** |
894 |
C============================================== |
895 |
C all entries are defined explicitly |
896 |
C============================================== |
897 |
implicit none |
898 |
|
899 |
C============================================== |
900 |
C define parameters |
901 |
C============================================== |
902 |
double precision eins |
903 |
parameter ( eins = 1. ) |
904 |
integer olx |
905 |
parameter ( olx = 3 ) |
906 |
integer oly |
907 |
parameter ( oly = 3 ) |
908 |
integer snx |
909 |
parameter ( snx = 20 ) |
910 |
integer sny |
911 |
parameter ( sny = 40 ) |
912 |
integer imt |
913 |
parameter ( imt = (snx+2*olx)*(sny+2*oly) ) |
914 |
integer mdiff |
915 |
parameter ( mdiff = 3 ) |
916 |
integer nr |
917 |
parameter ( nr = 15 ) |
918 |
integer nrp1 |
919 |
parameter ( nrp1 = nr+1 ) |
920 |
integer nsx |
921 |
parameter ( nsx = 1 ) |
922 |
integer nsy |
923 |
parameter ( nsy = 1 ) |
924 |
double precision p0 |
925 |
parameter ( p0 = 0. ) |
926 |
|
927 |
C============================================== |
928 |
C define common blocks |
929 |
C============================================== |
930 |
common /cadwm/ wmh |
931 |
double precision wmh(imt,36) |
932 |
|
933 |
common /cadws/ wsh |
934 |
double precision wsh(imt,36) |
935 |
|
936 |
common /kmixcbm/ cstar, cg |
937 |
double precision cg |
938 |
double precision cstar |
939 |
|
940 |
common /kmixcom/ epsln, phepsi, epsilon, vonk, db_dz, conc1, |
941 |
$conam, concm, conc2, zetam, conas, concs, conc3, zetas |
942 |
double precision conam |
943 |
double precision conas |
944 |
double precision conc1 |
945 |
double precision conc2 |
946 |
double precision conc3 |
947 |
double precision concm |
948 |
double precision concs |
949 |
double precision db_dz |
950 |
double precision epsilon |
951 |
double precision epsln |
952 |
double precision phepsi |
953 |
double precision vonk |
954 |
double precision zetam |
955 |
double precision zetas |
956 |
|
957 |
common /kpp_r1/ pmask, zgrid, hwide |
958 |
double precision hwide(0:nr+1) |
959 |
double precision pmask(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
960 |
double precision zgrid(0:nr+1) |
961 |
|
962 |
C============================================== |
963 |
C define arguments |
964 |
C============================================== |
965 |
double precision adbfsfc(imt) |
966 |
double precision adblmc(imt,nr,mdiff) |
967 |
double precision adcasea(imt) |
968 |
double precision addiffus(imt,0:nrp1,mdiff) |
969 |
double precision addkm1(imt,mdiff) |
970 |
double precision adghat(imt,nr) |
971 |
double precision adhbl(imt) |
972 |
double precision adsigma(imt) |
973 |
double precision adstable(imt) |
974 |
double precision adustar(imt) |
975 |
double precision bfsfc(imt) |
976 |
double precision casea(imt) |
977 |
double precision diffus(imt,0:nrp1,mdiff) |
978 |
double precision hbl(imt) |
979 |
integer ikey |
980 |
integer kbl(imt) |
981 |
double precision stable(imt) |
982 |
double precision ustar(imt) |
983 |
|
984 |
C============================================== |
985 |
C define local variables |
986 |
C============================================== |
987 |
double precision a1 |
988 |
double precision a2 |
989 |
double precision a3 |
990 |
double precision ada1 |
991 |
double precision ada2 |
992 |
double precision ada3 |
993 |
double precision addat1m(imt) |
994 |
double precision addat1s(imt) |
995 |
double precision addat1t(imt) |
996 |
double precision addelhat |
997 |
double precision addifsh |
998 |
double precision addifsp |
999 |
double precision addifth |
1000 |
double precision addiftp |
1001 |
double precision addvdzdn |
1002 |
double precision addvdzup |
1003 |
double precision adf1 |
1004 |
double precision adgat1m(imt) |
1005 |
double precision adgat1s(imt) |
1006 |
double precision adgat1t(imt) |
1007 |
double precision adgm |
1008 |
double precision adgs |
1009 |
double precision adgt |
1010 |
double precision adr |
1011 |
double precision adsig |
1012 |
double precision adtempvar |
1013 |
double precision advisch |
1014 |
double precision adviscp |
1015 |
double precision adwm(imt) |
1016 |
double precision adws(imt) |
1017 |
double precision dat1m(imt) |
1018 |
double precision dat1s(imt) |
1019 |
double precision dat1t(imt) |
1020 |
double precision delhat |
1021 |
double precision difsh |
1022 |
double precision difsp |
1023 |
double precision difth |
1024 |
double precision diftp |
1025 |
double precision dvdzdn |
1026 |
double precision dvdzup |
1027 |
double precision f1 |
1028 |
double precision gat1m(imt) |
1029 |
double precision gat1s(imt) |
1030 |
double precision gat1t(imt) |
1031 |
double precision gm |
1032 |
double precision gs |
1033 |
double precision gt |
1034 |
integer i |
1035 |
integer ip1 |
1036 |
integer ki |
1037 |
integer kn |
1038 |
double precision r |
1039 |
double precision sig |
1040 |
double precision sigma(imt) |
1041 |
double precision tempvar |
1042 |
double precision visch |
1043 |
double precision viscp |
1044 |
double precision wm(imt) |
1045 |
double precision ws(imt) |
1046 |
|
1047 |
C---------------------------------------------- |
1048 |
C RESET LOCAL ADJOINT VARIABLES |
1049 |
C---------------------------------------------- |
1050 |
ada1 = 0.d0 |
1051 |
ada2 = 0.d0 |
1052 |
ada3 = 0.d0 |
1053 |
do ip1 = 1, imt |
1054 |
addat1m(ip1) = 0.d0 |
1055 |
end do |
1056 |
do ip1 = 1, imt |
1057 |
addat1s(ip1) = 0.d0 |
1058 |
end do |
1059 |
do ip1 = 1, imt |
1060 |
addat1t(ip1) = 0.d0 |
1061 |
end do |
1062 |
addelhat = 0.d0 |
1063 |
addifsh = 0.d0 |
1064 |
addifsp = 0.d0 |
1065 |
addifth = 0.d0 |
1066 |
addiftp = 0.d0 |
1067 |
addvdzdn = 0.d0 |
1068 |
addvdzup = 0.d0 |
1069 |
adf1 = 0.d0 |
1070 |
do ip1 = 1, imt |
1071 |
adgat1m(ip1) = 0.d0 |
1072 |
end do |
1073 |
do ip1 = 1, imt |
1074 |
adgat1s(ip1) = 0.d0 |
1075 |
end do |
1076 |
do ip1 = 1, imt |
1077 |
adgat1t(ip1) = 0.d0 |
1078 |
end do |
1079 |
adgm = 0.d0 |
1080 |
adgs = 0.d0 |
1081 |
adgt = 0.d0 |
1082 |
adr = 0.d0 |
1083 |
adsig = 0.d0 |
1084 |
adtempvar = 0.d0 |
1085 |
advisch = 0.d0 |
1086 |
adviscp = 0.d0 |
1087 |
do ip1 = 1, imt |
1088 |
adwm(ip1) = 0.d0 |
1089 |
end do |
1090 |
do ip1 = 1, imt |
1091 |
adws(ip1) = 0.d0 |
1092 |
end do |
1093 |
|
1094 |
C---------------------------------------------- |
1095 |
C ROUTINE BODY |
1096 |
C---------------------------------------------- |
1097 |
do i = 1, imt |
1098 |
sigma(i) = stable(i)*1.+(1.-stable(i))*epsilon |
1099 |
end do |
1100 |
do ip1 = 1, imt |
1101 |
wm(ip1) = wmh(ip1,ikey) |
1102 |
end do |
1103 |
do ip1 = 1, imt |
1104 |
ws(ip1) = wsh(ip1,ikey) |
1105 |
end do |
1106 |
do i = 1, imt |
1107 |
kn = int(casea(i)+phepsi)*(kbl(i)-1)+(1-int(casea(i)+phepsi))* |
1108 |
$kbl(i) |
1109 |
delhat = 0.5*hwide(kn)-zgrid(kn)-hbl(i) |
1110 |
r = 1.-delhat/hwide(kn) |
1111 |
dvdzup = (diffus(i,kn-1,1)-diffus(i,kn,1))/hwide(kn) |
1112 |
dvdzdn = (diffus(i,kn,1)-diffus(i,kn+1,1))/hwide(kn+1) |
1113 |
viscp = 0.5*((1.-r)*(dvdzup+abs(dvdzup))+r*(dvdzdn+abs(dvdzdn))) |
1114 |
dvdzup = (diffus(i,kn-1,2)-diffus(i,kn,2))/hwide(kn) |
1115 |
dvdzdn = (diffus(i,kn,2)-diffus(i,kn+1,2))/hwide(kn+1) |
1116 |
difsp = 0.5*((1.-r)*(dvdzup+abs(dvdzup))+r*(dvdzdn+abs(dvdzdn))) |
1117 |
dvdzup = (diffus(i,kn-1,3)-diffus(i,kn,3))/hwide(kn) |
1118 |
dvdzdn = (diffus(i,kn,3)-diffus(i,kn+1,3))/hwide(kn+1) |
1119 |
diftp = 0.5*((1.-r)*(dvdzup+abs(dvdzup))+r*(dvdzdn+abs(dvdzdn))) |
1120 |
visch = diffus(i,kn,1)+viscp*delhat |
1121 |
difsh = diffus(i,kn,2)+difsp*delhat |
1122 |
difth = diffus(i,kn,3)+diftp*delhat |
1123 |
f1 = stable(i)*conc1*bfsfc(i)/max(ustar(i)**4,phepsi) |
1124 |
gat1m(i) = visch/hbl(i)/wm(i) |
1125 |
dat1m(i) = (-(viscp/wm(i)))+f1*visch |
1126 |
dat1m(i) = min(dat1m(i),p0) |
1127 |
gat1s(i) = difsh/hbl(i)/ws(i) |
1128 |
dat1s(i) = (-(difsp/ws(i)))+f1*difsh |
1129 |
dat1s(i) = min(dat1s(i),p0) |
1130 |
gat1t(i) = difth/hbl(i)/ws(i) |
1131 |
dat1t(i) = (-(diftp/ws(i)))+f1*difth |
1132 |
dat1t(i) = min(dat1t(i),p0) |
1133 |
end do |
1134 |
do ki = 1, nr |
1135 |
do i = 1, imt |
1136 |
sig = ((-zgrid(ki))+0.5*hwide(ki))/hbl(i) |
1137 |
sigma(i) = stable(i)*sig+(1.-stable(i))*min(sig,epsilon) |
1138 |
end do |
1139 |
end do |
1140 |
do i = 1, imt |
1141 |
sig = -(zgrid(kbl(i)-1)/hbl(i)) |
1142 |
sigma(i) = stable(i)*sig+(1.-stable(i))*min(sig,epsilon) |
1143 |
end do |
1144 |
call wscale( sigma,hbl,ustar,bfsfc,wm,ws ) |
1145 |
do i = 1, imt |
1146 |
ada1 = 0.d0 |
1147 |
ada2 = 0.d0 |
1148 |
ada3 = 0.d0 |
1149 |
adgm = 0.d0 |
1150 |
adgs = 0.d0 |
1151 |
adgt = 0.d0 |
1152 |
adsig = 0.d0 |
1153 |
sig = -(zgrid(kbl(i)-1)/hbl(i)) |
1154 |
a1 = sig-2. |
1155 |
a2 = 3.-2.*sig |
1156 |
a3 = sig-1. |
1157 |
gm = a1+a2*gat1m(i)+a3*dat1m(i) |
1158 |
gs = a1+a2*gat1s(i)+a3*dat1s(i) |
1159 |
gt = a1+a2*gat1t(i)+a3*dat1t(i) |
1160 |
adgt = adgt+addkm1(i,3)*hbl(i)*ws(i)*sig*sig |
1161 |
adhbl(i) = adhbl(i)+addkm1(i,3)*ws(i)*sig*(1.+sig*gt) |
1162 |
adsig = adsig+addkm1(i,3)*hbl(i)*ws(i)*(1.+2*sig*gt) |
1163 |
adws(i) = adws(i)+addkm1(i,3)*hbl(i)*sig*(1.+sig*gt) |
1164 |
addkm1(i,3) = 0.d0 |
1165 |
adgs = adgs+addkm1(i,2)*hbl(i)*ws(i)*sig*sig |
1166 |
adhbl(i) = adhbl(i)+addkm1(i,2)*ws(i)*sig*(1.+sig*gs) |
1167 |
adsig = adsig+addkm1(i,2)*hbl(i)*ws(i)*(1.+2*sig*gs) |
1168 |
adws(i) = adws(i)+addkm1(i,2)*hbl(i)*sig*(1.+sig*gs) |
1169 |
addkm1(i,2) = 0.d0 |
1170 |
adgm = adgm+addkm1(i,1)*hbl(i)*wm(i)*sig*sig |
1171 |
adhbl(i) = adhbl(i)+addkm1(i,1)*wm(i)*sig*(1.+sig*gm) |
1172 |
adsig = adsig+addkm1(i,1)*hbl(i)*wm(i)*(1.+2*sig*gm) |
1173 |
adwm(i) = adwm(i)+addkm1(i,1)*hbl(i)*sig*(1.+sig*gm) |
1174 |
addkm1(i,1) = 0.d0 |
1175 |
ada1 = ada1+adgt |
1176 |
ada2 = ada2+adgt*gat1t(i) |
1177 |
ada3 = ada3+adgt*dat1t(i) |
1178 |
addat1t(i) = addat1t(i)+adgt*a3 |
1179 |
adgat1t(i) = adgat1t(i)+adgt*a2 |
1180 |
adgt = 0.d0 |
1181 |
ada1 = ada1+adgs |
1182 |
ada2 = ada2+adgs*gat1s(i) |
1183 |
ada3 = ada3+adgs*dat1s(i) |
1184 |
addat1s(i) = addat1s(i)+adgs*a3 |
1185 |
adgat1s(i) = adgat1s(i)+adgs*a2 |
1186 |
adgs = 0.d0 |
1187 |
ada1 = ada1+adgm |
1188 |
ada2 = ada2+adgm*gat1m(i) |
1189 |
ada3 = ada3+adgm*dat1m(i) |
1190 |
addat1m(i) = addat1m(i)+adgm*a3 |
1191 |
adgat1m(i) = adgat1m(i)+adgm*a2 |
1192 |
adgm = 0.d0 |
1193 |
adsig = adsig+ada3 |
1194 |
ada3 = 0.d0 |
1195 |
adsig = adsig-2*ada2 |
1196 |
ada2 = 0.d0 |
1197 |
adsig = adsig+ada1 |
1198 |
ada1 = 0.d0 |
1199 |
adhbl(i) = adhbl(i)+adsig*(zgrid(kbl(i)-1)/(hbl(i)*hbl(i))) |
1200 |
adsig = 0.d0 |
1201 |
end do |
1202 |
call adwscale( sigma,hbl,ustar,bfsfc,adsigma,adhbl,adustar, |
1203 |
$adbfsfc,adwm,adws ) |
1204 |
do i = 1, imt |
1205 |
adsig = 0.d0 |
1206 |
sig = -(zgrid(kbl(i)-1)/hbl(i)) |
1207 |
adsig = adsig+adsigma(i)*(stable(i)+(1.-stable(i))*(0.5+ |
1208 |
$sign(0.5d0,epsilon-sig))) |
1209 |
adstable(i) = adstable(i)+adsigma(i)*(sig-min(sig,epsilon)) |
1210 |
adsigma(i) = 0.d0 |
1211 |
adhbl(i) = adhbl(i)+adsig*(zgrid(kbl(i)-1)/(hbl(i)*hbl(i))) |
1212 |
adsig = 0.d0 |
1213 |
end do |
1214 |
do ki = nr, 1, -1 |
1215 |
do i = 1, imt |
1216 |
sig = ((-zgrid(ki))+0.5*hwide(ki))/hbl(i) |
1217 |
sigma(i) = stable(i)*sig+(1.-stable(i))*min(sig,epsilon) |
1218 |
end do |
1219 |
call wscale( sigma,hbl,ustar,bfsfc,wm,ws ) |
1220 |
do i = 1, imt |
1221 |
ada1 = 0.d0 |
1222 |
ada2 = 0.d0 |
1223 |
ada3 = 0.d0 |
1224 |
adgm = 0.d0 |
1225 |
adgs = 0.d0 |
1226 |
adgt = 0.d0 |
1227 |
adsig = 0.d0 |
1228 |
adtempvar = 0.d0 |
1229 |
sig = ((-zgrid(ki))+0.5*hwide(ki))/hbl(i) |
1230 |
a1 = sig-2. |
1231 |
a2 = 3.-2.*sig |
1232 |
a3 = sig-1. |
1233 |
gm = a1+a2*gat1m(i)+a3*dat1m(i) |
1234 |
gs = a1+a2*gat1s(i)+a3*dat1s(i) |
1235 |
gt = a1+a2*gat1t(i)+a3*dat1t(i) |
1236 |
tempvar = ws(i)*hbl(i) |
1237 |
adstable(i) = adstable(i)-adghat(i,ki)*(cg/max(phepsi,tempvar) |
1238 |
$) |
1239 |
adtempvar = adtempvar-adghat(i,ki)*((1.-stable(i))*cg*(0.5- |
1240 |
$sign(0.5d0,phepsi-tempvar))/(max(phepsi,tempvar)*max(phepsi, |
1241 |
$tempvar))) |
1242 |
adghat(i,ki) = 0.d0 |
1243 |
adhbl(i) = adhbl(i)+adtempvar*ws(i) |
1244 |
adws(i) = adws(i)+adtempvar*hbl(i) |
1245 |
adtempvar = 0.d0 |
1246 |
adgt = adgt+adblmc(i,ki,3)*hbl(i)*ws(i)*sig*sig |
1247 |
adhbl(i) = adhbl(i)+adblmc(i,ki,3)*ws(i)*sig*(1.+sig*gt) |
1248 |
adsig = adsig+adblmc(i,ki,3)*hbl(i)*ws(i)*(1.+2*sig*gt) |
1249 |
adws(i) = adws(i)+adblmc(i,ki,3)*hbl(i)*sig*(1.+sig*gt) |
1250 |
adblmc(i,ki,3) = 0.d0 |
1251 |
adgs = adgs+adblmc(i,ki,2)*hbl(i)*ws(i)*sig*sig |
1252 |
adhbl(i) = adhbl(i)+adblmc(i,ki,2)*ws(i)*sig*(1.+sig*gs) |
1253 |
adsig = adsig+adblmc(i,ki,2)*hbl(i)*ws(i)*(1.+2*sig*gs) |
1254 |
adws(i) = adws(i)+adblmc(i,ki,2)*hbl(i)*sig*(1.+sig*gs) |
1255 |
adblmc(i,ki,2) = 0.d0 |
1256 |
adgm = adgm+adblmc(i,ki,1)*hbl(i)*wm(i)*sig*sig |
1257 |
adhbl(i) = adhbl(i)+adblmc(i,ki,1)*wm(i)*sig*(1.+sig*gm) |
1258 |
adsig = adsig+adblmc(i,ki,1)*hbl(i)*wm(i)*(1.+2*sig*gm) |
1259 |
adwm(i) = adwm(i)+adblmc(i,ki,1)*hbl(i)*sig*(1.+sig*gm) |
1260 |
adblmc(i,ki,1) = 0.d0 |
1261 |
ada1 = ada1+adgt |
1262 |
ada2 = ada2+adgt*gat1t(i) |
1263 |
ada3 = ada3+adgt*dat1t(i) |
1264 |
addat1t(i) = addat1t(i)+adgt*a3 |
1265 |
adgat1t(i) = adgat1t(i)+adgt*a2 |
1266 |
adgt = 0.d0 |
1267 |
ada1 = ada1+adgs |
1268 |
ada2 = ada2+adgs*gat1s(i) |
1269 |
ada3 = ada3+adgs*dat1s(i) |
1270 |
addat1s(i) = addat1s(i)+adgs*a3 |
1271 |
adgat1s(i) = adgat1s(i)+adgs*a2 |
1272 |
adgs = 0.d0 |
1273 |
ada1 = ada1+adgm |
1274 |
ada2 = ada2+adgm*gat1m(i) |
1275 |
ada3 = ada3+adgm*dat1m(i) |
1276 |
addat1m(i) = addat1m(i)+adgm*a3 |
1277 |
adgat1m(i) = adgat1m(i)+adgm*a2 |
1278 |
adgm = 0.d0 |
1279 |
adsig = adsig+ada3 |
1280 |
ada3 = 0.d0 |
1281 |
adsig = adsig-2*ada2 |
1282 |
ada2 = 0.d0 |
1283 |
adsig = adsig+ada1 |
1284 |
ada1 = 0.d0 |
1285 |
adhbl(i) = adhbl(i)-adsig*(((-zgrid(ki))+0.5*hwide(ki))/ |
1286 |
$(hbl(i)*hbl(i))) |
1287 |
adsig = 0.d0 |
1288 |
end do |
1289 |
call adwscale( sigma,hbl,ustar,bfsfc,adsigma,adhbl,adustar, |
1290 |
$adbfsfc,adwm,adws ) |
1291 |
do i = 1, imt |
1292 |
adsig = 0.d0 |
1293 |
sig = ((-zgrid(ki))+0.5*hwide(ki))/hbl(i) |
1294 |
adsig = adsig+adsigma(i)*(stable(i)+(1.-stable(i))*(0.5+ |
1295 |
$sign(0.5d0,epsilon-sig))) |
1296 |
adstable(i) = adstable(i)+adsigma(i)*(sig-min(sig,epsilon)) |
1297 |
adsigma(i) = 0.d0 |
1298 |
adhbl(i) = adhbl(i)-adsig*(((-zgrid(ki))+0.5*hwide(ki))/ |
1299 |
$(hbl(i)*hbl(i))) |
1300 |
adsig = 0.d0 |
1301 |
end do |
1302 |
end do |
1303 |
do ip1 = 1, imt |
1304 |
wm(ip1) = wmh(ip1,ikey) |
1305 |
end do |
1306 |
do ip1 = 1, imt |
1307 |
ws(ip1) = wsh(ip1,ikey) |
1308 |
end do |
1309 |
do i = 1, imt |
1310 |
addelhat = 0.d0 |
1311 |
addifsh = 0.d0 |
1312 |
addifsp = 0.d0 |
1313 |
addifth = 0.d0 |
1314 |
addiftp = 0.d0 |
1315 |
addvdzdn = 0.d0 |
1316 |
addvdzup = 0.d0 |
1317 |
adf1 = 0.d0 |
1318 |
adr = 0.d0 |
1319 |
advisch = 0.d0 |
1320 |
adviscp = 0.d0 |
1321 |
kn = int(casea(i)+phepsi)*(kbl(i)-1)+(1-int(casea(i)+phepsi))* |
1322 |
$kbl(i) |
1323 |
delhat = 0.5*hwide(kn)-zgrid(kn)-hbl(i) |
1324 |
r = 1.-delhat/hwide(kn) |
1325 |
dvdzup = (diffus(i,kn-1,1)-diffus(i,kn,1))/hwide(kn) |
1326 |
dvdzdn = (diffus(i,kn,1)-diffus(i,kn+1,1))/hwide(kn+1) |
1327 |
viscp = 0.5*((1.-r)*(dvdzup+abs(dvdzup))+r*(dvdzdn+abs(dvdzdn))) |
1328 |
dvdzup = (diffus(i,kn-1,2)-diffus(i,kn,2))/hwide(kn) |
1329 |
dvdzdn = (diffus(i,kn,2)-diffus(i,kn+1,2))/hwide(kn+1) |
1330 |
difsp = 0.5*((1.-r)*(dvdzup+abs(dvdzup))+r*(dvdzdn+abs(dvdzdn))) |
1331 |
dvdzup = (diffus(i,kn-1,3)-diffus(i,kn,3))/hwide(kn) |
1332 |
dvdzdn = (diffus(i,kn,3)-diffus(i,kn+1,3))/hwide(kn+1) |
1333 |
diftp = 0.5*((1.-r)*(dvdzup+abs(dvdzup))+r*(dvdzdn+abs(dvdzdn))) |
1334 |
visch = diffus(i,kn,1)+viscp*delhat |
1335 |
difsh = diffus(i,kn,2)+difsp*delhat |
1336 |
difth = diffus(i,kn,3)+diftp*delhat |
1337 |
f1 = stable(i)*conc1*bfsfc(i)/max(ustar(i)**4,phepsi) |
1338 |
dat1m(i) = (-(viscp/wm(i)))+f1*visch |
1339 |
dat1s(i) = (-(difsp/ws(i)))+f1*difsh |
1340 |
dat1t(i) = (-(diftp/ws(i)))+f1*difth |
1341 |
addat1t(i) = addat1t(i)*(0.5+sign(0.5d0,p0-dat1t(i))) |
1342 |
addifth = addifth+addat1t(i)*f1 |
1343 |
addiftp = addiftp-addat1t(i)/ws(i) |
1344 |
adf1 = adf1+addat1t(i)*difth |
1345 |
adws(i) = adws(i)+addat1t(i)*(diftp/(ws(i)*ws(i))) |
1346 |
addat1t(i) = 0.d0 |
1347 |
addifth = addifth+adgat1t(i)*(1/hbl(i)/ws(i)) |
1348 |
adhbl(i) = adhbl(i)-adgat1t(i)*(difth/(hbl(i)*hbl(i))/ws(i)) |
1349 |
adws(i) = adws(i)-adgat1t(i)*(difth/hbl(i)/(ws(i)*ws(i))) |
1350 |
adgat1t(i) = 0.d0 |
1351 |
addat1s(i) = addat1s(i)*(0.5+sign(0.5d0,p0-dat1s(i))) |
1352 |
addifsh = addifsh+addat1s(i)*f1 |
1353 |
addifsp = addifsp-addat1s(i)/ws(i) |
1354 |
adf1 = adf1+addat1s(i)*difsh |
1355 |
adws(i) = adws(i)+addat1s(i)*(difsp/(ws(i)*ws(i))) |
1356 |
addat1s(i) = 0.d0 |
1357 |
addifsh = addifsh+adgat1s(i)*(1/hbl(i)/ws(i)) |
1358 |
adhbl(i) = adhbl(i)-adgat1s(i)*(difsh/(hbl(i)*hbl(i))/ws(i)) |
1359 |
adws(i) = adws(i)-adgat1s(i)*(difsh/hbl(i)/(ws(i)*ws(i))) |
1360 |
adgat1s(i) = 0.d0 |
1361 |
addat1m(i) = addat1m(i)*(0.5+sign(0.5d0,p0-dat1m(i))) |
1362 |
adf1 = adf1+addat1m(i)*visch |
1363 |
advisch = advisch+addat1m(i)*f1 |
1364 |
adviscp = adviscp-addat1m(i)/wm(i) |
1365 |
adwm(i) = adwm(i)+addat1m(i)*(viscp/(wm(i)*wm(i))) |
1366 |
addat1m(i) = 0.d0 |
1367 |
adhbl(i) = adhbl(i)-adgat1m(i)*(visch/(hbl(i)*hbl(i))/wm(i)) |
1368 |
advisch = advisch+adgat1m(i)*(1/hbl(i)/wm(i)) |
1369 |
adwm(i) = adwm(i)-adgat1m(i)*(visch/hbl(i)/(wm(i)*wm(i))) |
1370 |
adgat1m(i) = 0.d0 |
1371 |
adbfsfc(i) = adbfsfc(i)+adf1*(stable(i)*conc1/max(ustar(i)**4, |
1372 |
$phepsi)) |
1373 |
adstable(i) = adstable(i)+adf1*(conc1*bfsfc(i)/max(ustar(i)**4, |
1374 |
$phepsi)) |
1375 |
adustar(i) = adustar(i)-adf1*(4*stable(i)*conc1*bfsfc(i)*(0.5+ |
1376 |
$sign(0.5d0,ustar(i)**4-phepsi))*ustar(i)**3/(max(ustar(i)**4, |
1377 |
$phepsi)*max(ustar(i)**4,phepsi))) |
1378 |
adf1 = 0.d0 |
1379 |
addelhat = addelhat+addifth*diftp |
1380 |
addiffus(i,kn,3) = addiffus(i,kn,3)+addifth |
1381 |
addiftp = addiftp+addifth*delhat |
1382 |
addifth = 0.d0 |
1383 |
addelhat = addelhat+addifsh*difsp |
1384 |
addiffus(i,kn,2) = addiffus(i,kn,2)+addifsh |
1385 |
addifsp = addifsp+addifsh*delhat |
1386 |
addifsh = 0.d0 |
1387 |
addelhat = addelhat+advisch*viscp |
1388 |
addiffus(i,kn,1) = addiffus(i,kn,1)+advisch |
1389 |
adviscp = adviscp+advisch*delhat |
1390 |
advisch = 0.d0 |
1391 |
addvdzdn = addvdzdn+0.5*addiftp*r |
1392 |
addvdzup = addvdzup+0.5*addiftp*(1.-r) |
1393 |
adr = adr+0.5*addiftp*((-(dvdzup+abs(dvdzup)))+dvdzdn+ |
1394 |
$abs(dvdzdn)) |
1395 |
addvdzdn = addvdzdn+0.5*addiftp*r*sign(1.d0,dvdzdn) |
1396 |
addvdzup = addvdzup+0.5*addiftp*(1.-r)*sign(1.d0,dvdzup) |
1397 |
addiftp = 0.d0 |
1398 |
addiffus(i,kn+1,3) = addiffus(i,kn+1,3)-addvdzdn/hwide(kn+1) |
1399 |
addiffus(i,kn,3) = addiffus(i,kn,3)+addvdzdn/hwide(kn+1) |
1400 |
addvdzdn = 0.d0 |
1401 |
addiffus(i,kn-1,3) = addiffus(i,kn-1,3)+addvdzup/hwide(kn) |
1402 |
addiffus(i,kn,3) = addiffus(i,kn,3)-addvdzup/hwide(kn) |
1403 |
addvdzup = 0.d0 |
1404 |
dvdzup = (diffus(i,kn-1,2)-diffus(i,kn,2))/hwide(kn) |
1405 |
dvdzdn = (diffus(i,kn,2)-diffus(i,kn+1,2))/hwide(kn+1) |
1406 |
addvdzdn = addvdzdn+0.5*addifsp*r |
1407 |
addvdzup = addvdzup+0.5*addifsp*(1.-r) |
1408 |
adr = adr+0.5*addifsp*((-(dvdzup+abs(dvdzup)))+dvdzdn+ |
1409 |
$abs(dvdzdn)) |
1410 |
addvdzdn = addvdzdn+0.5*addifsp*r*sign(1.d0,dvdzdn) |
1411 |
addvdzup = addvdzup+0.5*addifsp*(1.-r)*sign(1.d0,dvdzup) |
1412 |
addifsp = 0.d0 |
1413 |
addiffus(i,kn+1,2) = addiffus(i,kn+1,2)-addvdzdn/hwide(kn+1) |
1414 |
addiffus(i,kn,2) = addiffus(i,kn,2)+addvdzdn/hwide(kn+1) |
1415 |
addvdzdn = 0.d0 |
1416 |
addiffus(i,kn-1,2) = addiffus(i,kn-1,2)+addvdzup/hwide(kn) |
1417 |
addiffus(i,kn,2) = addiffus(i,kn,2)-addvdzup/hwide(kn) |
1418 |
addvdzup = 0.d0 |
1419 |
dvdzup = (diffus(i,kn-1,1)-diffus(i,kn,1))/hwide(kn) |
1420 |
dvdzdn = (diffus(i,kn,1)-diffus(i,kn+1,1))/hwide(kn+1) |
1421 |
addvdzdn = addvdzdn+0.5*adviscp*r |
1422 |
addvdzup = addvdzup+0.5*adviscp*(1.-r) |
1423 |
adr = adr+0.5*adviscp*((-(dvdzup+abs(dvdzup)))+dvdzdn+ |
1424 |
$abs(dvdzdn)) |
1425 |
addvdzdn = addvdzdn+0.5*adviscp*r*sign(1.d0,dvdzdn) |
1426 |
addvdzup = addvdzup+0.5*adviscp*(1.-r)*sign(1.d0,dvdzup) |
1427 |
adviscp = 0.d0 |
1428 |
addiffus(i,kn+1,1) = addiffus(i,kn+1,1)-addvdzdn/hwide(kn+1) |
1429 |
addiffus(i,kn,1) = addiffus(i,kn,1)+addvdzdn/hwide(kn+1) |
1430 |
addvdzdn = 0.d0 |
1431 |
addiffus(i,kn-1,1) = addiffus(i,kn-1,1)+addvdzup/hwide(kn) |
1432 |
addiffus(i,kn,1) = addiffus(i,kn,1)-addvdzup/hwide(kn) |
1433 |
addvdzup = 0.d0 |
1434 |
addelhat = addelhat-adr/hwide(kn) |
1435 |
adr = 0.d0 |
1436 |
adhbl(i) = adhbl(i)-addelhat |
1437 |
addelhat = 0.d0 |
1438 |
end do |
1439 |
do i = 1, imt |
1440 |
sigma(i) = stable(i)*1.+(1.-stable(i))*epsilon |
1441 |
end do |
1442 |
call wscale( sigma,hbl,ustar,bfsfc,wm,ws ) |
1443 |
do i = 1, imt |
1444 |
adws(i) = adws(i)*(1+(0.5-sign(0.5d0,phepsi-abs(ws(i))))* |
1445 |
$sign(eins,ws(i))*sign(1.d0,ws(i))) |
1446 |
adws(i) = 0.d0 |
1447 |
adwm(i) = adwm(i)*(1+(0.5-sign(0.5d0,phepsi-abs(wm(i))))* |
1448 |
$sign(eins,wm(i))*sign(1.d0,wm(i))) |
1449 |
adwm(i) = 0.d0 |
1450 |
end do |
1451 |
do i = 1, imt |
1452 |
sigma(i) = stable(i)*1.+(1.-stable(i))*epsilon |
1453 |
end do |
1454 |
call adwscale( sigma,hbl,ustar,bfsfc,adsigma,adhbl,adustar, |
1455 |
$adbfsfc,adwm,adws ) |
1456 |
do i = 1, imt |
1457 |
adstable(i) = adstable(i)+adsigma(i)*(1-epsilon) |
1458 |
adsigma(i) = 0.d0 |
1459 |
end do |
1460 |
|
1461 |
end |
1462 |
|
1463 |
|
1464 |
subroutine adcalc_common_factors( bi, bj, imin, imax, jmin, jmax, |
1465 |
$k, adutrans, advtrans, adrtrans ) |
1466 |
C*************************************************************** |
1467 |
C*************************************************************** |
1468 |
C** This routine was generated by the ** |
1469 |
C** Tangent linear and Adjoint Model Compiler, TAMC 5.2.14 ** |
1470 |
C*************************************************************** |
1471 |
C*************************************************************** |
1472 |
C============================================== |
1473 |
C all entries are defined explicitly |
1474 |
C============================================== |
1475 |
implicit none |
1476 |
|
1477 |
C============================================== |
1478 |
C define parameters |
1479 |
C============================================== |
1480 |
integer nr |
1481 |
parameter ( nr = 15 ) |
1482 |
integer nsx |
1483 |
parameter ( nsx = 1 ) |
1484 |
integer nsy |
1485 |
parameter ( nsy = 1 ) |
1486 |
integer olx |
1487 |
parameter ( olx = 3 ) |
1488 |
integer oly |
1489 |
parameter ( oly = 3 ) |
1490 |
integer snx |
1491 |
parameter ( snx = 20 ) |
1492 |
integer sny |
1493 |
parameter ( sny = 40 ) |
1494 |
|
1495 |
C============================================== |
1496 |
C define common blocks |
1497 |
C============================================== |
1498 |
common /addynvars_r/ adetan, aduvel, advvel, adwvel, adtheta, |
1499 |
$adsalt, adgu, adgv, adgt, adgs, adgunm1, adgvnm1, adgtnm1, adgsnm1 |
1500 |
double precision adetan(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
1501 |
double precision adgs(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
1502 |
double precision adgsnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
1503 |
double precision adgt(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
1504 |
double precision adgtnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
1505 |
double precision adgu(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
1506 |
double precision adgunm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
1507 |
double precision adgv(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
1508 |
double precision adgvnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
1509 |
double precision adsalt(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
1510 |
double precision adtheta(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
1511 |
double precision aduvel(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
1512 |
double precision advvel(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
1513 |
double precision adwvel(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
1514 |
|
1515 |
common /grid_r/ dxc, dxf, dxg, dxv, dyc, dyf, dyg, dyu, drc, drf, |
1516 |
$h, hfacc, hfacw, hfacs, depthink, recip_dxc, recip_dxf, recip_dxg, |
1517 |
$ recip_dxv, recip_dyc, recip_dyf, recip_dyg, recip_dyu, recip_drc, |
1518 |
$ recip_drf, recip_h, recip_hfacc, recip_hfacw, recip_hfacs, rkfac, |
1519 |
$ recip_rkfac, safac, xc, yc, ra, raw, ras, raz, rc, rf, yc0, xc0, |
1520 |
$xg, yg, maskw, masks, recip_ra, recip_raw, recip_ras, recip_raz, |
1521 |
$tanphiatu, tanphiatv |
1522 |
double precision depthink(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
1523 |
double precision drc(1:nr) |
1524 |
double precision drf(1:nr) |
1525 |
double precision dxc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
1526 |
double precision dxf(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
1527 |
double precision dxg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
1528 |
double precision dxv(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
1529 |
double precision dyc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
1530 |
double precision dyf(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
1531 |
double precision dyg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
1532 |
double precision dyu(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
1533 |
double precision h(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
1534 |
double precision hfacc(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) |
1535 |
double precision hfacs(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) |
1536 |
double precision hfacw(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) |
1537 |
double precision masks(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) |
1538 |
double precision maskw(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) |
1539 |
double precision ra(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
1540 |
double precision ras(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
1541 |
double precision raw(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
1542 |
double precision raz(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
1543 |
double precision rc(1:nr) |
1544 |
double precision recip_drc(1:nr) |
1545 |
double precision recip_drf(1:nr) |
1546 |
double precision recip_dxc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
1547 |
double precision recip_dxf(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
1548 |
double precision recip_dxg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
1549 |
double precision recip_dxv(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
1550 |
double precision recip_dyc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
1551 |
double precision recip_dyf(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
1552 |
double precision recip_dyg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
1553 |
double precision recip_dyu(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
1554 |
double precision recip_h(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
1555 |
double precision recip_hfacc(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx, |
1556 |
$nsy) |
1557 |
double precision recip_hfacs(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx, |
1558 |
$nsy) |
1559 |
double precision recip_hfacw(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx, |
1560 |
$nsy) |
1561 |
double precision recip_ra(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
1562 |
double precision recip_ras(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
1563 |
double precision recip_raw(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
1564 |
double precision recip_raz(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
1565 |
double precision recip_rkfac |
1566 |
double precision rf(1:nr+1) |
1567 |
double precision rkfac |
1568 |
double precision safac(1:nr) |
1569 |
double precision tanphiatu(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
1570 |
double precision tanphiatv(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
1571 |
double precision xc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
1572 |
double precision xc0 |
1573 |
double precision xg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
1574 |
double precision yc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
1575 |
double precision yc0 |
1576 |
double precision yg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
1577 |
|
1578 |
C============================================== |
1579 |
C define arguments |
1580 |
C============================================== |
1581 |
double precision adrtrans(1-olx:snx+olx,1-oly:sny+oly) |
1582 |
double precision adutrans(1-olx:snx+olx,1-oly:sny+oly) |
1583 |
double precision advtrans(1-olx:snx+olx,1-oly:sny+oly) |
1584 |
integer bi |
1585 |
integer bj |
1586 |
integer imax |
1587 |
integer imin |
1588 |
integer jmax |
1589 |
integer jmin |
1590 |
integer k |
1591 |
|
1592 |
C============================================== |
1593 |
C define local variables |
1594 |
C============================================== |
1595 |
integer i |
1596 |
integer j |
1597 |
double precision xa(1-olx:snx+olx,1-oly:sny+oly) |
1598 |
double precision ya(1-olx:snx+olx,1-oly:sny+oly) |
1599 |
|
1600 |
C---------------------------------------------- |
1601 |
C ROUTINE BODY |
1602 |
C---------------------------------------------- |
1603 |
do j = jmin, jmax |
1604 |
do i = imin, imax |
1605 |
xa(i,j) = dyg(i,j,bi,bj)*drf(k)*hfacw(i,j,k,bi,bj) |
1606 |
ya(i,j) = dxg(i,j,bi,bj)*drf(k)*hfacs(i,j,k,bi,bj) |
1607 |
end do |
1608 |
end do |
1609 |
do j = jmin, jmax |
1610 |
do i = imin, imax |
1611 |
adwvel(i,j,k,bi,bj) = adwvel(i,j,k,bi,bj)+adrtrans(i,j)*ra(i, |
1612 |
$j,bi,bj) |
1613 |
adrtrans(i,j) = 0.d0 |
1614 |
end do |
1615 |
end do |
1616 |
do j = jmin, jmax |
1617 |
do i = imin, imax |
1618 |
advvel(i,j,k,bi,bj) = advvel(i,j,k,bi,bj)+advtrans(i,j)*ya(i, |
1619 |
$j) |
1620 |
advtrans(i,j) = 0.d0 |
1621 |
aduvel(i,j,k,bi,bj) = aduvel(i,j,k,bi,bj)+adutrans(i,j)*xa(i, |
1622 |
$j) |
1623 |
adutrans(i,j) = 0.d0 |
1624 |
end do |
1625 |
end do |
1626 |
|
1627 |
end |
1628 |
|
1629 |
|
1630 |
subroutine adcalc_diffusivity( bi, bj, imin, imax, jmin, jmax, k, |
1631 |
$maskc, maskup, adkappart, adkappars, adkapparu, adkapparv ) |
1632 |
C*************************************************************** |
1633 |
C*************************************************************** |
1634 |
C** This routine was generated by the ** |
1635 |
C** Tangent linear and Adjoint Model Compiler, TAMC 5.2.14 ** |
1636 |
C*************************************************************** |
1637 |
C*************************************************************** |
1638 |
C============================================== |
1639 |
C all entries are defined explicitly |
1640 |
C============================================== |
1641 |
implicit none |
1642 |
|
1643 |
C============================================== |
1644 |
C define parameters |
1645 |
C============================================== |
1646 |
integer npx |
1647 |
parameter ( npx = 1 ) |
1648 |
integer npy |
1649 |
parameter ( npy = 1 ) |
1650 |
integer nr |
1651 |
parameter ( nr = 15 ) |
1652 |
integer nsx |
1653 |
parameter ( nsx = 1 ) |
1654 |
integer nsy |
1655 |
parameter ( nsy = 1 ) |
1656 |
integer snx |
1657 |
parameter ( snx = 20 ) |
1658 |
integer nx |
1659 |
parameter ( nx = snx*nsx*npx ) |
1660 |
integer sny |
1661 |
parameter ( sny = 40 ) |
1662 |
integer ny |
1663 |
parameter ( ny = sny*nsy*npy ) |
1664 |
integer olx |
1665 |
parameter ( olx = 3 ) |
1666 |
integer oly |
1667 |
parameter ( oly = 3 ) |
1668 |
|
1669 |
C============================================== |
1670 |
C define common blocks |
1671 |
C============================================== |
1672 |
common /parm_packages/ usekpp, usegmredi, useobcs, useaim, useecco |
1673 |
logical useaim |
1674 |
logical useecco |
1675 |
logical usegmredi |
1676 |
logical usekpp |
1677 |
logical useobcs |
1678 |
|
1679 |
common /parm_r/ cg2dtargetresidual, cg2dpcoffdfac, |
1680 |
$cg3dtargetresidual, delp, delz, delr, delx, dely, deltat, |
1681 |
$deltatmom, deltattracer, deltatclock, abeps, starttime, phimin, |
1682 |
$thetamin, rsphere, recip_rsphere, f0, fcori, beta, viscah, viscaz, |
1683 |
$ visca4, viscar, diffkht, diffkzt, diffk4t, diffkrt, diffkhs, |
1684 |
$diffkzs, diffk4s, diffkrs, delt, taucd, rcd, freesurffac, |
1685 |
$implicsurfpress, implicdiv2dflow, hfacmin, hfacmindz, gravity, |
1686 |
$recip_gravity, gbaro, rhonil, recip_rhonil, recip_rhoconst, |
1687 |
$rhoconst, tref, sref, endtime, chkptfreq, pchkptfreq, dumpfreq, |
1688 |
$tavefreq, affacmom, vffacmom, pffacmom, cffacmom, fofacmom, |
1689 |
$mtfacmom, cospower, cadjfreq, omega, tauthetaclimrelax, |
1690 |
$lambdathetaclimrelax, tausaltclimrelax, lambdasaltclimrelax, |
1691 |
$externforcingcycle, externforcingperiod, viscap, diffkpt, diffkps, |
1692 |
$ hfacmindr, hfacmindp, theta_s, specvol_s, horivertratio, |
1693 |
$recip_horivertratio, latfftfiltlo, ivdc_kappa, ro_sealevel, |
1694 |
$zonal_filt_lat, bottomdraglinear, bottomdragquadratic |
1695 |
double precision abeps |
1696 |
double precision affacmom |
1697 |
double precision beta |
1698 |
double precision bottomdraglinear |
1699 |
double precision bottomdragquadratic |
1700 |
double precision cadjfreq |
1701 |
double precision cffacmom |
1702 |
double precision cg2dpcoffdfac |
1703 |
double precision cg2dtargetresidual |
1704 |
double precision cg3dtargetresidual |
1705 |
double precision chkptfreq |
1706 |
double precision cospower |
1707 |
double precision delp(nr) |
1708 |
double precision delr(nr) |
1709 |
double precision delt |
1710 |
double precision deltat |
1711 |
double precision deltatclock |
1712 |
double precision deltatmom |
1713 |
double precision deltattracer |
1714 |
double precision delx(nx) |
1715 |
double precision dely(ny) |
1716 |
double precision delz(nr) |
1717 |
double precision diffk4s |
1718 |
double precision diffk4t |
1719 |
double precision diffkhs |
1720 |
double precision diffkht |
1721 |
double precision diffkps |
1722 |
double precision diffkpt |
1723 |
double precision diffkrs |
1724 |
double precision diffkrt |
1725 |
double precision diffkzs |
1726 |
double precision diffkzt |
1727 |
double precision dumpfreq |
1728 |
double precision endtime |
1729 |
double precision externforcingcycle |
1730 |
double precision externforcingperiod |
1731 |
double precision f0 |
1732 |
double precision fcori(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
1733 |
double precision fofacmom |
1734 |
double precision freesurffac |
1735 |
double precision gbaro |
1736 |
double precision gravity |
1737 |
double precision hfacmin |
1738 |
double precision hfacmindp |
1739 |
double precision hfacmindr |
1740 |
double precision hfacmindz |
1741 |
double precision horivertratio |
1742 |
double precision implicdiv2dflow |
1743 |
double precision implicsurfpress |
1744 |
double precision ivdc_kappa |
1745 |
double precision lambdasaltclimrelax |
1746 |
double precision lambdathetaclimrelax |
1747 |
double precision latfftfiltlo |
1748 |
double precision mtfacmom |
1749 |
double precision omega |
1750 |
double precision pchkptfreq |
1751 |
double precision pffacmom |
1752 |
double precision phimin |
1753 |
double precision rcd |
1754 |
double precision recip_gravity |
1755 |
double precision recip_horivertratio |
1756 |
double precision recip_rhoconst |
1757 |
double precision recip_rhonil |
1758 |
double precision recip_rsphere |
1759 |
double precision rhoconst |
1760 |
double precision rhonil |
1761 |
double precision ro_sealevel |
1762 |
double precision rsphere |
1763 |
double precision specvol_s(nr) |
1764 |
double precision sref(nr) |
1765 |
double precision starttime |
1766 |
double precision taucd |
1767 |
double precision tausaltclimrelax |
1768 |
double precision tauthetaclimrelax |
1769 |
double precision tavefreq |
1770 |
double precision theta_s(nr) |
1771 |
double precision thetamin |
1772 |
double precision tref(nr) |
1773 |
double precision vffacmom |
1774 |
double precision visca4 |
1775 |
double precision viscah |
1776 |
double precision viscap |
1777 |
double precision viscar |
1778 |
double precision viscaz |
1779 |
double precision zonal_filt_lat |
1780 |
|
1781 |
C============================================== |
1782 |
C define arguments |
1783 |
C============================================== |
1784 |
double precision adkappars(1-olx:snx+olx,1-oly:sny+oly,nr) |
1785 |
double precision adkappart(1-olx:snx+olx,1-oly:sny+oly,nr) |
1786 |
double precision adkapparu(1-olx:snx+olx,1-oly:sny+oly,nr) |
1787 |
double precision adkapparv(1-olx:snx+olx,1-oly:sny+oly,nr) |
1788 |
integer bi |
1789 |
integer bj |
1790 |
integer imax |
1791 |
integer imin |
1792 |
integer jmax |
1793 |
integer jmin |
1794 |
integer k |
1795 |
double precision maskc(1-olx:snx+olx,1-oly:sny+oly) |
1796 |
double precision maskup(1-olx:snx+olx,1-oly:sny+oly) |
1797 |
|
1798 |
C============================================== |
1799 |
C define local variables |
1800 |
C============================================== |
1801 |
integer i |
1802 |
integer j |
1803 |
double precision kapparu(1-olx:snx+olx,1-oly:sny+oly,nr) |
1804 |
double precision kapparv(1-olx:snx+olx,1-oly:sny+oly,nr) |
1805 |
|
1806 |
C---------------------------------------------- |
1807 |
C ROUTINE BODY |
1808 |
C---------------------------------------------- |
1809 |
do j = jmin, jmax |
1810 |
do i = imin, imax |
1811 |
kapparu(i,j,k) = viscar |
1812 |
end do |
1813 |
end do |
1814 |
do j = jmin, jmax |
1815 |
do i = imin, imax |
1816 |
kapparv(i,j,k) = viscar |
1817 |
end do |
1818 |
end do |
1819 |
if (usekpp) then |
1820 |
call adkpp_calc_diff( bi,bj,imin,imax,jmin,jmax,k,maskup, |
1821 |
$kapparu,kapparv,adkappart,adkappars,adkapparu,adkapparv ) |
1822 |
endif |
1823 |
if (usegmredi) then |
1824 |
call adgmredi_calc_diff( bi,bj,imin,imax,jmin,jmax,k,maskup, |
1825 |
$adkappart,adkappars ) |
1826 |
endif |
1827 |
do j = jmin, jmax |
1828 |
do i = imin, imax |
1829 |
adkapparv(i,j,k) = 0.d0 |
1830 |
end do |
1831 |
end do |
1832 |
do j = jmin, jmax |
1833 |
do i = imin, imax |
1834 |
adkapparu(i,j,k) = 0.d0 |
1835 |
end do |
1836 |
end do |
1837 |
do j = jmin, jmax |
1838 |
do i = imin, imax |
1839 |
adkappars(i,j,k) = adkappars(i,j,k)*maskc(i,j)*maskup(i,j) |
1840 |
end do |
1841 |
end do |
1842 |
do j = jmin, jmax |
1843 |
do i = imin, imax |
1844 |
adkappart(i,j,k) = adkappart(i,j,k)*maskc(i,j)*maskup(i,j) |
1845 |
end do |
1846 |
end do |
1847 |
|
1848 |
end |
1849 |
|
1850 |
|
1851 |
subroutine adcalc_div_ghat( bi, bj, k, xa, ya, adcg2d_b ) |
1852 |
C*************************************************************** |
1853 |
C*************************************************************** |
1854 |
C** This routine was generated by the ** |
1855 |
C** Tangent linear and Adjoint Model Compiler, TAMC 5.2.14 ** |
1856 |
C*************************************************************** |
1857 |
C*************************************************************** |
1858 |
C============================================== |
1859 |
C all entries are defined explicitly |
1860 |
C============================================== |
1861 |
implicit none |
1862 |
|
1863 |
C============================================== |
1864 |
C define parameters |
1865 |
C============================================== |
1866 |
integer npx |
1867 |
parameter ( npx = 1 ) |
1868 |
integer npy |
1869 |
parameter ( npy = 1 ) |
1870 |
integer nr |
1871 |
parameter ( nr = 15 ) |
1872 |
integer nsx |
1873 |
parameter ( nsx = 1 ) |
1874 |
integer nsy |
1875 |
parameter ( nsy = 1 ) |
1876 |
integer snx |
1877 |
parameter ( snx = 20 ) |
1878 |
integer nx |
1879 |
parameter ( nx = snx*nsx*npx ) |
1880 |
integer sny |
1881 |
parameter ( sny = 40 ) |
1882 |
integer ny |
1883 |
parameter ( ny = sny*nsy*npy ) |
1884 |
integer olx |
1885 |
parameter ( olx = 3 ) |
1886 |
integer oly |
1887 |
parameter ( oly = 3 ) |
1888 |
|
1889 |
C============================================== |
1890 |
C define common blocks |
1891 |
C============================================== |
1892 |
common /addynvars_r/ adetan, aduvel, advvel, adwvel, adtheta, |
1893 |
$adsalt, adgu, adgv, adgt, adgs, adgunm1, adgvnm1, adgtnm1, adgsnm1 |
1894 |
double precision adetan(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
1895 |
double precision adgs(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
1896 |
double precision adgsnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
1897 |
double precision adgt(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
1898 |
double precision adgtnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
1899 |
double precision adgu(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
1900 |
double precision adgunm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
1901 |
double precision adgv(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
1902 |
double precision adgvnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
1903 |
double precision adsalt(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
1904 |
double precision adtheta(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
1905 |
double precision aduvel(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
1906 |
double precision advvel(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
1907 |
double precision adwvel(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
1908 |
|
1909 |
common /parm_r/ cg2dtargetresidual, cg2dpcoffdfac, |
1910 |
$cg3dtargetresidual, delp, delz, delr, delx, dely, deltat, |
1911 |
$deltatmom, deltattracer, deltatclock, abeps, starttime, phimin, |
1912 |
$thetamin, rsphere, recip_rsphere, f0, fcori, beta, viscah, viscaz, |
1913 |
$ visca4, viscar, diffkht, diffkzt, diffk4t, diffkrt, diffkhs, |
1914 |
$diffkzs, diffk4s, diffkrs, delt, taucd, rcd, freesurffac, |
1915 |
$implicsurfpress, implicdiv2dflow, hfacmin, hfacmindz, gravity, |
1916 |
$recip_gravity, gbaro, rhonil, recip_rhonil, recip_rhoconst, |
1917 |
$rhoconst, tref, sref, endtime, chkptfreq, pchkptfreq, dumpfreq, |
1918 |
$tavefreq, affacmom, vffacmom, pffacmom, cffacmom, fofacmom, |
1919 |
$mtfacmom, cospower, cadjfreq, omega, tauthetaclimrelax, |
1920 |
$lambdathetaclimrelax, tausaltclimrelax, lambdasaltclimrelax, |
1921 |
$externforcingcycle, externforcingperiod, viscap, diffkpt, diffkps, |
1922 |
$ hfacmindr, hfacmindp, theta_s, specvol_s, horivertratio, |
1923 |
$recip_horivertratio, latfftfiltlo, ivdc_kappa, ro_sealevel, |
1924 |
$zonal_filt_lat, bottomdraglinear, bottomdragquadratic |
1925 |
double precision abeps |
1926 |
double precision affacmom |
1927 |
double precision beta |
1928 |
double precision bottomdraglinear |
1929 |
double precision bottomdragquadratic |
1930 |
double precision cadjfreq |
1931 |
double precision cffacmom |
1932 |
double precision cg2dpcoffdfac |
1933 |
double precision cg2dtargetresidual |
1934 |
double precision cg3dtargetresidual |
1935 |
double precision chkptfreq |
1936 |
double precision cospower |
1937 |
double precision delp(nr) |
1938 |
double precision delr(nr) |
1939 |
double precision delt |
1940 |
double precision deltat |
1941 |
double precision deltatclock |
1942 |
double precision deltatmom |
1943 |
double precision deltattracer |
1944 |
double precision delx(nx) |
1945 |
double precision dely(ny) |
1946 |
double precision delz(nr) |
1947 |
double precision diffk4s |
1948 |
double precision diffk4t |
1949 |
double precision diffkhs |
1950 |
double precision diffkht |
1951 |
double precision diffkps |
1952 |
double precision diffkpt |
1953 |
double precision diffkrs |
1954 |
double precision diffkrt |
1955 |
double precision diffkzs |
1956 |
double precision diffkzt |
1957 |
double precision dumpfreq |
1958 |
double precision endtime |
1959 |
double precision externforcingcycle |
1960 |
double precision externforcingperiod |
1961 |
double precision f0 |
1962 |
double precision fcori(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
1963 |
double precision fofacmom |
1964 |
double precision freesurffac |
1965 |
double precision gbaro |
1966 |
double precision gravity |
1967 |
double precision hfacmin |
1968 |
double precision hfacmindp |
1969 |
double precision hfacmindr |
1970 |
double precision hfacmindz |
1971 |
double precision horivertratio |
1972 |
double precision implicdiv2dflow |
1973 |
double precision implicsurfpress |
1974 |
double precision ivdc_kappa |
1975 |
double precision lambdasaltclimrelax |
1976 |
double precision lambdathetaclimrelax |
1977 |
double precision latfftfiltlo |
1978 |
double precision mtfacmom |
1979 |
double precision omega |
1980 |
double precision pchkptfreq |
1981 |
double precision pffacmom |
1982 |
double precision phimin |
1983 |
double precision rcd |
1984 |
double precision recip_gravity |
1985 |
double precision recip_horivertratio |
1986 |
double precision recip_rhoconst |
1987 |
double precision recip_rhonil |
1988 |
double precision recip_rsphere |
1989 |
double precision rhoconst |
1990 |
double precision rhonil |
1991 |
double precision ro_sealevel |
1992 |
double precision rsphere |
1993 |
double precision specvol_s(nr) |
1994 |
double precision sref(nr) |
1995 |
double precision starttime |
1996 |
double precision taucd |
1997 |
double precision tausaltclimrelax |
1998 |
double precision tauthetaclimrelax |
1999 |
double precision tavefreq |
2000 |
double precision theta_s(nr) |
2001 |
double precision thetamin |
2002 |
double precision tref(nr) |
2003 |
double precision vffacmom |
2004 |
double precision visca4 |
2005 |
double precision viscah |
2006 |
double precision viscap |
2007 |
double precision viscar |
2008 |
double precision viscaz |
2009 |
double precision zonal_filt_lat |
2010 |
|
2011 |
C============================================== |
2012 |
C define arguments |
2013 |
C============================================== |
2014 |
double precision adcg2d_b(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
2015 |
integer bi |
2016 |
integer bj |
2017 |
integer k |
2018 |
double precision xa(1-olx:snx+olx,1-oly:sny+oly) |
2019 |
double precision ya(1-olx:snx+olx,1-oly:sny+oly) |
2020 |
|
2021 |
C============================================== |
2022 |
C define local variables |
2023 |
C============================================== |
2024 |
double precision adpf(1-olx:snx+olx,1-oly:sny+oly) |
2025 |
integer i |
2026 |
integer ip1 |
2027 |
integer ip2 |
2028 |
integer j |
2029 |
|
2030 |
C---------------------------------------------- |
2031 |
C RESET LOCAL ADJOINT VARIABLES |
2032 |
C---------------------------------------------- |
2033 |
do ip2 = 1-oly, sny+oly |
2034 |
do ip1 = 1-olx, snx+olx |
2035 |
adpf(ip1,ip2) = 0.d0 |
2036 |
end do |
2037 |
end do |
2038 |
|
2039 |
C---------------------------------------------- |
2040 |
C ROUTINE BODY |
2041 |
C---------------------------------------------- |
2042 |
do j = 1, sny |
2043 |
do i = 1, snx |
2044 |
adpf(i,j+1) = adpf(i,j+1)+adcg2d_b(i,j,bi,bj) |
2045 |
adpf(i,j) = adpf(i,j)-adcg2d_b(i,j,bi,bj) |
2046 |
end do |
2047 |
end do |
2048 |
if (implicdiv2dflow .eq. 1.) then |
2049 |
do j = 1, sny+1 |
2050 |
do i = 1, snx |
2051 |
adgvnm1(i,j,k,bi,bj) = adgvnm1(i,j,k,bi,bj)+adpf(i,j)*(ya(i, |
2052 |
$j)/deltatmom) |
2053 |
adpf(i,j) = 0.d0 |
2054 |
end do |
2055 |
end do |
2056 |
else |
2057 |
do j = 1, sny+1 |
2058 |
do i = 1, snx |
2059 |
adgvnm1(i,j,k,bi,bj) = adgvnm1(i,j,k,bi,bj)+adpf(i,j)* |
2060 |
$(implicdiv2dflow*ya(i,j)/deltatmom) |
2061 |
advvel(i,j,k,bi,bj) = advvel(i,j,k,bi,bj)+adpf(i,j)*((1.- |
2062 |
$implicdiv2dflow)*ya(i,j)/deltatmom) |
2063 |
adpf(i,j) = 0.d0 |
2064 |
end do |
2065 |
end do |
2066 |
endif |
2067 |
do j = 1, sny |
2068 |
do i = 1, snx |
2069 |
adpf(i+1,j) = adpf(i+1,j)+adcg2d_b(i,j,bi,bj) |
2070 |
adpf(i,j) = adpf(i,j)-adcg2d_b(i,j,bi,bj) |
2071 |
end do |
2072 |
end do |
2073 |
if (implicdiv2dflow .eq. 1.) then |
2074 |
do j = 1, sny |
2075 |
do i = 1, snx+1 |
2076 |
adgunm1(i,j,k,bi,bj) = adgunm1(i,j,k,bi,bj)+adpf(i,j)*(xa(i, |
2077 |
$j)/deltatmom) |
2078 |
adpf(i,j) = 0.d0 |
2079 |
end do |
2080 |
end do |
2081 |
else |
2082 |
do j = 1, sny |
2083 |
do i = 1, snx+1 |
2084 |
adgunm1(i,j,k,bi,bj) = adgunm1(i,j,k,bi,bj)+adpf(i,j)* |
2085 |
$(implicdiv2dflow*xa(i,j)/deltatmom) |
2086 |
aduvel(i,j,k,bi,bj) = aduvel(i,j,k,bi,bj)+adpf(i,j)*((1.- |
2087 |
$implicdiv2dflow)*xa(i,j)/deltatmom) |
2088 |
adpf(i,j) = 0.d0 |
2089 |
end do |
2090 |
end do |
2091 |
endif |
2092 |
|
2093 |
end |
2094 |
|
2095 |
|
2096 |
subroutine adcalc_grad_phi_surf( bi, bj, imin, imax, jmin, jmax, |
2097 |
$adetafld, adphisurfx, adphisurfy ) |
2098 |
C*************************************************************** |
2099 |
C*************************************************************** |
2100 |
C** This routine was generated by the ** |
2101 |
C** Tangent linear and Adjoint Model Compiler, TAMC 5.2.14 ** |
2102 |
C*************************************************************** |
2103 |
C*************************************************************** |
2104 |
C============================================== |
2105 |
C all entries are defined explicitly |
2106 |
C============================================== |
2107 |
implicit none |
2108 |
|
2109 |
C============================================== |
2110 |
C define parameters |
2111 |
C============================================== |
2112 |
integer nr |
2113 |
parameter ( nr = 15 ) |
2114 |
integer nsx |
2115 |
parameter ( nsx = 1 ) |
2116 |
integer nsy |
2117 |
parameter ( nsy = 1 ) |
2118 |
integer olx |
2119 |
parameter ( olx = 3 ) |
2120 |
integer oly |
2121 |
parameter ( oly = 3 ) |
2122 |
integer snx |
2123 |
parameter ( snx = 20 ) |
2124 |
integer sny |
2125 |
parameter ( sny = 40 ) |
2126 |
|
2127 |
C============================================== |
2128 |
C define common blocks |
2129 |
C============================================== |
2130 |
common /grid_r/ dxc, dxf, dxg, dxv, dyc, dyf, dyg, dyu, drc, drf, |
2131 |
$h, hfacc, hfacw, hfacs, depthink, recip_dxc, recip_dxf, recip_dxg, |
2132 |
$ recip_dxv, recip_dyc, recip_dyf, recip_dyg, recip_dyu, recip_drc, |
2133 |
$ recip_drf, recip_h, recip_hfacc, recip_hfacw, recip_hfacs, rkfac, |
2134 |
$ recip_rkfac, safac, xc, yc, ra, raw, ras, raz, rc, rf, yc0, xc0, |
2135 |
$xg, yg, maskw, masks, recip_ra, recip_raw, recip_ras, recip_raz, |
2136 |
$tanphiatu, tanphiatv |
2137 |
double precision depthink(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
2138 |
double precision drc(1:nr) |
2139 |
double precision drf(1:nr) |
2140 |
double precision dxc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
2141 |
double precision dxf(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
2142 |
double precision dxg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
2143 |
double precision dxv(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
2144 |
double precision dyc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
2145 |
double precision dyf(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
2146 |
double precision dyg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
2147 |
double precision dyu(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
2148 |
double precision h(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
2149 |
double precision hfacc(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) |
2150 |
double precision hfacs(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) |
2151 |
double precision hfacw(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) |
2152 |
double precision masks(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) |
2153 |
double precision maskw(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) |
2154 |
double precision ra(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
2155 |
double precision ras(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
2156 |
double precision raw(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
2157 |
double precision raz(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
2158 |
double precision rc(1:nr) |
2159 |
double precision recip_drc(1:nr) |
2160 |
double precision recip_drf(1:nr) |
2161 |
double precision recip_dxc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
2162 |
double precision recip_dxf(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
2163 |
double precision recip_dxg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
2164 |
double precision recip_dxv(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
2165 |
double precision recip_dyc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
2166 |
double precision recip_dyf(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
2167 |
double precision recip_dyg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
2168 |
double precision recip_dyu(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
2169 |
double precision recip_h(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
2170 |
double precision recip_hfacc(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx, |
2171 |
$nsy) |
2172 |
double precision recip_hfacs(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx, |
2173 |
$nsy) |
2174 |
double precision recip_hfacw(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx, |
2175 |
$nsy) |
2176 |
double precision recip_ra(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
2177 |
double precision recip_ras(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
2178 |
double precision recip_raw(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
2179 |
double precision recip_raz(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
2180 |
double precision recip_rkfac |
2181 |
double precision rf(1:nr+1) |
2182 |
double precision rkfac |
2183 |
double precision safac(1:nr) |
2184 |
double precision tanphiatu(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
2185 |
double precision tanphiatv(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
2186 |
double precision xc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
2187 |
double precision xc0 |
2188 |
double precision xg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
2189 |
double precision yc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
2190 |
double precision yc0 |
2191 |
double precision yg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
2192 |
|
2193 |
common /solve_barot/ bo_surf, recip_bo |
2194 |
double precision bo_surf(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
2195 |
double precision recip_bo(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
2196 |
|
2197 |
C============================================== |
2198 |
C define arguments |
2199 |
C============================================== |
2200 |
double precision adetafld(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
2201 |
double precision adphisurfx(1-olx:snx+olx,1-oly:sny+oly) |
2202 |
double precision adphisurfy(1-olx:snx+olx,1-oly:sny+oly) |
2203 |
integer bi |
2204 |
integer bj |
2205 |
integer imax |
2206 |
integer imin |
2207 |
integer jmax |
2208 |
integer jmin |
2209 |
|
2210 |
C============================================== |
2211 |
C define local variables |
2212 |
C============================================== |
2213 |
integer i |
2214 |
integer j |
2215 |
|
2216 |
C---------------------------------------------- |
2217 |
C ROUTINE BODY |
2218 |
C---------------------------------------------- |
2219 |
do j = jmin, jmax |
2220 |
do i = imin, imax |
2221 |
adetafld(i,j-1,bi,bj) = adetafld(i,j-1,bi,bj)-adphisurfy(i,j)* |
2222 |
$recip_dyc(i,j,bi,bj)*bo_surf(i,j-1,bi,bj) |
2223 |
adetafld(i,j,bi,bj) = adetafld(i,j,bi,bj)+adphisurfy(i,j)* |
2224 |
$recip_dyc(i,j,bi,bj)*bo_surf(i,j,bi,bj) |
2225 |
adphisurfy(i,j) = 0.d0 |
2226 |
end do |
2227 |
end do |
2228 |
do j = jmin, jmax |
2229 |
do i = imin, imax |
2230 |
adetafld(i-1,j,bi,bj) = adetafld(i-1,j,bi,bj)-adphisurfx(i,j)* |
2231 |
$recip_dxc(i,j,bi,bj)*bo_surf(i-1,j,bi,bj) |
2232 |
adetafld(i,j,bi,bj) = adetafld(i,j,bi,bj)+adphisurfx(i,j)* |
2233 |
$recip_dxc(i,j,bi,bj)*bo_surf(i,j,bi,bj) |
2234 |
adphisurfx(i,j) = 0.d0 |
2235 |
end do |
2236 |
end do |
2237 |
|
2238 |
end |
2239 |
|
2240 |
|
2241 |
subroutine adcalc_gs( bi, bj, imin, imax, jmin, jmax, k, km1, kup, |
2242 |
$ kdown, xa, ya, utrans, vtrans, rtrans, maskup, maskc, kappars, |
2243 |
$adutrans, advtrans, adrtrans, adkappars, adfvers ) |
2244 |
C*************************************************************** |
2245 |
C*************************************************************** |
2246 |
C** This routine was generated by the ** |
2247 |
C** Tangent linear and Adjoint Model Compiler, TAMC 5.2.14 ** |
2248 |
C*************************************************************** |
2249 |
C*************************************************************** |
2250 |
C============================================== |
2251 |
C all entries are defined explicitly |
2252 |
C============================================== |
2253 |
implicit none |
2254 |
|
2255 |
C============================================== |
2256 |
C define parameters |
2257 |
C============================================== |
2258 |
integer npx |
2259 |
parameter ( npx = 1 ) |
2260 |
integer npy |
2261 |
parameter ( npy = 1 ) |
2262 |
integer nr |
2263 |
parameter ( nr = 15 ) |
2264 |
integer nsx |
2265 |
parameter ( nsx = 1 ) |
2266 |
integer nsy |
2267 |
parameter ( nsy = 1 ) |
2268 |
integer snx |
2269 |
parameter ( snx = 20 ) |
2270 |
integer nx |
2271 |
parameter ( nx = snx*nsx*npx ) |
2272 |
integer sny |
2273 |
parameter ( sny = 40 ) |
2274 |
integer ny |
2275 |
parameter ( ny = sny*nsy*npy ) |
2276 |
integer olx |
2277 |
parameter ( olx = 3 ) |
2278 |
integer oly |
2279 |
parameter ( oly = 3 ) |
2280 |
|
2281 |
C============================================== |
2282 |
C define common blocks |
2283 |
C============================================== |
2284 |
common /addynvars_r/ adetan, aduvel, advvel, adwvel, adtheta, |
2285 |
$adsalt, adgu, adgv, adgt, adgs, adgunm1, adgvnm1, adgtnm1, adgsnm1 |
2286 |
double precision adetan(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
2287 |
double precision adgs(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
2288 |
double precision adgsnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
2289 |
double precision adgt(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
2290 |
double precision adgtnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
2291 |
double precision adgu(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
2292 |
double precision adgunm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
2293 |
double precision adgv(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
2294 |
double precision adgvnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
2295 |
double precision adsalt(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
2296 |
double precision adtheta(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
2297 |
double precision aduvel(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
2298 |
double precision advvel(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
2299 |
double precision adwvel(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
2300 |
|
2301 |
common /dynvars_r/ etan, uvel, vvel, wvel, theta, salt, gu, gv, |
2302 |
$gt, gs, gunm1, gvnm1, gtnm1, gsnm1 |
2303 |
double precision etan(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
2304 |
double precision gs(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
2305 |
double precision gsnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
2306 |
double precision gt(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
2307 |
double precision gtnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
2308 |
double precision gu(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
2309 |
double precision gunm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
2310 |
double precision gv(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
2311 |
double precision gvnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
2312 |
double precision salt(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
2313 |
double precision theta(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
2314 |
double precision uvel(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
2315 |
double precision vvel(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
2316 |
double precision wvel(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
2317 |
|
2318 |
common /grid_r/ dxc, dxf, dxg, dxv, dyc, dyf, dyg, dyu, drc, drf, |
2319 |
$h, hfacc, hfacw, hfacs, depthink, recip_dxc, recip_dxf, recip_dxg, |
2320 |
$ recip_dxv, recip_dyc, recip_dyf, recip_dyg, recip_dyu, recip_drc, |
2321 |
$ recip_drf, recip_h, recip_hfacc, recip_hfacw, recip_hfacs, rkfac, |
2322 |
$ recip_rkfac, safac, xc, yc, ra, raw, ras, raz, rc, rf, yc0, xc0, |
2323 |
$xg, yg, maskw, masks, recip_ra, recip_raw, recip_ras, recip_raz, |
2324 |
$tanphiatu, tanphiatv |
2325 |
double precision depthink(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
2326 |
double precision drc(1:nr) |
2327 |
double precision drf(1:nr) |
2328 |
double precision dxc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
2329 |
double precision dxf(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
2330 |
double precision dxg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
2331 |
double precision dxv(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
2332 |
double precision dyc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
2333 |
double precision dyf(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
2334 |
double precision dyg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
2335 |
double precision dyu(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
2336 |
double precision h(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
2337 |
double precision hfacc(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) |
2338 |
double precision hfacs(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) |
2339 |
double precision hfacw(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) |
2340 |
double precision masks(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) |
2341 |
double precision maskw(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) |
2342 |
double precision ra(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
2343 |
double precision ras(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
2344 |
double precision raw(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
2345 |
double precision raz(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
2346 |
double precision rc(1:nr) |
2347 |
double precision recip_drc(1:nr) |
2348 |
double precision recip_drf(1:nr) |
2349 |
double precision recip_dxc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
2350 |
double precision recip_dxf(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
2351 |
double precision recip_dxg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
2352 |
double precision recip_dxv(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
2353 |
double precision recip_dyc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
2354 |
double precision recip_dyf(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
2355 |
double precision recip_dyg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
2356 |
double precision recip_dyu(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
2357 |
double precision recip_h(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
2358 |
double precision recip_hfacc(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx, |
2359 |
$nsy) |
2360 |
double precision recip_hfacs(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx, |
2361 |
$nsy) |
2362 |
double precision recip_hfacw(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx, |
2363 |
$nsy) |
2364 |
double precision recip_ra(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
2365 |
double precision recip_ras(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
2366 |
double precision recip_raw(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
2367 |
double precision recip_raz(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
2368 |
double precision recip_rkfac |
2369 |
double precision rf(1:nr+1) |
2370 |
double precision rkfac |
2371 |
double precision safac(1:nr) |
2372 |
double precision tanphiatu(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
2373 |
double precision tanphiatv(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
2374 |
double precision xc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
2375 |
double precision xc0 |
2376 |
double precision xg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
2377 |
double precision yc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
2378 |
double precision yc0 |
2379 |
double precision yg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
2380 |
|
2381 |
common /parm_l/ usingcartesiangrid, usingsphericalpolargrid, |
2382 |
$no_slip_sides, no_slip_bottom, staggertimestep, momviscosity, |
2383 |
$momadvection, momforcing, usecoriolis, mompressureforcing, |
2384 |
$tempdiffusion, tempadvection, tempforcing, saltdiffusion, |
2385 |
$saltadvection, saltforcing, implicitfreesurface, rigidlid, |
2386 |
$momstepping, tempstepping, saltstepping, metricterms, |
2387 |
$usingsphericalpolarmterms, useconstantf, usebetaplanef, |
2388 |
$usespheref, implicitdiffusion, implicitviscosity, |
2389 |
$dothetaclimrelax, dosaltclimrelax, periodicexternalforcing, |
2390 |
$usingpcoords, usingzcoords, nonhydrostatic, globalfiles, |
2391 |
$allowfreezing, groundatk1, usepickupbeforec35 |
2392 |
logical allowfreezing |
2393 |
logical dosaltclimrelax |
2394 |
logical dothetaclimrelax |
2395 |
logical globalfiles |
2396 |
logical groundatk1 |
2397 |
logical implicitdiffusion |
2398 |
logical implicitfreesurface |
2399 |
logical implicitviscosity |
2400 |
logical metricterms |
2401 |
logical momadvection |
2402 |
logical momforcing |
2403 |
logical mompressureforcing |
2404 |
logical momstepping |
2405 |
logical momviscosity |
2406 |
logical no_slip_bottom |
2407 |
logical no_slip_sides |
2408 |
logical nonhydrostatic |
2409 |
logical periodicexternalforcing |
2410 |
logical rigidlid |
2411 |
logical saltadvection |
2412 |
logical saltdiffusion |
2413 |
logical saltforcing |
2414 |
logical saltstepping |
2415 |
logical staggertimestep |
2416 |
logical tempadvection |
2417 |
logical tempdiffusion |
2418 |
logical tempforcing |
2419 |
logical tempstepping |
2420 |
logical usebetaplanef |
2421 |
logical useconstantf |
2422 |
logical usecoriolis |
2423 |
logical usepickupbeforec35 |
2424 |
logical usespheref |
2425 |
logical usingcartesiangrid |
2426 |
logical usingpcoords |
2427 |
logical usingsphericalpolargrid |
2428 |
logical usingsphericalpolarmterms |
2429 |
logical usingzcoords |
2430 |
|
2431 |
common /parm_packages/ usekpp, usegmredi, useobcs, useaim, useecco |
2432 |
logical useaim |
2433 |
logical useecco |
2434 |
logical usegmredi |
2435 |
logical usekpp |
2436 |
logical useobcs |
2437 |
|
2438 |
common /parm_r/ cg2dtargetresidual, cg2dpcoffdfac, |
2439 |
$cg3dtargetresidual, delp, delz, delr, delx, dely, deltat, |
2440 |
$deltatmom, deltattracer, deltatclock, abeps, starttime, phimin, |
2441 |
$thetamin, rsphere, recip_rsphere, f0, fcori, beta, viscah, viscaz, |
2442 |
$ visca4, viscar, diffkht, diffkzt, diffk4t, diffkrt, diffkhs, |
2443 |
$diffkzs, diffk4s, diffkrs, delt, taucd, rcd, freesurffac, |
2444 |
$implicsurfpress, implicdiv2dflow, hfacmin, hfacmindz, gravity, |
2445 |
$recip_gravity, gbaro, rhonil, recip_rhonil, recip_rhoconst, |
2446 |
$rhoconst, tref, sref, endtime, chkptfreq, pchkptfreq, dumpfreq, |
2447 |
$tavefreq, affacmom, vffacmom, pffacmom, cffacmom, fofacmom, |
2448 |
$mtfacmom, cospower, cadjfreq, omega, tauthetaclimrelax, |
2449 |
$lambdathetaclimrelax, tausaltclimrelax, lambdasaltclimrelax, |
2450 |
$externforcingcycle, externforcingperiod, viscap, diffkpt, diffkps, |
2451 |
$ hfacmindr, hfacmindp, theta_s, specvol_s, horivertratio, |
2452 |
$recip_horivertratio, latfftfiltlo, ivdc_kappa, ro_sealevel, |
2453 |
$zonal_filt_lat, bottomdraglinear, bottomdragquadratic |
2454 |
double precision abeps |
2455 |
double precision affacmom |
2456 |
double precision beta |
2457 |
double precision bottomdraglinear |
2458 |
double precision bottomdragquadratic |
2459 |
double precision cadjfreq |
2460 |
double precision cffacmom |
2461 |
double precision cg2dpcoffdfac |
2462 |
double precision cg2dtargetresidual |
2463 |
double precision cg3dtargetresidual |
2464 |
double precision chkptfreq |
2465 |
double precision cospower |
2466 |
double precision delp(nr) |
2467 |
double precision delr(nr) |
2468 |
double precision delt |
2469 |
double precision deltat |
2470 |
double precision deltatclock |
2471 |
double precision deltatmom |
2472 |
double precision deltattracer |
2473 |
double precision delx(nx) |
2474 |
double precision dely(ny) |
2475 |
double precision delz(nr) |
2476 |
double precision diffk4s |
2477 |
double precision diffk4t |
2478 |
double precision diffkhs |
2479 |
double precision diffkht |
2480 |
double precision diffkps |
2481 |
double precision diffkpt |
2482 |
double precision diffkrs |
2483 |
double precision diffkrt |
2484 |
double precision diffkzs |
2485 |
double precision diffkzt |
2486 |
double precision dumpfreq |
2487 |
double precision endtime |
2488 |
double precision externforcingcycle |
2489 |
double precision externforcingperiod |
2490 |
double precision f0 |
2491 |
double precision fcori(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
2492 |
double precision fofacmom |
2493 |
double precision freesurffac |
2494 |
double precision gbaro |
2495 |
double precision gravity |
2496 |
double precision hfacmin |
2497 |
double precision hfacmindp |
2498 |
double precision hfacmindr |
2499 |
double precision hfacmindz |
2500 |
double precision horivertratio |
2501 |
double precision implicdiv2dflow |
2502 |
double precision implicsurfpress |
2503 |
double precision ivdc_kappa |
2504 |
double precision lambdasaltclimrelax |
2505 |
double precision lambdathetaclimrelax |
2506 |
double precision latfftfiltlo |
2507 |
double precision mtfacmom |
2508 |
double precision omega |
2509 |
double precision pchkptfreq |
2510 |
double precision pffacmom |
2511 |
double precision phimin |
2512 |
double precision rcd |
2513 |
double precision recip_gravity |
2514 |
double precision recip_horivertratio |
2515 |
double precision recip_rhoconst |
2516 |
double precision recip_rhonil |
2517 |
double precision recip_rsphere |
2518 |
double precision rhoconst |
2519 |
double precision rhonil |
2520 |
double precision ro_sealevel |
2521 |
double precision rsphere |
2522 |
double precision specvol_s(nr) |
2523 |
double precision sref(nr) |
2524 |
double precision starttime |
2525 |
double precision taucd |
2526 |
double precision tausaltclimrelax |
2527 |
double precision tauthetaclimrelax |
2528 |
double precision tavefreq |
2529 |
double precision theta_s(nr) |
2530 |
double precision thetamin |
2531 |
double precision tref(nr) |
2532 |
double precision vffacmom |
2533 |
double precision visca4 |
2534 |
double precision viscah |
2535 |
double precision viscap |
2536 |
double precision viscar |
2537 |
double precision viscaz |
2538 |
double precision zonal_filt_lat |
2539 |
|
2540 |
C============================================== |
2541 |
C define arguments |
2542 |
C============================================== |
2543 |
double precision adfvers(1-olx:snx+olx,1-oly:sny+oly,2) |
2544 |
double precision adkappars(1-olx:snx+olx,1-oly:sny+oly,nr) |
2545 |
double precision adrtrans(1-olx:snx+olx,1-oly:sny+oly) |
2546 |
double precision adutrans(1-olx:snx+olx,1-oly:sny+oly) |
2547 |
double precision advtrans(1-olx:snx+olx,1-oly:sny+oly) |
2548 |
integer bi |
2549 |
integer bj |
2550 |
integer imax |
2551 |
integer imin |
2552 |
integer jmax |
2553 |
integer jmin |
2554 |
integer k |
2555 |
double precision kappars(1-olx:snx+olx,1-oly:sny+oly,nr) |
2556 |
integer kdown |
2557 |
integer km1 |
2558 |
integer kup |
2559 |
double precision maskc(1-olx:snx+olx,1-oly:sny+oly) |
2560 |
double precision maskup(1-olx:snx+olx,1-oly:sny+oly) |
2561 |
double precision rtrans(1-olx:snx+olx,1-oly:sny+oly) |
2562 |
double precision utrans(1-olx:snx+olx,1-oly:sny+oly) |
2563 |
double precision vtrans(1-olx:snx+olx,1-oly:sny+oly) |
2564 |
double precision xa(1-olx:snx+olx,1-oly:sny+oly) |
2565 |
double precision ya(1-olx:snx+olx,1-oly:sny+oly) |
2566 |
|
2567 |
C============================================== |
2568 |
C define local variables |
2569 |
C============================================== |
2570 |
double precision adaf(1-olx:snx+olx,1-oly:sny+oly) |
2571 |
double precision addf(1-olx:snx+olx,1-oly:sny+oly) |
2572 |
double precision addf4(1-olx:snx+olx,1-oly:sny+oly) |
2573 |
double precision addsdx(1-olx:snx+olx,1-oly:sny+oly) |
2574 |
double precision addsdy(1-olx:snx+olx,1-oly:sny+oly) |
2575 |
double precision adfmer(1-olx:snx+olx,1-oly:sny+oly) |
2576 |
double precision adfzon(1-olx:snx+olx,1-oly:sny+oly) |
2577 |
double precision affacs |
2578 |
double precision dffacs |
2579 |
integer i |
2580 |
integer ip1 |
2581 |
integer ip2 |
2582 |
integer j |
2583 |
logical top_layer |
2584 |
|
2585 |
C---------------------------------------------- |
2586 |
C RESET LOCAL ADJOINT VARIABLES |
2587 |
C---------------------------------------------- |
2588 |
do ip2 = 1-oly, sny+oly |
2589 |
do ip1 = 1-olx, snx+olx |
2590 |
adaf(ip1,ip2) = 0.d0 |
2591 |
end do |
2592 |
end do |
2593 |
do ip2 = 1-oly, sny+oly |
2594 |
do ip1 = 1-olx, snx+olx |
2595 |
addf(ip1,ip2) = 0.d0 |
2596 |
end do |
2597 |
end do |
2598 |
do ip2 = 1-oly, sny+oly |
2599 |
do ip1 = 1-olx, snx+olx |
2600 |
addf4(ip1,ip2) = 0.d0 |
2601 |
end do |
2602 |
end do |
2603 |
do ip2 = 1-oly, sny+oly |
2604 |
do ip1 = 1-olx, snx+olx |
2605 |
addsdx(ip1,ip2) = 0.d0 |
2606 |
end do |
2607 |
end do |
2608 |
do ip2 = 1-oly, sny+oly |
2609 |
do ip1 = 1-olx, snx+olx |
2610 |
addsdy(ip1,ip2) = 0.d0 |
2611 |
end do |
2612 |
end do |
2613 |
do ip2 = 1-oly, sny+oly |
2614 |
do ip1 = 1-olx, snx+olx |
2615 |
adfmer(ip1,ip2) = 0.d0 |
2616 |
end do |
2617 |
end do |
2618 |
do ip2 = 1-oly, sny+oly |
2619 |
do ip1 = 1-olx, snx+olx |
2620 |
adfzon(ip1,ip2) = 0.d0 |
2621 |
end do |
2622 |
end do |
2623 |
|
2624 |
C---------------------------------------------- |
2625 |
C ROUTINE BODY |
2626 |
C---------------------------------------------- |
2627 |
affacs = 1.d0 |
2628 |
dffacs = 1.d0 |
2629 |
top_layer = k .eq. 1 |
2630 |
call adexternal_forcing_s( imin,imax,jmin,jmax,bi,bj,k,maskc ) |
2631 |
do j = jmin, jmax-1 |
2632 |
do i = imin, imax-1 |
2633 |
adfmer(i,j+1) = adfmer(i,j+1)-adgs(i,j,k,bi,bj)* |
2634 |
$(recip_hfacc(i,j,k,bi,bj)*recip_drf(k)/ra(i,j,bi,bj)) |
2635 |
adfmer(i,j) = adfmer(i,j)+adgs(i,j,k,bi,bj)*(recip_hfacc(i,j, |
2636 |
$k,bi,bj)*recip_drf(k)/ra(i,j,bi,bj)) |
2637 |
adfvers(i,j,kdown) = adfvers(i,j,kdown)+adgs(i,j,k,bi,bj)* |
2638 |
$recip_hfacc(i,j,k,bi,bj)*recip_drf(k)/ra(i,j,bi,bj)*rkfac |
2639 |
adfvers(i,j,kup) = adfvers(i,j,kup)-adgs(i,j,k,bi,bj)* |
2640 |
$recip_hfacc(i,j,k,bi,bj)*recip_drf(k)/ra(i,j,bi,bj)*rkfac |
2641 |
adfzon(i+1,j) = adfzon(i+1,j)-adgs(i,j,k,bi,bj)* |
2642 |
$(recip_hfacc(i,j,k,bi,bj)*recip_drf(k)/ra(i,j,bi,bj)) |
2643 |
adfzon(i,j) = adfzon(i,j)+adgs(i,j,k,bi,bj)*(recip_hfacc(i,j, |
2644 |
$k,bi,bj)*recip_drf(k)/ra(i,j,bi,bj)) |
2645 |
adgs(i,j,k,bi,bj) = 0.d0 |
2646 |
end do |
2647 |
end do |
2648 |
if (top_layer) then |
2649 |
do j = jmin, jmax |
2650 |
do i = imin, imax |
2651 |
adaf(i,j) = adaf(i,j)+adfvers(i,j,kup)*affacs*freesurffac |
2652 |
adfvers(i,j,kup) = 0.d0 |
2653 |
end do |
2654 |
end do |
2655 |
endif |
2656 |
do j = jmin, jmax |
2657 |
do i = imin, imax |
2658 |
adaf(i,j) = adaf(i,j)+adfvers(i,j,kup)*affacs*maskup(i,j) |
2659 |
addf(i,j) = addf(i,j)+adfvers(i,j,kup)*dffacs*maskup(i,j) |
2660 |
adfvers(i,j,kup) = 0.d0 |
2661 |
end do |
2662 |
end do |
2663 |
if (usekpp) then |
2664 |
call adkpp_transport_s( imin,imax,jmin,jmax,bi,bj,k,km1,maskc, |
2665 |
$kappars,adkappars,addf ) |
2666 |
endif |
2667 |
if (usegmredi) then |
2668 |
call adgmredi_rtransport( imin,imax,jmin,jmax,bi,bj,k,salt, |
2669 |
$adsalt,addf ) |
2670 |
endif |
2671 |
if (implicitdiffusion) then |
2672 |
do j = jmin, jmax |
2673 |
do i = imin, imax |
2674 |
addf(i,j) = 0.d0 |
2675 |
end do |
2676 |
end do |
2677 |
else |
2678 |
do j = jmin, jmax |
2679 |
do i = imin, imax |
2680 |
adkappars(i,j,k) = adkappars(i,j,k)-addf(i,j)*ra(i,j,bi,bj)* |
2681 |
$recip_drc(k)*(salt(i,j,km1,bi,bj)-salt(i,j,k,bi,bj))*rkfac |
2682 |
adsalt(i,j,k,bi,bj) = adsalt(i,j,k,bi,bj)+addf(i,j)*ra(i,j, |
2683 |
$bi,bj)*kappars(i,j,k)*recip_drc(k)*rkfac |
2684 |
adsalt(i,j,km1,bi,bj) = adsalt(i,j,km1,bi,bj)-addf(i,j)* |
2685 |
$ra(i,j,bi,bj)*kappars(i,j,k)*recip_drc(k)*rkfac |
2686 |
addf(i,j) = 0.d0 |
2687 |
end do |
2688 |
end do |
2689 |
endif |
2690 |
do j = jmin, jmax |
2691 |
do i = imin, imax |
2692 |
adrtrans(i,j) = adrtrans(i,j)+0.5d0*adaf(i,j)*(salt(i,j,k,bi, |
2693 |
$bj)+salt(i,j,km1,bi,bj)) |
2694 |
adsalt(i,j,k,bi,bj) = adsalt(i,j,k,bi,bj)+0.5d0*adaf(i,j)* |
2695 |
$rtrans(i,j) |
2696 |
adsalt(i,j,km1,bi,bj) = adsalt(i,j,km1,bi,bj)+0.5d0*adaf(i,j)* |
2697 |
$rtrans(i,j) |
2698 |
adaf(i,j) = 0.d0 |
2699 |
end do |
2700 |
end do |
2701 |
do j = jmin, jmax |
2702 |
do i = imin, imax |
2703 |
adaf(i,j) = adaf(i,j)+adfmer(i,j)*affacs |
2704 |
addf(i,j) = addf(i,j)+adfmer(i,j)*dffacs |
2705 |
adfmer(i,j) = 0.d0 |
2706 |
end do |
2707 |
end do |
2708 |
if (diffk4s .ne. 0.) then |
2709 |
do j = jmin, jmax |
2710 |
do i = imin, imax |
2711 |
addf4(i,j-1) = addf4(i,j-1)-addf(i,j)*ya(i,j)*diffk4s* |
2712 |
$recip_dyc(i,j,bi,bj) |
2713 |
addf4(i,j) = addf4(i,j)+addf(i,j)*ya(i,j)*diffk4s* |
2714 |
$recip_dyc(i,j,bi,bj) |
2715 |
end do |
2716 |
end do |
2717 |
endif |
2718 |
if (usegmredi) then |
2719 |
call adgmredi_ytransport( imin,imax,jmin,jmax,bi,bj,k,ya,adsalt, |
2720 |
$addf ) |
2721 |
endif |
2722 |
do j = jmin, jmax |
2723 |
do i = imin, imax |
2724 |
addsdy(i,j) = addsdy(i,j)-addf(i,j)*diffkhs*ya(i,j) |
2725 |
addf(i,j) = 0.d0 |
2726 |
end do |
2727 |
end do |
2728 |
do j = jmin, jmax |
2729 |
do i = imin, imax |
2730 |
adsalt(i,j-1,k,bi,bj) = adsalt(i,j-1,k,bi,bj)+0.5d0*adaf(i,j)* |
2731 |
$vtrans(i,j) |
2732 |
adsalt(i,j,k,bi,bj) = adsalt(i,j,k,bi,bj)+0.5d0*adaf(i,j)* |
2733 |
$vtrans(i,j) |
2734 |
advtrans(i,j) = advtrans(i,j)+0.5d0*adaf(i,j)*(salt(i,j,k,bi, |
2735 |
$bj)+salt(i,j-1,k,bi,bj)) |
2736 |
adaf(i,j) = 0.d0 |
2737 |
end do |
2738 |
end do |
2739 |
do j = jmin, jmax |
2740 |
do i = imin, imax |
2741 |
adaf(i,j) = adaf(i,j)+adfzon(i,j)*affacs |
2742 |
addf(i,j) = addf(i,j)+adfzon(i,j)*dffacs |
2743 |
adfzon(i,j) = 0.d0 |
2744 |
end do |
2745 |
end do |
2746 |
if (diffk4s .ne. 0.) then |
2747 |
do j = jmin, jmax |
2748 |
do i = imin, imax |
2749 |
addf4(i-1,j) = addf4(i-1,j)-addf(i,j)*xa(i,j)*diffk4s* |
2750 |
$recip_dxc(i,j,bi,bj) |
2751 |
addf4(i,j) = addf4(i,j)+addf(i,j)*xa(i,j)*diffk4s* |
2752 |
$recip_dxc(i,j,bi,bj) |
2753 |
end do |
2754 |
end do |
2755 |
endif |
2756 |
if (usegmredi) then |
2757 |
call adgmredi_xtransport( imin,imax,jmin,jmax,bi,bj,k,xa,adsalt, |
2758 |
$addf ) |
2759 |
endif |
2760 |
do j = jmin, jmax |
2761 |
do i = imin, imax |
2762 |
addsdx(i,j) = addsdx(i,j)-addf(i,j)*diffkhs*xa(i,j) |
2763 |
addf(i,j) = 0.d0 |
2764 |
end do |
2765 |
end do |
2766 |
do j = jmin, jmax |
2767 |
do i = imin, imax |
2768 |
adsalt(i-1,j,k,bi,bj) = adsalt(i-1,j,k,bi,bj)+0.5d0*adaf(i,j)* |
2769 |
$utrans(i,j) |
2770 |
adsalt(i,j,k,bi,bj) = adsalt(i,j,k,bi,bj)+0.5d0*adaf(i,j)* |
2771 |
$utrans(i,j) |
2772 |
adutrans(i,j) = adutrans(i,j)+0.5d0*adaf(i,j)*(salt(i,j,k,bi, |
2773 |
$bj)+salt(i-1,j,k,bi,bj)) |
2774 |
adaf(i,j) = 0.d0 |
2775 |
end do |
2776 |
end do |
2777 |
if (diffk4s .ne. 0.) then |
2778 |
do j = 1-oly+1, sny+oly-1 |
2779 |
do i = 1-olx+1, snx+olx-1 |
2780 |
addsdx(i+1,j) = addsdx(i+1,j)+addf4(i,j)*recip_hfacc(i,j,k, |
2781 |
$bi,bj)*recip_drf(k)/ra(i,j,bi,bj)*xa(i+1,j) |
2782 |
addsdx(i,j) = addsdx(i,j)-addf4(i,j)*recip_hfacc(i,j,k,bi, |
2783 |
$bj)*recip_drf(k)/ra(i,j,bi,bj)*xa(i,j) |
2784 |
addsdy(i,j+1) = addsdy(i,j+1)+addf4(i,j)*recip_hfacc(i,j,k, |
2785 |
$bi,bj)*recip_drf(k)/ra(i,j,bi,bj)*ya(i,j+1) |
2786 |
addsdy(i,j) = addsdy(i,j)-addf4(i,j)*recip_hfacc(i,j,k,bi, |
2787 |
$bj)*recip_drf(k)/ra(i,j,bi,bj)*ya(i,j) |
2788 |
addf4(i,j) = 0.d0 |
2789 |
end do |
2790 |
end do |
2791 |
endif |
2792 |
do j = 1-oly+1, sny+oly |
2793 |
do i = 1-olx, snx+olx |
2794 |
adsalt(i,j-1,k,bi,bj) = adsalt(i,j-1,k,bi,bj)-addsdy(i,j)* |
2795 |
$recip_dyc(i,j,bi,bj) |
2796 |
adsalt(i,j,k,bi,bj) = adsalt(i,j,k,bi,bj)+addsdy(i,j)* |
2797 |
$recip_dyc(i,j,bi,bj) |
2798 |
addsdy(i,j) = 0.d0 |
2799 |
end do |
2800 |
end do |
2801 |
do j = 1-oly, sny+oly |
2802 |
do i = 1-olx+1, snx+olx |
2803 |
adsalt(i-1,j,k,bi,bj) = adsalt(i-1,j,k,bi,bj)-addsdx(i,j)* |
2804 |
$recip_dxc(i,j,bi,bj) |
2805 |
adsalt(i,j,k,bi,bj) = adsalt(i,j,k,bi,bj)+addsdx(i,j)* |
2806 |
$recip_dxc(i,j,bi,bj) |
2807 |
addsdx(i,j) = 0.d0 |
2808 |
end do |
2809 |
end do |
2810 |
do j = 1-oly, sny+oly |
2811 |
do i = 1-olx, snx+olx |
2812 |
adfvers(i,j,kup) = 0.d0 |
2813 |
end do |
2814 |
end do |
2815 |
|
2816 |
end |
2817 |
|
2818 |
|
2819 |
subroutine adcalc_gt( bi, bj, imin, imax, jmin, jmax, k, km1, kup, |
2820 |
$ kdown, xa, ya, utrans, vtrans, rtrans, maskup, maskc, kappart, |
2821 |
$adutrans, advtrans, adrtrans, adkappart, adfvert ) |
2822 |
C*************************************************************** |
2823 |
C*************************************************************** |
2824 |
C** This routine was generated by the ** |
2825 |
C** Tangent linear and Adjoint Model Compiler, TAMC 5.2.14 ** |
2826 |
C*************************************************************** |
2827 |
C*************************************************************** |
2828 |
C============================================== |
2829 |
C all entries are defined explicitly |
2830 |
C============================================== |
2831 |
implicit none |
2832 |
|
2833 |
C============================================== |
2834 |
C define parameters |
2835 |
C============================================== |
2836 |
integer npx |
2837 |
parameter ( npx = 1 ) |
2838 |
integer npy |
2839 |
parameter ( npy = 1 ) |
2840 |
integer nr |
2841 |
parameter ( nr = 15 ) |
2842 |
integer nsx |
2843 |
parameter ( nsx = 1 ) |
2844 |
integer nsy |
2845 |
parameter ( nsy = 1 ) |
2846 |
integer snx |
2847 |
parameter ( snx = 20 ) |
2848 |
integer nx |
2849 |
parameter ( nx = snx*nsx*npx ) |
2850 |
integer sny |
2851 |
parameter ( sny = 40 ) |
2852 |
integer ny |
2853 |
parameter ( ny = sny*nsy*npy ) |
2854 |
integer olx |
2855 |
parameter ( olx = 3 ) |
2856 |
integer oly |
2857 |
parameter ( oly = 3 ) |
2858 |
|
2859 |
C============================================== |
2860 |
C define common blocks |
2861 |
C============================================== |
2862 |
common /addynvars_r/ adetan, aduvel, advvel, adwvel, adtheta, |
2863 |
$adsalt, adgu, adgv, adgt, adgs, adgunm1, adgvnm1, adgtnm1, adgsnm1 |
2864 |
double precision adetan(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
2865 |
double precision adgs(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
2866 |
double precision adgsnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
2867 |
double precision adgt(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
2868 |
double precision adgtnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
2869 |
double precision adgu(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
2870 |
double precision adgunm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
2871 |
double precision adgv(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
2872 |
double precision adgvnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
2873 |
double precision adsalt(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
2874 |
double precision adtheta(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
2875 |
double precision aduvel(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
2876 |
double precision advvel(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
2877 |
double precision adwvel(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
2878 |
|
2879 |
common /dynvars_r/ etan, uvel, vvel, wvel, theta, salt, gu, gv, |
2880 |
$gt, gs, gunm1, gvnm1, gtnm1, gsnm1 |
2881 |
double precision etan(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
2882 |
double precision gs(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
2883 |
double precision gsnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
2884 |
double precision gt(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
2885 |
double precision gtnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
2886 |
double precision gu(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
2887 |
double precision gunm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
2888 |
double precision gv(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
2889 |
double precision gvnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
2890 |
double precision salt(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
2891 |
double precision theta(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
2892 |
double precision uvel(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
2893 |
double precision vvel(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
2894 |
double precision wvel(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
2895 |
|
2896 |
common /grid_r/ dxc, dxf, dxg, dxv, dyc, dyf, dyg, dyu, drc, drf, |
2897 |
$h, hfacc, hfacw, hfacs, depthink, recip_dxc, recip_dxf, recip_dxg, |
2898 |
$ recip_dxv, recip_dyc, recip_dyf, recip_dyg, recip_dyu, recip_drc, |
2899 |
$ recip_drf, recip_h, recip_hfacc, recip_hfacw, recip_hfacs, rkfac, |
2900 |
$ recip_rkfac, safac, xc, yc, ra, raw, ras, raz, rc, rf, yc0, xc0, |
2901 |
$xg, yg, maskw, masks, recip_ra, recip_raw, recip_ras, recip_raz, |
2902 |
$tanphiatu, tanphiatv |
2903 |
double precision depthink(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
2904 |
double precision drc(1:nr) |
2905 |
double precision drf(1:nr) |
2906 |
double precision dxc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
2907 |
double precision dxf(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
2908 |
double precision dxg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
2909 |
double precision dxv(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
2910 |
double precision dyc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
2911 |
double precision dyf(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
2912 |
double precision dyg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
2913 |
double precision dyu(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
2914 |
double precision h(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
2915 |
double precision hfacc(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) |
2916 |
double precision hfacs(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) |
2917 |
double precision hfacw(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) |
2918 |
double precision masks(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) |
2919 |
double precision maskw(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) |
2920 |
double precision ra(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
2921 |
double precision ras(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
2922 |
double precision raw(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
2923 |
double precision raz(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
2924 |
double precision rc(1:nr) |
2925 |
double precision recip_drc(1:nr) |
2926 |
double precision recip_drf(1:nr) |
2927 |
double precision recip_dxc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
2928 |
double precision recip_dxf(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
2929 |
double precision recip_dxg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
2930 |
double precision recip_dxv(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
2931 |
double precision recip_dyc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
2932 |
double precision recip_dyf(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
2933 |
double precision recip_dyg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
2934 |
double precision recip_dyu(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
2935 |
double precision recip_h(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
2936 |
double precision recip_hfacc(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx, |
2937 |
$nsy) |
2938 |
double precision recip_hfacs(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx, |
2939 |
$nsy) |
2940 |
double precision recip_hfacw(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx, |
2941 |
$nsy) |
2942 |
double precision recip_ra(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
2943 |
double precision recip_ras(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
2944 |
double precision recip_raw(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
2945 |
double precision recip_raz(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
2946 |
double precision recip_rkfac |
2947 |
double precision rf(1:nr+1) |
2948 |
double precision rkfac |
2949 |
double precision safac(1:nr) |
2950 |
double precision tanphiatu(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
2951 |
double precision tanphiatv(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
2952 |
double precision xc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
2953 |
double precision xc0 |
2954 |
double precision xg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
2955 |
double precision yc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
2956 |
double precision yc0 |
2957 |
double precision yg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
2958 |
|
2959 |
common /parm_l/ usingcartesiangrid, usingsphericalpolargrid, |
2960 |
$no_slip_sides, no_slip_bottom, staggertimestep, momviscosity, |
2961 |
$momadvection, momforcing, usecoriolis, mompressureforcing, |
2962 |
$tempdiffusion, tempadvection, tempforcing, saltdiffusion, |
2963 |
$saltadvection, saltforcing, implicitfreesurface, rigidlid, |
2964 |
$momstepping, tempstepping, saltstepping, metricterms, |
2965 |
$usingsphericalpolarmterms, useconstantf, usebetaplanef, |
2966 |
$usespheref, implicitdiffusion, implicitviscosity, |
2967 |
$dothetaclimrelax, dosaltclimrelax, periodicexternalforcing, |
2968 |
$usingpcoords, usingzcoords, nonhydrostatic, globalfiles, |
2969 |
$allowfreezing, groundatk1, usepickupbeforec35 |
2970 |
logical allowfreezing |
2971 |
logical dosaltclimrelax |
2972 |
logical dothetaclimrelax |
2973 |
logical globalfiles |
2974 |
logical groundatk1 |
2975 |
logical implicitdiffusion |
2976 |
logical implicitfreesurface |
2977 |
logical implicitviscosity |
2978 |
logical metricterms |
2979 |
logical momadvection |
2980 |
logical momforcing |
2981 |
logical mompressureforcing |
2982 |
logical momstepping |
2983 |
logical momviscosity |
2984 |
logical no_slip_bottom |
2985 |
logical no_slip_sides |
2986 |
logical nonhydrostatic |
2987 |
logical periodicexternalforcing |
2988 |
logical rigidlid |
2989 |
logical saltadvection |
2990 |
logical saltdiffusion |
2991 |
logical saltforcing |
2992 |
logical saltstepping |
2993 |
logical staggertimestep |
2994 |
logical tempadvection |
2995 |
logical tempdiffusion |
2996 |
logical tempforcing |
2997 |
logical tempstepping |
2998 |
logical usebetaplanef |
2999 |
logical useconstantf |
3000 |
logical usecoriolis |
3001 |
logical usepickupbeforec35 |
3002 |
logical usespheref |
3003 |
logical usingcartesiangrid |
3004 |
logical usingpcoords |
3005 |
logical usingsphericalpolargrid |
3006 |
logical usingsphericalpolarmterms |
3007 |
logical usingzcoords |
3008 |
|
3009 |
common /parm_packages/ usekpp, usegmredi, useobcs, useaim, useecco |
3010 |
logical useaim |
3011 |
logical useecco |
3012 |
logical usegmredi |
3013 |
logical usekpp |
3014 |
logical useobcs |
3015 |
|
3016 |
common /parm_r/ cg2dtargetresidual, cg2dpcoffdfac, |
3017 |
$cg3dtargetresidual, delp, delz, delr, delx, dely, deltat, |
3018 |
$deltatmom, deltattracer, deltatclock, abeps, starttime, phimin, |
3019 |
$thetamin, rsphere, recip_rsphere, f0, fcori, beta, viscah, viscaz, |
3020 |
$ visca4, viscar, diffkht, diffkzt, diffk4t, diffkrt, diffkhs, |
3021 |
$diffkzs, diffk4s, diffkrs, delt, taucd, rcd, freesurffac, |
3022 |
$implicsurfpress, implicdiv2dflow, hfacmin, hfacmindz, gravity, |
3023 |
$recip_gravity, gbaro, rhonil, recip_rhonil, recip_rhoconst, |
3024 |
$rhoconst, tref, sref, endtime, chkptfreq, pchkptfreq, dumpfreq, |
3025 |
$tavefreq, affacmom, vffacmom, pffacmom, cffacmom, fofacmom, |
3026 |
$mtfacmom, cospower, cadjfreq, omega, tauthetaclimrelax, |
3027 |
$lambdathetaclimrelax, tausaltclimrelax, lambdasaltclimrelax, |
3028 |
$externforcingcycle, externforcingperiod, viscap, diffkpt, diffkps, |
3029 |
$ hfacmindr, hfacmindp, theta_s, specvol_s, horivertratio, |
3030 |
$recip_horivertratio, latfftfiltlo, ivdc_kappa, ro_sealevel, |
3031 |
$zonal_filt_lat, bottomdraglinear, bottomdragquadratic |
3032 |
double precision abeps |
3033 |
double precision affacmom |
3034 |
double precision beta |
3035 |
double precision bottomdraglinear |
3036 |
double precision bottomdragquadratic |
3037 |
double precision cadjfreq |
3038 |
double precision cffacmom |
3039 |
double precision cg2dpcoffdfac |
3040 |
double precision cg2dtargetresidual |
3041 |
double precision cg3dtargetresidual |
3042 |
double precision chkptfreq |
3043 |
double precision cospower |
3044 |
double precision delp(nr) |
3045 |
double precision delr(nr) |
3046 |
double precision delt |
3047 |
double precision deltat |
3048 |
double precision deltatclock |
3049 |
double precision deltatmom |
3050 |
double precision deltattracer |
3051 |
double precision delx(nx) |
3052 |
double precision dely(ny) |
3053 |
double precision delz(nr) |
3054 |
double precision diffk4s |
3055 |
double precision diffk4t |
3056 |
double precision diffkhs |
3057 |
double precision diffkht |
3058 |
double precision diffkps |
3059 |
double precision diffkpt |
3060 |
double precision diffkrs |
3061 |
double precision diffkrt |
3062 |
double precision diffkzs |
3063 |
double precision diffkzt |
3064 |
double precision dumpfreq |
3065 |
double precision endtime |
3066 |
double precision externforcingcycle |
3067 |
double precision externforcingperiod |
3068 |
double precision f0 |
3069 |
double precision fcori(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
3070 |
double precision fofacmom |
3071 |
double precision freesurffac |
3072 |
double precision gbaro |
3073 |
double precision gravity |
3074 |
double precision hfacmin |
3075 |
double precision hfacmindp |
3076 |
double precision hfacmindr |
3077 |
double precision hfacmindz |
3078 |
double precision horivertratio |
3079 |
double precision implicdiv2dflow |
3080 |
double precision implicsurfpress |
3081 |
double precision ivdc_kappa |
3082 |
double precision lambdasaltclimrelax |
3083 |
double precision lambdathetaclimrelax |
3084 |
double precision latfftfiltlo |
3085 |
double precision mtfacmom |
3086 |
double precision omega |
3087 |
double precision pchkptfreq |
3088 |
double precision pffacmom |
3089 |
double precision phimin |
3090 |
double precision rcd |
3091 |
double precision recip_gravity |
3092 |
double precision recip_horivertratio |
3093 |
double precision recip_rhoconst |
3094 |
double precision recip_rhonil |
3095 |
double precision recip_rsphere |
3096 |
double precision rhoconst |
3097 |
double precision rhonil |
3098 |
double precision ro_sealevel |
3099 |
double precision rsphere |
3100 |
double precision specvol_s(nr) |
3101 |
double precision sref(nr) |
3102 |
double precision starttime |
3103 |
double precision taucd |
3104 |
double precision tausaltclimrelax |
3105 |
double precision tauthetaclimrelax |
3106 |
double precision tavefreq |
3107 |
double precision theta_s(nr) |
3108 |
double precision thetamin |
3109 |
double precision tref(nr) |
3110 |
double precision vffacmom |
3111 |
double precision visca4 |
3112 |
double precision viscah |
3113 |
double precision viscap |
3114 |
double precision viscar |
3115 |
double precision viscaz |
3116 |
double precision zonal_filt_lat |
3117 |
|
3118 |
C============================================== |
3119 |
C define arguments |
3120 |
C============================================== |
3121 |
double precision adfvert(1-olx:snx+olx,1-oly:sny+oly,2) |
3122 |
double precision adkappart(1-olx:snx+olx,1-oly:sny+oly,nr) |
3123 |
double precision adrtrans(1-olx:snx+olx,1-oly:sny+oly) |
3124 |
double precision adutrans(1-olx:snx+olx,1-oly:sny+oly) |
3125 |
double precision advtrans(1-olx:snx+olx,1-oly:sny+oly) |
3126 |
integer bi |
3127 |
integer bj |
3128 |
integer imax |
3129 |
integer imin |
3130 |
integer jmax |
3131 |
integer jmin |
3132 |
integer k |
3133 |
double precision kappart(1-olx:snx+olx,1-oly:sny+oly,nr) |
3134 |
integer kdown |
3135 |
integer km1 |
3136 |
integer kup |
3137 |
double precision maskc(1-olx:snx+olx,1-oly:sny+oly) |
3138 |
double precision maskup(1-olx:snx+olx,1-oly:sny+oly) |
3139 |
double precision rtrans(1-olx:snx+olx,1-oly:sny+oly) |
3140 |
double precision utrans(1-olx:snx+olx,1-oly:sny+oly) |
3141 |
double precision vtrans(1-olx:snx+olx,1-oly:sny+oly) |
3142 |
double precision xa(1-olx:snx+olx,1-oly:sny+oly) |
3143 |
double precision ya(1-olx:snx+olx,1-oly:sny+oly) |
3144 |
|
3145 |
C============================================== |
3146 |
C define local variables |
3147 |
C============================================== |
3148 |
double precision adaf(1-olx:snx+olx,1-oly:sny+oly) |
3149 |
double precision addf(1-olx:snx+olx,1-oly:sny+oly) |
3150 |
double precision addf4(1-olx:snx+olx,1-oly:sny+oly) |
3151 |
double precision addtdx(1-olx:snx+olx,1-oly:sny+oly) |
3152 |
double precision addtdy(1-olx:snx+olx,1-oly:sny+oly) |
3153 |
double precision adfmer(1-olx:snx+olx,1-oly:sny+oly) |
3154 |
double precision adfzon(1-olx:snx+olx,1-oly:sny+oly) |
3155 |
double precision affact |
3156 |
double precision dffact |
3157 |
integer i |
3158 |
integer ip1 |
3159 |
integer ip2 |
3160 |
integer j |
3161 |
logical top_layer |
3162 |
|
3163 |
C---------------------------------------------- |
3164 |
C RESET LOCAL ADJOINT VARIABLES |
3165 |
C---------------------------------------------- |
3166 |
do ip2 = 1-oly, sny+oly |
3167 |
do ip1 = 1-olx, snx+olx |
3168 |
adaf(ip1,ip2) = 0.d0 |
3169 |
end do |
3170 |
end do |
3171 |
do ip2 = 1-oly, sny+oly |
3172 |
do ip1 = 1-olx, snx+olx |
3173 |
addf(ip1,ip2) = 0.d0 |
3174 |
end do |
3175 |
end do |
3176 |
do ip2 = 1-oly, sny+oly |
3177 |
do ip1 = 1-olx, snx+olx |
3178 |
addf4(ip1,ip2) = 0.d0 |
3179 |
end do |
3180 |
end do |
3181 |
do ip2 = 1-oly, sny+oly |
3182 |
do ip1 = 1-olx, snx+olx |
3183 |
addtdx(ip1,ip2) = 0.d0 |
3184 |
end do |
3185 |
end do |
3186 |
do ip2 = 1-oly, sny+oly |
3187 |
do ip1 = 1-olx, snx+olx |
3188 |
addtdy(ip1,ip2) = 0.d0 |
3189 |
end do |
3190 |
end do |
3191 |
do ip2 = 1-oly, sny+oly |
3192 |
do ip1 = 1-olx, snx+olx |
3193 |
adfmer(ip1,ip2) = 0.d0 |
3194 |
end do |
3195 |
end do |
3196 |
do ip2 = 1-oly, sny+oly |
3197 |
do ip1 = 1-olx, snx+olx |
3198 |
adfzon(ip1,ip2) = 0.d0 |
3199 |
end do |
3200 |
end do |
3201 |
|
3202 |
C---------------------------------------------- |
3203 |
C ROUTINE BODY |
3204 |
C---------------------------------------------- |
3205 |
affact = 1.d0 |
3206 |
dffact = 1.d0 |
3207 |
top_layer = k .eq. 1 |
3208 |
call adexternal_forcing_t( imin,imax,jmin,jmax,bi,bj,k,maskc ) |
3209 |
do j = jmin, jmax |
3210 |
do i = imin, imax |
3211 |
adfmer(i,j+1) = adfmer(i,j+1)-adgt(i,j,k,bi,bj)* |
3212 |
$(recip_hfacc(i,j,k,bi,bj)*recip_drf(k)/ra(i,j,bi,bj)) |
3213 |
adfmer(i,j) = adfmer(i,j)+adgt(i,j,k,bi,bj)*(recip_hfacc(i,j, |
3214 |
$k,bi,bj)*recip_drf(k)/ra(i,j,bi,bj)) |
3215 |
adfvert(i,j,kdown) = adfvert(i,j,kdown)+adgt(i,j,k,bi,bj)* |
3216 |
$recip_hfacc(i,j,k,bi,bj)*recip_drf(k)/ra(i,j,bi,bj)*rkfac |
3217 |
adfvert(i,j,kup) = adfvert(i,j,kup)-adgt(i,j,k,bi,bj)* |
3218 |
$recip_hfacc(i,j,k,bi,bj)*recip_drf(k)/ra(i,j,bi,bj)*rkfac |
3219 |
adfzon(i+1,j) = adfzon(i+1,j)-adgt(i,j,k,bi,bj)* |
3220 |
$(recip_hfacc(i,j,k,bi,bj)*recip_drf(k)/ra(i,j,bi,bj)) |
3221 |
adfzon(i,j) = adfzon(i,j)+adgt(i,j,k,bi,bj)*(recip_hfacc(i,j, |
3222 |
$k,bi,bj)*recip_drf(k)/ra(i,j,bi,bj)) |
3223 |
adgt(i,j,k,bi,bj) = 0.d0 |
3224 |
end do |
3225 |
end do |
3226 |
if (top_layer) then |
3227 |
do j = jmin, jmax |
3228 |
do i = imin, imax |
3229 |
adaf(i,j) = adaf(i,j)+adfvert(i,j,kup)*affact*freesurffac |
3230 |
adfvert(i,j,kup) = 0.d0 |
3231 |
end do |
3232 |
end do |
3233 |
endif |
3234 |
do j = jmin, jmax |
3235 |
do i = imin, imax |
3236 |
adaf(i,j) = adaf(i,j)+adfvert(i,j,kup)*affact*maskup(i,j) |
3237 |
addf(i,j) = addf(i,j)+adfvert(i,j,kup)*dffact*maskup(i,j) |
3238 |
adfvert(i,j,kup) = 0.d0 |
3239 |
end do |
3240 |
end do |
3241 |
if (usekpp) then |
3242 |
call adkpp_transport_t( imin,imax,jmin,jmax,bi,bj,k,km1,maskc, |
3243 |
$kappart,adkappart,addf ) |
3244 |
endif |
3245 |
if (usegmredi) then |
3246 |
call adgmredi_rtransport( imin,imax,jmin,jmax,bi,bj,k,theta, |
3247 |
$adtheta,addf ) |
3248 |
endif |
3249 |
if (implicitdiffusion) then |
3250 |
do j = jmin, jmax |
3251 |
do i = imin, imax |
3252 |
addf(i,j) = 0.d0 |
3253 |
end do |
3254 |
end do |
3255 |
else |
3256 |
do j = jmin, jmax |
3257 |
do i = imin, imax |
3258 |
adkappart(i,j,k) = adkappart(i,j,k)-addf(i,j)*ra(i,j,bi,bj)* |
3259 |
$recip_drc(k)*(theta(i,j,km1,bi,bj)-theta(i,j,k,bi,bj))*rkfac |
3260 |
adtheta(i,j,k,bi,bj) = adtheta(i,j,k,bi,bj)+addf(i,j)*ra(i, |
3261 |
$j,bi,bj)*kappart(i,j,k)*recip_drc(k)*rkfac |
3262 |
adtheta(i,j,km1,bi,bj) = adtheta(i,j,km1,bi,bj)-addf(i,j)* |
3263 |
$ra(i,j,bi,bj)*kappart(i,j,k)*recip_drc(k)*rkfac |
3264 |
addf(i,j) = 0.d0 |
3265 |
end do |
3266 |
end do |
3267 |
endif |
3268 |
do j = jmin, jmax |
3269 |
do i = imin, imax |
3270 |
adrtrans(i,j) = adrtrans(i,j)+0.5d0*adaf(i,j)*(theta(i,j,k,bi, |
3271 |
$bj)+theta(i,j,km1,bi,bj)) |
3272 |
adtheta(i,j,k,bi,bj) = adtheta(i,j,k,bi,bj)+0.5d0*adaf(i,j)* |
3273 |
$rtrans(i,j) |
3274 |
adtheta(i,j,km1,bi,bj) = adtheta(i,j,km1,bi,bj)+0.5d0*adaf(i, |
3275 |
$j)*rtrans(i,j) |
3276 |
adaf(i,j) = 0.d0 |
3277 |
end do |
3278 |
end do |
3279 |
do j = jmin, jmax |
3280 |
do i = imin, imax |
3281 |
adaf(i,j) = adaf(i,j)+adfmer(i,j)*affact |
3282 |
addf(i,j) = addf(i,j)+adfmer(i,j)*dffact |
3283 |
adfmer(i,j) = 0.d0 |
3284 |
end do |
3285 |
end do |
3286 |
if (diffk4t .ne. 0.) then |
3287 |
do j = jmin, jmax |
3288 |
do i = imin, imax |
3289 |
addf4(i,j-1) = addf4(i,j-1)-addf(i,j)*ya(i,j)*diffk4t* |
3290 |
$recip_dyc(i,j,bi,bj) |
3291 |
addf4(i,j) = addf4(i,j)+addf(i,j)*ya(i,j)*diffk4t* |
3292 |
$recip_dyc(i,j,bi,bj) |
3293 |
end do |
3294 |
end do |
3295 |
endif |
3296 |
if (usegmredi) then |
3297 |
call adgmredi_ytransport( imin,imax,jmin,jmax,bi,bj,k,ya, |
3298 |
$adtheta,addf ) |
3299 |
endif |
3300 |
do j = jmin, jmax |
3301 |
do i = imin, imax |
3302 |
addtdy(i,j) = addtdy(i,j)-addf(i,j)*diffkht*ya(i,j) |
3303 |
addf(i,j) = 0.d0 |
3304 |
end do |
3305 |
end do |
3306 |
do j = jmin, jmax |
3307 |
do i = imin, imax |
3308 |
adtheta(i,j-1,k,bi,bj) = adtheta(i,j-1,k,bi,bj)+0.5d0*adaf(i, |
3309 |
$j)*vtrans(i,j) |
3310 |
adtheta(i,j,k,bi,bj) = adtheta(i,j,k,bi,bj)+0.5d0*adaf(i,j)* |
3311 |
$vtrans(i,j) |
3312 |
advtrans(i,j) = advtrans(i,j)+0.5d0*adaf(i,j)*(theta(i,j,k,bi, |
3313 |
$bj)+theta(i,j-1,k,bi,bj)) |
3314 |
adaf(i,j) = 0.d0 |
3315 |
end do |
3316 |
end do |
3317 |
do j = jmin, jmax |
3318 |
do i = imin, imax |
3319 |
adaf(i,j) = adaf(i,j)+adfzon(i,j)*affact |
3320 |
addf(i,j) = addf(i,j)+adfzon(i,j)*dffact |
3321 |
adfzon(i,j) = 0.d0 |
3322 |
end do |
3323 |
end do |
3324 |
if (diffk4t .ne. 0.) then |
3325 |
do j = jmin, jmax |
3326 |
do i = imin, imax |
3327 |
addf4(i-1,j) = addf4(i-1,j)-addf(i,j)*xa(i,j)*diffk4t* |
3328 |
$recip_dxc(i,j,bi,bj) |
3329 |
addf4(i,j) = addf4(i,j)+addf(i,j)*xa(i,j)*diffk4t* |
3330 |
$recip_dxc(i,j,bi,bj) |
3331 |
end do |
3332 |
end do |
3333 |
endif |
3334 |
if (usegmredi) then |
3335 |
call adgmredi_xtransport( imin,imax,jmin,jmax,bi,bj,k,xa, |
3336 |
$adtheta,addf ) |
3337 |
endif |
3338 |
do j = jmin, jmax |
3339 |
do i = imin, imax |
3340 |
addtdx(i,j) = addtdx(i,j)-addf(i,j)*diffkht*xa(i,j) |
3341 |
addf(i,j) = 0.d0 |
3342 |
end do |
3343 |
end do |
3344 |
do j = jmin, jmax |
3345 |
do i = imin, imax |
3346 |
adtheta(i-1,j,k,bi,bj) = adtheta(i-1,j,k,bi,bj)+0.5d0*adaf(i, |
3347 |
$j)*utrans(i,j) |
3348 |
adtheta(i,j,k,bi,bj) = adtheta(i,j,k,bi,bj)+0.5d0*adaf(i,j)* |
3349 |
$utrans(i,j) |
3350 |
adutrans(i,j) = adutrans(i,j)+0.5d0*adaf(i,j)*(theta(i,j,k,bi, |
3351 |
$bj)+theta(i-1,j,k,bi,bj)) |
3352 |
adaf(i,j) = 0.d0 |
3353 |
end do |
3354 |
end do |
3355 |
if (diffk4t .ne. 0.) then |
3356 |
do j = 1-oly+1, sny+oly-1 |
3357 |
do i = 1-olx+1, snx+olx-1 |
3358 |
addtdx(i+1,j) = addtdx(i+1,j)+addf4(i,j)*recip_hfacc(i,j,k, |
3359 |
$bi,bj)*recip_drf(k)/ra(i,j,bi,bj)*xa(i+1,j) |
3360 |
addtdx(i,j) = addtdx(i,j)-addf4(i,j)*recip_hfacc(i,j,k,bi, |
3361 |
$bj)*recip_drf(k)/ra(i,j,bi,bj)*xa(i,j) |
3362 |
addtdy(i,j+1) = addtdy(i,j+1)+addf4(i,j)*recip_hfacc(i,j,k, |
3363 |
$bi,bj)*recip_drf(k)/ra(i,j,bi,bj)*ya(i,j+1) |
3364 |
addtdy(i,j) = addtdy(i,j)-addf4(i,j)*recip_hfacc(i,j,k,bi, |
3365 |
$bj)*recip_drf(k)/ra(i,j,bi,bj)*ya(i,j) |
3366 |
addf4(i,j) = 0.d0 |
3367 |
end do |
3368 |
end do |
3369 |
endif |
3370 |
do j = 1-oly+1, sny+oly |
3371 |
do i = 1-olx, snx+olx |
3372 |
adtheta(i,j-1,k,bi,bj) = adtheta(i,j-1,k,bi,bj)-addtdy(i,j)* |
3373 |
$recip_dyc(i,j,bi,bj) |
3374 |
adtheta(i,j,k,bi,bj) = adtheta(i,j,k,bi,bj)+addtdy(i,j)* |
3375 |
$recip_dyc(i,j,bi,bj) |
3376 |
addtdy(i,j) = 0.d0 |
3377 |
end do |
3378 |
end do |
3379 |
do j = 1-oly, sny+oly |
3380 |
do i = 1-olx+1, snx+olx |
3381 |
adtheta(i-1,j,k,bi,bj) = adtheta(i-1,j,k,bi,bj)-addtdx(i,j)* |
3382 |
$recip_dxc(i,j,bi,bj) |
3383 |
adtheta(i,j,k,bi,bj) = adtheta(i,j,k,bi,bj)+addtdx(i,j)* |
3384 |
$recip_dxc(i,j,bi,bj) |
3385 |
addtdx(i,j) = 0.d0 |
3386 |
end do |
3387 |
end do |
3388 |
do j = 1-oly, sny+oly |
3389 |
do i = 1-olx, snx+olx |
3390 |
adfvert(i,j,kup) = 0.d0 |
3391 |
end do |
3392 |
end do |
3393 |
|
3394 |
end |
3395 |
|
3396 |
|
3397 |
subroutine adcalc_ivdc( bi, bj, imin, imax, jmin, jmax, k, rhokm1, |
3398 |
$ rhokp1, adrhokm1, adrhokp1, adkappart, adkappars ) |
3399 |
C*************************************************************** |
3400 |
C*************************************************************** |
3401 |
C** This routine was generated by the ** |
3402 |
C** Tangent linear and Adjoint Model Compiler, TAMC 5.2.14 ** |
3403 |
C*************************************************************** |
3404 |
C*************************************************************** |
3405 |
C============================================== |
3406 |
C all entries are defined explicitly |
3407 |
C============================================== |
3408 |
implicit none |
3409 |
|
3410 |
C============================================== |
3411 |
C define parameters |
3412 |
C============================================== |
3413 |
integer nr |
3414 |
parameter ( nr = 15 ) |
3415 |
integer nsx |
3416 |
parameter ( nsx = 1 ) |
3417 |
integer nsy |
3418 |
parameter ( nsy = 1 ) |
3419 |
integer olx |
3420 |
parameter ( olx = 3 ) |
3421 |
integer oly |
3422 |
parameter ( oly = 3 ) |
3423 |
integer snx |
3424 |
parameter ( snx = 20 ) |
3425 |
integer sny |
3426 |
parameter ( sny = 40 ) |
3427 |
|
3428 |
C============================================== |
3429 |
C define common blocks |
3430 |
C============================================== |
3431 |
common /grid_r/ dxc, dxf, dxg, dxv, dyc, dyf, dyg, dyu, drc, drf, |
3432 |
$h, hfacc, hfacw, hfacs, depthink, recip_dxc, recip_dxf, recip_dxg, |
3433 |
$ recip_dxv, recip_dyc, recip_dyf, recip_dyg, recip_dyu, recip_drc, |
3434 |
$ recip_drf, recip_h, recip_hfacc, recip_hfacw, recip_hfacs, rkfac, |
3435 |
$ recip_rkfac, safac, xc, yc, ra, raw, ras, raz, rc, rf, yc0, xc0, |
3436 |
$xg, yg, maskw, masks, recip_ra, recip_raw, recip_ras, recip_raz, |
3437 |
$tanphiatu, tanphiatv |
3438 |
double precision depthink(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
3439 |
double precision drc(1:nr) |
3440 |
double precision drf(1:nr) |
3441 |
double precision dxc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
3442 |
double precision dxf(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
3443 |
double precision dxg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
3444 |
double precision dxv(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
3445 |
double precision dyc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
3446 |
double precision dyf(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
3447 |
double precision dyg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
3448 |
double precision dyu(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
3449 |
double precision h(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
3450 |
double precision hfacc(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) |
3451 |
double precision hfacs(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) |
3452 |
double precision hfacw(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) |
3453 |
double precision masks(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) |
3454 |
double precision maskw(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) |
3455 |
double precision ra(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
3456 |
double precision ras(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
3457 |
double precision raw(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
3458 |
double precision raz(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
3459 |
double precision rc(1:nr) |
3460 |
double precision recip_drc(1:nr) |
3461 |
double precision recip_drf(1:nr) |
3462 |
double precision recip_dxc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
3463 |
double precision recip_dxf(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
3464 |
double precision recip_dxg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
3465 |
double precision recip_dxv(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
3466 |
double precision recip_dyc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
3467 |
double precision recip_dyf(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
3468 |
double precision recip_dyg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
3469 |
double precision recip_dyu(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
3470 |
double precision recip_h(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
3471 |
double precision recip_hfacc(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx, |
3472 |
$nsy) |
3473 |
double precision recip_hfacs(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx, |
3474 |
$nsy) |
3475 |
double precision recip_hfacw(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx, |
3476 |
$nsy) |
3477 |
double precision recip_ra(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
3478 |
double precision recip_ras(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
3479 |
double precision recip_raw(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
3480 |
double precision recip_raz(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
3481 |
double precision recip_rkfac |
3482 |
double precision rf(1:nr+1) |
3483 |
double precision rkfac |
3484 |
double precision safac(1:nr) |
3485 |
double precision tanphiatu(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
3486 |
double precision tanphiatv(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
3487 |
double precision xc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
3488 |
double precision xc0 |
3489 |
double precision xg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
3490 |
double precision yc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
3491 |
double precision yc0 |
3492 |
double precision yg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
3493 |
|
3494 |
C============================================== |
3495 |
C define arguments |
3496 |
C============================================== |
3497 |
double precision adkappars(1-olx:snx+olx,1-oly:sny+oly,nr) |
3498 |
double precision adkappart(1-olx:snx+olx,1-oly:sny+oly,nr) |
3499 |
double precision adrhokm1(1-olx:snx+olx,1-oly:sny+oly) |
3500 |
double precision adrhokp1(1-olx:snx+olx,1-oly:sny+oly) |
3501 |
integer bi |
3502 |
integer bj |
3503 |
integer imax |
3504 |
integer imin |
3505 |
integer jmax |
3506 |
integer jmin |
3507 |
integer k |
3508 |
double precision rhokm1(1-olx:snx+olx,1-oly:sny+oly) |
3509 |
double precision rhokp1(1-olx:snx+olx,1-oly:sny+oly) |
3510 |
|
3511 |
C============================================== |
3512 |
C define local variables |
3513 |
C============================================== |
3514 |
integer i |
3515 |
integer j |
3516 |
|
3517 |
C============================================== |
3518 |
C define external procedures and functions |
3519 |
C============================================== |
3520 |
logical different_multiple |
3521 |
external different_multiple |
3522 |
|
3523 |
C---------------------------------------------- |
3524 |
C ROUTINE BODY |
3525 |
C---------------------------------------------- |
3526 |
do j = jmin, jmax |
3527 |
do i = imin, imax |
3528 |
if (hfacc(i,j,k,bi,bj) .gt. 0. .and. rhokm1(i,j) .gt. |
3529 |
$rhokp1(i,j)) then |
3530 |
adkappars(i,j,k) = 0.d0 |
3531 |
adkappart(i,j,k) = 0.d0 |
3532 |
endif |
3533 |
end do |
3534 |
end do |
3535 |
|
3536 |
end |
3537 |
|
3538 |
|
3539 |
subroutine adcalc_mom_rhs( bi, bj, imin, imax, jmin, jmax, k, kup, |
3540 |
$ kdown, kapparu, kapparv, adphihyd, adkapparu, adkapparv, adfveru, |
3541 |
$ adfverv ) |
3542 |
C*************************************************************** |
3543 |
C*************************************************************** |
3544 |
C** This routine was generated by the ** |
3545 |
C** Tangent linear and Adjoint Model Compiler, TAMC 5.2.14 ** |
3546 |
C*************************************************************** |
3547 |
C*************************************************************** |
3548 |
C============================================== |
3549 |
C all entries are defined explicitly |
3550 |
C============================================== |
3551 |
implicit none |
3552 |
|
3553 |
C============================================== |
3554 |
C define parameters |
3555 |
C============================================== |
3556 |
double precision pi |
3557 |
parameter ( pi = 3.1415926535898d0 ) |
3558 |
double precision deg2rad |
3559 |
parameter ( deg2rad = 2.d0*pi/360.d0 ) |
3560 |
integer max_no_threads |
3561 |
parameter ( max_no_threads = 32 ) |
3562 |
integer npx |
3563 |
parameter ( npx = 1 ) |
3564 |
integer npy |
3565 |
parameter ( npy = 1 ) |
3566 |
integer nr |
3567 |
parameter ( nr = 15 ) |
3568 |
integer nsx |
3569 |
parameter ( nsx = 1 ) |
3570 |
integer nsy |
3571 |
parameter ( nsy = 1 ) |
3572 |
integer snx |
3573 |
parameter ( snx = 20 ) |
3574 |
integer nx |
3575 |
parameter ( nx = snx*nsx*npx ) |
3576 |
integer sny |
3577 |
parameter ( sny = 40 ) |
3578 |
integer ny |
3579 |
parameter ( ny = sny*nsy*npy ) |
3580 |
integer olx |
3581 |
parameter ( olx = 3 ) |
3582 |
integer oly |
3583 |
parameter ( oly = 3 ) |
3584 |
|
3585 |
C============================================== |
3586 |
C define common blocks |
3587 |
C============================================== |
3588 |
common /addynvars_cd/ aduveld, advveld, adetanm1, adunm1, advnm1, |
3589 |
$adgucd, adgvcd |
3590 |
double precision adetanm1(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
3591 |
double precision adgucd(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
3592 |
double precision adgvcd(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
3593 |
double precision adunm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
3594 |
double precision aduveld(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
3595 |
double precision advnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
3596 |
double precision advveld(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
3597 |
|
3598 |
common /addynvars_r/ adetan, aduvel, advvel, adwvel, adtheta, |
3599 |
$adsalt, adgu, adgv, adgt, adgs, adgunm1, adgvnm1, adgtnm1, adgsnm1 |
3600 |
double precision adetan(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
3601 |
double precision adgs(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
3602 |
double precision adgsnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
3603 |
double precision adgt(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
3604 |
double precision adgtnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
3605 |
double precision adgu(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
3606 |
double precision adgunm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
3607 |
double precision adgv(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
3608 |
double precision adgvnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
3609 |
double precision adsalt(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
3610 |
double precision adtheta(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
3611 |
double precision aduvel(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
3612 |
double precision advvel(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
3613 |
double precision adwvel(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
3614 |
|
3615 |
common /dynvars_r/ etan, uvel, vvel, wvel, theta, salt, gu, gv, |
3616 |
$gt, gs, gunm1, gvnm1, gtnm1, gsnm1 |
3617 |
double precision etan(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
3618 |
double precision gs(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
3619 |
double precision gsnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
3620 |
double precision gt(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
3621 |
double precision gtnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
3622 |
double precision gu(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
3623 |
double precision gunm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
3624 |
double precision gv(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
3625 |
double precision gvnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
3626 |
double precision salt(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
3627 |
double precision theta(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
3628 |
double precision uvel(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
3629 |
double precision vvel(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
3630 |
double precision wvel(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
3631 |
|
3632 |
common /eeparams_i/ errormessageunit, standardmessageunit, |
3633 |
$scrunit1, scrunit2, eedataunit, modeldataunit, numberofprocs, |
3634 |
$pidio, myprocid, mypx, mypy, myxgloballo, myygloballo, nthreads, |
3635 |
$mybxlo, mybxhi, mybylo, mybyhi, ntx, nty, ioerrorcount |
3636 |
integer eedataunit |
3637 |
integer errormessageunit |
3638 |
integer ioerrorcount(max_no_threads) |
3639 |
integer modeldataunit |
3640 |
integer mybxhi(max_no_threads) |
3641 |
integer mybxlo(max_no_threads) |
3642 |
integer mybyhi(max_no_threads) |
3643 |
integer mybylo(max_no_threads) |
3644 |
integer myprocid |
3645 |
integer mypx |
3646 |
integer mypy |
3647 |
integer myxgloballo |
3648 |
integer myygloballo |
3649 |
integer nthreads |
3650 |
integer ntx |
3651 |
integer nty |
3652 |
integer numberofprocs |
3653 |
integer pidio |
3654 |
integer scrunit1 |
3655 |
integer scrunit2 |
3656 |
integer standardmessageunit |
3657 |
|
3658 |
common /grid_r/ dxc, dxf, dxg, dxv, dyc, dyf, dyg, dyu, drc, drf, |
3659 |
$h, hfacc, hfacw, hfacs, depthink, recip_dxc, recip_dxf, recip_dxg, |
3660 |
$ recip_dxv, recip_dyc, recip_dyf, recip_dyg, recip_dyu, recip_drc, |
3661 |
$ recip_drf, recip_h, recip_hfacc, recip_hfacw, recip_hfacs, rkfac, |
3662 |
$ recip_rkfac, safac, xc, yc, ra, raw, ras, raz, rc, rf, yc0, xc0, |
3663 |
$xg, yg, maskw, masks, recip_ra, recip_raw, recip_ras, recip_raz, |
3664 |
$tanphiatu, tanphiatv |
3665 |
double precision depthink(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
3666 |
double precision drc(1:nr) |
3667 |
double precision drf(1:nr) |
3668 |
double precision dxc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
3669 |
double precision dxf(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
3670 |
double precision dxg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
3671 |
double precision dxv(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
3672 |
double precision dyc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
3673 |
double precision dyf(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
3674 |
double precision dyg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
3675 |
double precision dyu(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
3676 |
double precision h(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
3677 |
double precision hfacc(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) |
3678 |
double precision hfacs(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) |
3679 |
double precision hfacw(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) |
3680 |
double precision masks(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) |
3681 |
double precision maskw(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) |
3682 |
double precision ra(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
3683 |
double precision ras(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
3684 |
double precision raw(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
3685 |
double precision raz(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
3686 |
double precision rc(1:nr) |
3687 |
double precision recip_drc(1:nr) |
3688 |
double precision recip_drf(1:nr) |
3689 |
double precision recip_dxc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
3690 |
double precision recip_dxf(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
3691 |
double precision recip_dxg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
3692 |
double precision recip_dxv(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
3693 |
double precision recip_dyc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
3694 |
double precision recip_dyf(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
3695 |
double precision recip_dyg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
3696 |
double precision recip_dyu(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
3697 |
double precision recip_h(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
3698 |
double precision recip_hfacc(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx, |
3699 |
$nsy) |
3700 |
double precision recip_hfacs(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx, |
3701 |
$nsy) |
3702 |
double precision recip_hfacw(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx, |
3703 |
$nsy) |
3704 |
double precision recip_ra(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
3705 |
double precision recip_ras(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
3706 |
double precision recip_raw(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
3707 |
double precision recip_raz(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
3708 |
double precision recip_rkfac |
3709 |
double precision rf(1:nr+1) |
3710 |
double precision rkfac |
3711 |
double precision safac(1:nr) |
3712 |
double precision tanphiatu(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
3713 |
double precision tanphiatv(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
3714 |
double precision xc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
3715 |
double precision xc0 |
3716 |
double precision xg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
3717 |
double precision yc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
3718 |
double precision yc0 |
3719 |
double precision yg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
3720 |
|
3721 |
common /parm_l/ usingcartesiangrid, usingsphericalpolargrid, |
3722 |
$no_slip_sides, no_slip_bottom, staggertimestep, momviscosity, |
3723 |
$momadvection, momforcing, usecoriolis, mompressureforcing, |
3724 |
$tempdiffusion, tempadvection, tempforcing, saltdiffusion, |
3725 |
$saltadvection, saltforcing, implicitfreesurface, rigidlid, |
3726 |
$momstepping, tempstepping, saltstepping, metricterms, |
3727 |
$usingsphericalpolarmterms, useconstantf, usebetaplanef, |
3728 |
$usespheref, implicitdiffusion, implicitviscosity, |
3729 |
$dothetaclimrelax, dosaltclimrelax, periodicexternalforcing, |
3730 |
$usingpcoords, usingzcoords, nonhydrostatic, globalfiles, |
3731 |
$allowfreezing, groundatk1, usepickupbeforec35 |
3732 |
logical allowfreezing |
3733 |
logical dosaltclimrelax |
3734 |
logical dothetaclimrelax |
3735 |
logical globalfiles |
3736 |
logical groundatk1 |
3737 |
logical implicitdiffusion |
3738 |
logical implicitfreesurface |
3739 |
logical implicitviscosity |
3740 |
logical metricterms |
3741 |
logical momadvection |
3742 |
logical momforcing |
3743 |
logical mompressureforcing |
3744 |
logical momstepping |
3745 |
logical momviscosity |
3746 |
logical no_slip_bottom |
3747 |
logical no_slip_sides |
3748 |
logical nonhydrostatic |
3749 |
logical periodicexternalforcing |
3750 |
logical rigidlid |
3751 |
logical saltadvection |
3752 |
logical saltdiffusion |
3753 |
logical saltforcing |
3754 |
logical saltstepping |
3755 |
logical staggertimestep |
3756 |
logical tempadvection |
3757 |
logical tempdiffusion |
3758 |
logical tempforcing |
3759 |
logical tempstepping |
3760 |
logical usebetaplanef |
3761 |
logical useconstantf |
3762 |
logical usecoriolis |
3763 |
logical usepickupbeforec35 |
3764 |
logical usespheref |
3765 |
logical usingcartesiangrid |
3766 |
logical usingpcoords |
3767 |
logical usingsphericalpolargrid |
3768 |
logical usingsphericalpolarmterms |
3769 |
logical usingzcoords |
3770 |
|
3771 |
common /parm_r/ cg2dtargetresidual, cg2dpcoffdfac, |
3772 |
$cg3dtargetresidual, delp, delz, delr, delx, dely, deltat, |
3773 |
$deltatmom, deltattracer, deltatclock, abeps, starttime, phimin, |
3774 |
$thetamin, rsphere, recip_rsphere, f0, fcori, beta, viscah, viscaz, |
3775 |
$ visca4, viscar, diffkht, diffkzt, diffk4t, diffkrt, diffkhs, |
3776 |
$diffkzs, diffk4s, diffkrs, delt, taucd, rcd, freesurffac, |
3777 |
$implicsurfpress, implicdiv2dflow, hfacmin, hfacmindz, gravity, |
3778 |
$recip_gravity, gbaro, rhonil, recip_rhonil, recip_rhoconst, |
3779 |
$rhoconst, tref, sref, endtime, chkptfreq, pchkptfreq, dumpfreq, |
3780 |
$tavefreq, affacmom, vffacmom, pffacmom, cffacmom, fofacmom, |
3781 |
$mtfacmom, cospower, cadjfreq, omega, tauthetaclimrelax, |
3782 |
$lambdathetaclimrelax, tausaltclimrelax, lambdasaltclimrelax, |
3783 |
$externforcingcycle, externforcingperiod, viscap, diffkpt, diffkps, |
3784 |
$ hfacmindr, hfacmindp, theta_s, specvol_s, horivertratio, |
3785 |
$recip_horivertratio, latfftfiltlo, ivdc_kappa, ro_sealevel, |
3786 |
$zonal_filt_lat, bottomdraglinear, bottomdragquadratic |
3787 |
double precision abeps |
3788 |
double precision affacmom |
3789 |
double precision beta |
3790 |
double precision bottomdraglinear |
3791 |
double precision bottomdragquadratic |
3792 |
double precision cadjfreq |
3793 |
double precision cffacmom |
3794 |
double precision cg2dpcoffdfac |
3795 |
double precision cg2dtargetresidual |
3796 |
double precision cg3dtargetresidual |
3797 |
double precision chkptfreq |
3798 |
double precision cospower |
3799 |
double precision delp(nr) |
3800 |
double precision delr(nr) |
3801 |
double precision delt |
3802 |
double precision deltat |
3803 |
double precision deltatclock |
3804 |
double precision deltatmom |
3805 |
double precision deltattracer |
3806 |
double precision delx(nx) |
3807 |
double precision dely(ny) |
3808 |
double precision delz(nr) |
3809 |
double precision diffk4s |
3810 |
double precision diffk4t |
3811 |
double precision diffkhs |
3812 |
double precision diffkht |
3813 |
double precision diffkps |
3814 |
double precision diffkpt |
3815 |
double precision diffkrs |
3816 |
double precision diffkrt |
3817 |
double precision diffkzs |
3818 |
double precision diffkzt |
3819 |
double precision dumpfreq |
3820 |
double precision endtime |
3821 |
double precision externforcingcycle |
3822 |
double precision externforcingperiod |
3823 |
double precision f0 |
3824 |
double precision fcori(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
3825 |
double precision fofacmom |
3826 |
double precision freesurffac |
3827 |
double precision gbaro |
3828 |
double precision gravity |
3829 |
double precision hfacmin |
3830 |
double precision hfacmindp |
3831 |
double precision hfacmindr |
3832 |
double precision hfacmindz |
3833 |
double precision horivertratio |
3834 |
double precision implicdiv2dflow |
3835 |
double precision implicsurfpress |
3836 |
double precision ivdc_kappa |
3837 |
double precision lambdasaltclimrelax |
3838 |
double precision lambdathetaclimrelax |
3839 |
double precision latfftfiltlo |
3840 |
double precision mtfacmom |
3841 |
double precision omega |
3842 |
double precision pchkptfreq |
3843 |
double precision pffacmom |
3844 |
double precision phimin |
3845 |
double precision rcd |
3846 |
double precision recip_gravity |
3847 |
double precision recip_horivertratio |
3848 |
double precision recip_rhoconst |
3849 |
double precision recip_rhonil |
3850 |
double precision recip_rsphere |
3851 |
double precision rhoconst |
3852 |
double precision rhonil |
3853 |
double precision ro_sealevel |
3854 |
double precision rsphere |
3855 |
double precision specvol_s(nr) |
3856 |
double precision sref(nr) |
3857 |
double precision starttime |
3858 |
double precision taucd |
3859 |
double precision tausaltclimrelax |
3860 |
double precision tauthetaclimrelax |
3861 |
double precision tavefreq |
3862 |
double precision theta_s(nr) |
3863 |
double precision thetamin |
3864 |
double precision tref(nr) |
3865 |
double precision vffacmom |
3866 |
double precision visca4 |
3867 |
double precision viscah |
3868 |
double precision viscap |
3869 |
double precision viscar |
3870 |
double precision viscaz |
3871 |
double precision zonal_filt_lat |
3872 |
|
3873 |
common /solve_barot/ bo_surf, recip_bo |
3874 |
double precision bo_surf(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
3875 |
double precision recip_bo(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
3876 |
|
3877 |
C============================================== |
3878 |
C define arguments |
3879 |
C============================================== |
3880 |
double precision adfveru(1-olx:snx+olx,1-oly:sny+oly,2) |
3881 |
double precision adfverv(1-olx:snx+olx,1-oly:sny+oly,2) |
3882 |
double precision adkapparu(1-olx:snx+olx,1-oly:sny+oly,nr) |
3883 |
double precision adkapparv(1-olx:snx+olx,1-oly:sny+oly,nr) |
3884 |
double precision adphihyd(1-olx:snx+olx,1-oly:sny+oly,nr) |
3885 |
integer bi |
3886 |
integer bj |
3887 |
integer imax |
3888 |
integer imin |
3889 |
integer jmax |
3890 |
integer jmin |
3891 |
integer k |
3892 |
double precision kapparu(1-olx:snx+olx,1-oly:sny+oly,nr) |
3893 |
double precision kapparv(1-olx:snx+olx,1-oly:sny+oly,nr) |
3894 |
integer kdown |
3895 |
integer kup |
3896 |
|
3897 |
C============================================== |
3898 |
C define local variables |
3899 |
C============================================== |
3900 |
double precision ab05 |
3901 |
double precision ab15 |
3902 |
double precision adaf(1-olx:snx+olx,1-oly:sny+oly) |
3903 |
double precision adfmer(1-olx:snx+olx,1-oly:sny+oly) |
3904 |
double precision adfzon(1-olx:snx+olx,1-oly:sny+oly) |
3905 |
double precision adke(1-olx:snx+olx,1-oly:sny+oly) |
3906 |
double precision admt(1-olx:snx+olx,1-oly:sny+oly) |
3907 |
double precision adpf(1-olx:snx+olx,1-oly:sny+oly) |
3908 |
double precision adutrans(1-olx:snx+olx,1-oly:sny+oly) |
3909 |
double precision adv4f(1-olx:snx+olx,1-oly:sny+oly) |
3910 |
double precision advf(1-olx:snx+olx,1-oly:sny+oly) |
3911 |
double precision advtrans(1-olx:snx+olx,1-oly:sny+oly) |
3912 |
double precision ahdudxfac |
3913 |
double precision ahdudyfac |
3914 |
double precision ahdvdxfac |
3915 |
double precision ahdvdyfac |
3916 |
double precision ardudrfac |
3917 |
double precision ardvdrfac |
3918 |
logical bottomdragterms |
3919 |
double precision cosfacu(1-oly:sny+oly) |
3920 |
double precision cosfacv(1-oly:sny+oly) |
3921 |
double precision fufac |
3922 |
double precision fvfac |
3923 |
double precision hfacz(1-olx:snx+olx,1-oly:sny+oly) |
3924 |
double precision hfaczclosede |
3925 |
double precision hfaczclosedn |
3926 |
double precision hfaczcloseds |
3927 |
double precision hfaczclosedw |
3928 |
double precision hfaczopen |
3929 |
integer i |
3930 |
integer ip1 |
3931 |
integer ip2 |
3932 |
integer j |
3933 |
integer jg |
3934 |
double precision ke(1-olx:snx+olx,1-oly:sny+oly) |
3935 |
integer kp1 |
3936 |
double precision maskdown |
3937 |
double precision mtfacu |
3938 |
double precision mtfacv |
3939 |
double precision phxfac |
3940 |
double precision phyfac |
3941 |
double precision rdrckp1 |
3942 |
double precision rveldudrfac |
3943 |
double precision rveldvdrfac |
3944 |
double precision rvelmaskoverride |
3945 |
double precision ududxfac |
3946 |
double precision udvdxfac |
3947 |
double precision utrans(1-olx:snx+olx,1-oly:sny+oly) |
3948 |
double precision vdudyfac |
3949 |
double precision vdvdyfac |
3950 |
double precision vtrans(1-olx:snx+olx,1-oly:sny+oly) |
3951 |
double precision wvelbottomoverride |
3952 |
double precision xa(1-olx:snx+olx,1-oly:sny+oly) |
3953 |
double precision ya(1-olx:snx+olx,1-oly:sny+oly) |
3954 |
|
3955 |
C---------------------------------------------- |
3956 |
C RESET LOCAL ADJOINT VARIABLES |
3957 |
C---------------------------------------------- |
3958 |
do ip2 = 1-oly, sny+oly |
3959 |
do ip1 = 1-olx, snx+olx |
3960 |
adaf(ip1,ip2) = 0.d0 |
3961 |
end do |
3962 |
end do |
3963 |
do ip2 = 1-oly, sny+oly |
3964 |
do ip1 = 1-olx, snx+olx |
3965 |
adfmer(ip1,ip2) = 0.d0 |
3966 |
end do |
3967 |
end do |
3968 |
do ip2 = 1-oly, sny+oly |
3969 |
do ip1 = 1-olx, snx+olx |
3970 |
adfzon(ip1,ip2) = 0.d0 |
3971 |
end do |
3972 |
end do |
3973 |
do ip2 = 1-oly, sny+oly |
3974 |
do ip1 = 1-olx, snx+olx |
3975 |
adke(ip1,ip2) = 0.d0 |
3976 |
end do |
3977 |
end do |
3978 |
do ip2 = 1-oly, sny+oly |
3979 |
do ip1 = 1-olx, snx+olx |
3980 |
admt(ip1,ip2) = 0.d0 |
3981 |
end do |
3982 |
end do |
3983 |
do ip2 = 1-oly, sny+oly |
3984 |
do ip1 = 1-olx, snx+olx |
3985 |
adpf(ip1,ip2) = 0.d0 |
3986 |
end do |
3987 |
end do |
3988 |
do ip2 = 1-oly, sny+oly |
3989 |
do ip1 = 1-olx, snx+olx |
3990 |
adutrans(ip1,ip2) = 0.d0 |
3991 |
end do |
3992 |
end do |
3993 |
do ip2 = 1-oly, sny+oly |
3994 |
do ip1 = 1-olx, snx+olx |
3995 |
adv4f(ip1,ip2) = 0.d0 |
3996 |
end do |
3997 |
end do |
3998 |
do ip2 = 1-oly, sny+oly |
3999 |
do ip1 = 1-olx, snx+olx |
4000 |
advf(ip1,ip2) = 0.d0 |
4001 |
end do |
4002 |
end do |
4003 |
do ip2 = 1-oly, sny+oly |
4004 |
do ip1 = 1-olx, snx+olx |
4005 |
advtrans(ip1,ip2) = 0.d0 |
4006 |
end do |
4007 |
end do |
4008 |
|
4009 |
C---------------------------------------------- |
4010 |
C ROUTINE BODY |
4011 |
C---------------------------------------------- |
4012 |
kp1 = min(nr,k+1) |
4013 |
rvelmaskoverride = 1. |
4014 |
if (k .eq. 1) then |
4015 |
rvelmaskoverride = freesurffac |
4016 |
endif |
4017 |
wvelbottomoverride = 1. |
4018 |
if (k .eq. nr) then |
4019 |
wvelbottomoverride = 0. |
4020 |
endif |
4021 |
do j = 1-oly, sny+oly-1 |
4022 |
do i = 1-olx, snx+olx-1 |
4023 |
ke(i,j) = 0.25*(uvel(i,j,k,bi,bj)*uvel(i,j,k,bi,bj)+uvel(i+1, |
4024 |
$j,k,bi,bj)*uvel(i+1,j,k,bi,bj)+vvel(i,j,k,bi,bj)*vvel(i,j,k,bi,bj) |
4025 |
$+vvel(i,j+1,k,bi,bj)*vvel(i,j+1,k,bi,bj)) |
4026 |
end do |
4027 |
end do |
4028 |
do j = 1-oly, sny+oly |
4029 |
jg = myygloballo+(bj-1)*sny+j-1 |
4030 |
jg = min(max(1,jg),ny) |
4031 |
if (cospower .ne. 0.) then |
4032 |
cosfacu(j) = cos(yc(1,j,bi,bj)*deg2rad)**cospower |
4033 |
cosfacv(j) = cos((yc(1,j,bi,bj)-0.5*dely(jg))*deg2rad)** |
4034 |
$cospower |
4035 |
else |
4036 |
cosfacu(j) = 1. |
4037 |
cosfacv(j) = 1. |
4038 |
endif |
4039 |
end do |
4040 |
ududxfac = affacmom*1. |
4041 |
ahdudxfac = vffacmom*1. |
4042 |
vdudyfac = affacmom*1. |
4043 |
ahdudyfac = vffacmom*1. |
4044 |
rveldudrfac = affacmom*1. |
4045 |
ardudrfac = vffacmom*1. |
4046 |
mtfacu = mtfacmom*1. |
4047 |
fufac = cffacmom*1. |
4048 |
phxfac = pffacmom*1. |
4049 |
udvdxfac = affacmom*1. |
4050 |
ahdvdxfac = vffacmom*1. |
4051 |
vdvdyfac = affacmom*1. |
4052 |
ahdvdyfac = vffacmom*1. |
4053 |
rveldvdrfac = affacmom*1. |
4054 |
ardvdrfac = vffacmom*1. |
4055 |
mtfacv = mtfacmom*1. |
4056 |
fvfac = cffacmom*1. |
4057 |
phyfac = pffacmom*1. |
4058 |
if (no_slip_bottom) then |
4059 |
bottomdragterms = .true. |
4060 |
else |
4061 |
bottomdragterms = .false. |
4062 |
endif |
4063 |
if (staggertimestep) then |
4064 |
phxfac = 0. |
4065 |
phyfac = 0. |
4066 |
endif |
4067 |
ab15 = 1.5d0+abeps |
4068 |
ab05 = (-0.5d0)-abeps |
4069 |
do i = 1-olx, snx+olx |
4070 |
hfacz(i,1-oly) = 0. |
4071 |
end do |
4072 |
do j = 2-oly, sny+oly |
4073 |
hfacz(1-olx,j) = 0. |
4074 |
do i = 2-olx, snx+olx |
4075 |
hfaczopen = min(hfacw(i,j,k,bi,bj),hfacw(i,j-1,k,bi,bj)) |
4076 |
hfaczopen = min(hfacs(i,j,k,bi,bj),hfaczopen) |
4077 |
hfaczopen = min(hfacs(i-1,j,k,bi,bj),hfaczopen) |
4078 |
hfacz(i,j) = hfaczopen |
4079 |
end do |
4080 |
end do |
4081 |
do j = 1-oly, sny+oly |
4082 |
do i = 1-olx, snx+olx |
4083 |
xa(i,j) = dyg(i,j,bi,bj)*drf(k)*hfacw(i,j,k,bi,bj) |
4084 |
ya(i,j) = dxg(i,j,bi,bj)*drf(k)*hfacs(i,j,k,bi,bj) |
4085 |
end do |
4086 |
end do |
4087 |
do j = 1-oly, sny+oly |
4088 |
do i = 1-olx, snx+olx |
4089 |
utrans(i,j) = uvel(i,j,k,bi,bj)*xa(i,j) |
4090 |
vtrans(i,j) = vvel(i,j,k,bi,bj)*ya(i,j) |
4091 |
end do |
4092 |
end do |
4093 |
do j = 1-oly, sny+oly |
4094 |
do i = 1-olx, snx+olx |
4095 |
advvel(i,j,k,bi,bj) = advvel(i,j,k,bi,bj)+advnm1(i,j,k,bi,bj) |
4096 |
advnm1(i,j,k,bi,bj) = 0.d0 |
4097 |
aduvel(i,j,k,bi,bj) = aduvel(i,j,k,bi,bj)+adunm1(i,j,k,bi,bj) |
4098 |
adunm1(i,j,k,bi,bj) = 0.d0 |
4099 |
end do |
4100 |
end do |
4101 |
do j = jmin, jmax |
4102 |
do i = imin, imax |
4103 |
adgv(i,j,k,bi,bj) = adgv(i,j,k,bi,bj)*masks(i,j,k,bi,bj) |
4104 |
end do |
4105 |
end do |
4106 |
do j = jmin, jmax |
4107 |
do i = imin, imax |
4108 |
adgu(i,j,k,bi,bj) = adgu(i,j,k,bi,bj)*maskw(i,j,k,bi,bj) |
4109 |
end do |
4110 |
end do |
4111 |
do j = jmin, jmax |
4112 |
do i = imin, imax |
4113 |
aduveld(i,j,k,bi,bj) = aduveld(i,j,k,bi,bj)-0.5d0*adgvcd(i,j, |
4114 |
$k,bi,bj)*(fcori(i,j,bi,bj)+fcori(i,j-1,bi,bj))*masks(i,j,k,bi,bj)* |
4115 |
$fvfac |
4116 |
adgvcd(i,j,k,bi,bj) = 0.d0 |
4117 |
end do |
4118 |
end do |
4119 |
do j = jmin, jmax |
4120 |
do i = imin, imax |
4121 |
adunm1(i+1,j-1,k,bi,bj) = adunm1(i+1,j-1,k,bi,bj)+0.25d0* |
4122 |
$aduveld(i,j,k,bi,bj)*(1.d0-rcd)*ab05*masks(i,j,k,bi,bj) |
4123 |
adunm1(i,j-1,k,bi,bj) = adunm1(i,j-1,k,bi,bj)+0.25d0* |
4124 |
$aduveld(i,j,k,bi,bj)*(1.d0-rcd)*ab05*masks(i,j,k,bi,bj) |
4125 |
adunm1(i+1,j,k,bi,bj) = adunm1(i+1,j,k,bi,bj)+0.25d0* |
4126 |
$aduveld(i,j,k,bi,bj)*(1.d0-rcd)*ab05*masks(i,j,k,bi,bj) |
4127 |
adunm1(i,j,k,bi,bj) = adunm1(i,j,k,bi,bj)+0.25d0*aduveld(i,j, |
4128 |
$k,bi,bj)*(1.d0-rcd)*ab05*masks(i,j,k,bi,bj) |
4129 |
aduvel(i+1,j-1,k,bi,bj) = aduvel(i+1,j-1,k,bi,bj)+0.25d0* |
4130 |
$aduveld(i,j,k,bi,bj)*(1.d0-rcd)*ab15*masks(i,j,k,bi,bj) |
4131 |
aduvel(i,j-1,k,bi,bj) = aduvel(i,j-1,k,bi,bj)+0.25d0* |
4132 |
$aduveld(i,j,k,bi,bj)*(1.d0-rcd)*ab15*masks(i,j,k,bi,bj) |
4133 |
aduvel(i+1,j,k,bi,bj) = aduvel(i+1,j,k,bi,bj)+0.25d0* |
4134 |
$aduveld(i,j,k,bi,bj)*(1.d0-rcd)*ab15*masks(i,j,k,bi,bj) |
4135 |
aduvel(i,j,k,bi,bj) = aduvel(i,j,k,bi,bj)+0.25d0*aduveld(i,j, |
4136 |
$k,bi,bj)*(1.d0-rcd)*ab15*masks(i,j,k,bi,bj) |
4137 |
aduveld(i,j,k,bi,bj) = aduveld(i,j,k,bi,bj)*rcd |
4138 |
end do |
4139 |
end do |
4140 |
do j = jmin, jmax |
4141 |
do i = imin, imax |
4142 |
advf(i,j) = advf(i,j)+aduveld(i,j,k,bi,bj)*deltatmom*masks(i, |
4143 |
$j,k,bi,bj) |
4144 |
end do |
4145 |
end do |
4146 |
do j = jmin, jmax |
4147 |
do i = imin, imax |
4148 |
adaf(i+1,j-1) = adaf(i+1,j-1)+0.25d0*advf(i,j)*masks(i,j,k,bi, |
4149 |
$bj) |
4150 |
adaf(i,j-1) = adaf(i,j-1)+0.25d0*advf(i,j)*masks(i,j,k,bi,bj) |
4151 |
adaf(i+1,j) = adaf(i+1,j)+0.25d0*advf(i,j)*masks(i,j,k,bi,bj) |
4152 |
adaf(i,j) = adaf(i,j)+0.25d0*advf(i,j)*masks(i,j,k,bi,bj) |
4153 |
advvel(i,j,k,bi,bj) = advvel(i,j,k,bi,bj)+0.5d0*advf(i,j)* |
4154 |
$(fcori(i,j,bi,bj)+fcori(i,j-1,bi,bj)) |
4155 |
advf(i,j) = 0.d0 |
4156 |
end do |
4157 |
end do |
4158 |
do j = jmin, jmax |
4159 |
do i = imin, imax |
4160 |
adgu(i,j,k,bi,bj) = adgu(i,j,k,bi,bj)+adaf(i,j) |
4161 |
adpf(i-1,j) = adpf(i-1,j)+adaf(i,j)*maskw(i,j,k,bi,bj)* |
4162 |
$recip_dxc(i,j,bi,bj) |
4163 |
adpf(i,j) = adpf(i,j)-adaf(i,j)*maskw(i,j,k,bi,bj)* |
4164 |
$recip_dxc(i,j,bi,bj) |
4165 |
adaf(i,j) = 0.d0 |
4166 |
end do |
4167 |
end do |
4168 |
do j = jmin, jmax |
4169 |
do i = imin, imax |
4170 |
advveld(i,j,k,bi,bj) = advveld(i,j,k,bi,bj)+0.5d0*adgucd(i,j, |
4171 |
$k,bi,bj)*(fcori(i,j,bi,bj)+fcori(i-1,j,bi,bj))*fufac |
4172 |
adgucd(i,j,k,bi,bj) = 0.d0 |
4173 |
end do |
4174 |
end do |
4175 |
do j = jmin, jmax |
4176 |
do i = imin, imax |
4177 |
advnm1(i-1,j+1,k,bi,bj) = advnm1(i-1,j+1,k,bi,bj)+0.25d0* |
4178 |
$advveld(i,j,k,bi,bj)*(1.d0-rcd)*ab05*maskw(i,j,k,bi,bj) |
4179 |
advnm1(i,j+1,k,bi,bj) = advnm1(i,j+1,k,bi,bj)+0.25d0* |
4180 |
$advveld(i,j,k,bi,bj)*(1.d0-rcd)*ab05*maskw(i,j,k,bi,bj) |
4181 |
advnm1(i-1,j,k,bi,bj) = advnm1(i-1,j,k,bi,bj)+0.25d0* |
4182 |
$advveld(i,j,k,bi,bj)*(1.d0-rcd)*ab05*maskw(i,j,k,bi,bj) |
4183 |
advnm1(i,j,k,bi,bj) = advnm1(i,j,k,bi,bj)+0.25d0*advveld(i,j, |
4184 |
$k,bi,bj)*(1.d0-rcd)*ab05*maskw(i,j,k,bi,bj) |
4185 |
advvel(i-1,j+1,k,bi,bj) = advvel(i-1,j+1,k,bi,bj)+0.25d0* |
4186 |
$advveld(i,j,k,bi,bj)*(1.d0-rcd)*ab15*maskw(i,j,k,bi,bj) |
4187 |
advvel(i,j+1,k,bi,bj) = advvel(i,j+1,k,bi,bj)+0.25d0* |
4188 |
$advveld(i,j,k,bi,bj)*(1.d0-rcd)*ab15*maskw(i,j,k,bi,bj) |
4189 |
advvel(i-1,j,k,bi,bj) = advvel(i-1,j,k,bi,bj)+0.25d0* |
4190 |
$advveld(i,j,k,bi,bj)*(1.d0-rcd)*ab15*maskw(i,j,k,bi,bj) |
4191 |
advvel(i,j,k,bi,bj) = advvel(i,j,k,bi,bj)+0.25d0*advveld(i,j, |
4192 |
$k,bi,bj)*(1.d0-rcd)*ab15*maskw(i,j,k,bi,bj) |
4193 |
advveld(i,j,k,bi,bj) = advveld(i,j,k,bi,bj)*rcd |
4194 |
end do |
4195 |
end do |
4196 |
do j = jmin, jmax |
4197 |
do i = imin, imax |
4198 |
advf(i,j) = advf(i,j)+advveld(i,j,k,bi,bj)*deltatmom |
4199 |
end do |
4200 |
end do |
4201 |
do j = jmin, jmax |
4202 |
do i = imin, imax |
4203 |
adaf(i-1,j+1) = adaf(i-1,j+1)+0.25d0*advf(i,j)*maskw(i,j,k,bi, |
4204 |
$bj) |
4205 |
adaf(i,j+1) = adaf(i,j+1)+0.25d0*advf(i,j)*maskw(i,j,k,bi,bj) |
4206 |
adaf(i-1,j) = adaf(i-1,j)+0.25d0*advf(i,j)*maskw(i,j,k,bi,bj) |
4207 |
adaf(i,j) = adaf(i,j)+0.25d0*advf(i,j)*maskw(i,j,k,bi,bj) |
4208 |
aduvel(i,j,k,bi,bj) = aduvel(i,j,k,bi,bj)-0.5d0*advf(i,j)* |
4209 |
$(fcori(i,j,bi,bj)+fcori(i-1,j,bi,bj)) |
4210 |
advf(i,j) = 0.d0 |
4211 |
end do |
4212 |
end do |
4213 |
do j = jmin, jmax |
4214 |
do i = imin, imax |
4215 |
adgv(i,j,k,bi,bj) = adgv(i,j,k,bi,bj)+adaf(i,j) |
4216 |
adpf(i,j-1) = adpf(i,j-1)+adaf(i,j)*masks(i,j,k,bi,bj)* |
4217 |
$recip_dyc(i,j,bi,bj) |
4218 |
adpf(i,j) = adpf(i,j)-adaf(i,j)*masks(i,j,k,bi,bj)* |
4219 |
$recip_dyc(i,j,bi,bj) |
4220 |
adaf(i,j) = 0.d0 |
4221 |
end do |
4222 |
end do |
4223 |
if (staggertimestep) then |
4224 |
do j = jmin, jmax |
4225 |
do i = imin, imax |
4226 |
adphihyd(i,j,k) = adphihyd(i,j,k)+adpf(i,j) |
4227 |
end do |
4228 |
end do |
4229 |
endif |
4230 |
do j = jmin, jmax |
4231 |
do i = imin, imax |
4232 |
adetan(i,j,bi,bj) = adetan(i,j,bi,bj)+adpf(i,j)*ab15* |
4233 |
$bo_surf(i,j,bi,bj) |
4234 |
adetanm1(i,j,bi,bj) = adetanm1(i,j,bi,bj)+adpf(i,j)*ab05* |
4235 |
$bo_surf(i,j,bi,bj) |
4236 |
adpf(i,j) = 0.d0 |
4237 |
end do |
4238 |
end do |
4239 |
do j = jmin, jmax |
4240 |
do i = imin, imax |
4241 |
adgv(i,j,k,bi,bj) = adgv(i,j,k,bi,bj)*masks(i,j,k,bi,bj) |
4242 |
end do |
4243 |
end do |
4244 |
if (usingsphericalpolarmterms) then |
4245 |
do j = jmin, jmax |
4246 |
do i = imin, imax |
4247 |
admt(i,j) = admt(i,j)+adgv(i,j,k,bi,bj)*mtfacv |
4248 |
end do |
4249 |
end do |
4250 |
do j = jmin, jmax |
4251 |
do i = imin, imax |
4252 |
aduvel(i+1,j-1,k,bi,bj) = aduvel(i+1,j-1,k,bi,bj)-0.125d0* |
4253 |
$admt(i,j)*recip_rsphere*(uvel(i,j,k,bi,bj)+uvel(i+1,j,k,bi,bj)+ |
4254 |
$uvel(i,j-1,k,bi,bj)+uvel(i+1,j-1,k,bi,bj))*tanphiatv(i,j,bi,bj) |
4255 |
aduvel(i,j-1,k,bi,bj) = aduvel(i,j-1,k,bi,bj)-0.125d0* |
4256 |
$admt(i,j)*recip_rsphere*(uvel(i,j,k,bi,bj)+uvel(i+1,j,k,bi,bj)+ |
4257 |
$uvel(i,j-1,k,bi,bj)+uvel(i+1,j-1,k,bi,bj))*tanphiatv(i,j,bi,bj) |
4258 |
aduvel(i+1,j,k,bi,bj) = aduvel(i+1,j,k,bi,bj)-0.125d0* |
4259 |
$admt(i,j)*recip_rsphere*(uvel(i,j,k,bi,bj)+uvel(i+1,j,k,bi,bj)+ |
4260 |
$uvel(i,j-1,k,bi,bj)+uvel(i+1,j-1,k,bi,bj))*tanphiatv(i,j,bi,bj) |
4261 |
aduvel(i,j,k,bi,bj) = aduvel(i,j,k,bi,bj)-0.125d0*admt(i,j)* |
4262 |
$recip_rsphere*(uvel(i,j,k,bi,bj)+uvel(i+1,j,k,bi,bj)+uvel(i,j-1,k, |
4263 |
$bi,bj)+uvel(i+1,j-1,k,bi,bj))*tanphiatv(i,j,bi,bj) |
4264 |
end do |
4265 |
end do |
4266 |
do j = jmin, jmax |
4267 |
do i = imin, imax |
4268 |
advvel(i,j,k,bi,bj) = advvel(i,j,k,bi,bj)-0.25d0*admt(i,j)* |
4269 |
$recip_rsphere*(wvelbottomoverride*(wvel(i,j,kp1,bi,bj)+wvel(i,j-1, |
4270 |
$kp1,bi,bj))+wvel(i,j,k,bi,bj)+wvel(i,j-1,k,bi,bj))*rkfac* |
4271 |
$recip_horivertratio |
4272 |
adwvel(i,j-1,k,bi,bj) = adwvel(i,j-1,k,bi,bj)-0.25d0*admt(i, |
4273 |
$j)*vvel(i,j,k,bi,bj)*recip_rsphere*rkfac*recip_horivertratio |
4274 |
adwvel(i,j-1,kp1,bi,bj) = adwvel(i,j-1,kp1,bi,bj)-0.25d0* |
4275 |
$admt(i,j)*vvel(i,j,k,bi,bj)*recip_rsphere*wvelbottomoverride* |
4276 |
$rkfac*recip_horivertratio |
4277 |
adwvel(i,j,k,bi,bj) = adwvel(i,j,k,bi,bj)-0.25d0*admt(i,j)* |
4278 |
$vvel(i,j,k,bi,bj)*recip_rsphere*rkfac*recip_horivertratio |
4279 |
adwvel(i,j,kp1,bi,bj) = adwvel(i,j,kp1,bi,bj)-0.25d0*admt(i, |
4280 |
$j)*vvel(i,j,k,bi,bj)*recip_rsphere*wvelbottomoverride*rkfac* |
4281 |
$recip_horivertratio |
4282 |
admt(i,j) = 0.d0 |
4283 |
end do |
4284 |
end do |
4285 |
endif |
4286 |
call adexternal_forcing_v( imin,imax,jmin,jmax,bi,bj,k ) |
4287 |
if (bottomdragterms) then |
4288 |
rdrckp1 = recip_drc(kp1) |
4289 |
if (k .eq. nr) then |
4290 |
rdrckp1 = recip_drf(k) |
4291 |
endif |
4292 |
do j = jmin, jmax |
4293 |
do i = imin, imax |
4294 |
maskdown = masks(i,j,kp1,bi,bj) |
4295 |
if (k .eq. nr) then |
4296 |
maskdown = 0. |
4297 |
endif |
4298 |
if (ke(i,j)+ke(i,j-1) .ne. 0.) then |
4299 |
adke(i,j-1) = adke(i,j-1)-adgv(i,j,k,bi,bj)*recip_hfacs(i, |
4300 |
$j,k,bi,bj)*recip_drf(k)*bottomdragquadratic*1./(2.*sqrt(ke(i,j)+ |
4301 |
$ke(i,j-1)))*(1.-maskdown)*vvel(i,j,k,bi,bj) |
4302 |
adke(i,j) = adke(i,j)-adgv(i,j,k,bi,bj)*recip_hfacs(i,j,k, |
4303 |
$bi,bj)*recip_drf(k)*bottomdragquadratic*1./(2.*sqrt(ke(i,j)+ke(i, |
4304 |
$j-1)))*(1.-maskdown)*vvel(i,j,k,bi,bj) |
4305 |
advvel(i,j,k,bi,bj) = advvel(i,j,k,bi,bj)-adgv(i,j,k,bi, |
4306 |
$bj)*recip_hfacs(i,j,k,bi,bj)*recip_drf(k)*bottomdragquadratic*(1.- |
4307 |
$maskdown)*sqrt(ke(i,j)+ke(i,j-1)) |
4308 |
endif |
4309 |
adkapparv(i,j,kp1) = adkapparv(i,j,kp1)-2*adgv(i,j,k,bi,bj)* |
4310 |
$recip_hfacs(i,j,k,bi,bj)*recip_drf(k)*rkfac*rdrckp1*(1.-maskdown)* |
4311 |
$vvel(i,j,k,bi,bj) |
4312 |
advvel(i,j,k,bi,bj) = advvel(i,j,k,bi,bj)-adgv(i,j,k,bi,bj)* |
4313 |
$recip_hfacs(i,j,k,bi,bj)*recip_drf(k)*(2.*kapparv(i,j,kp1)*rkfac* |
4314 |
$rdrckp1+bottomdraglinear)*(1.-maskdown) |
4315 |
end do |
4316 |
end do |
4317 |
endif |
4318 |
if (no_slip_sides) then |
4319 |
do j = jmin, jmax |
4320 |
do i = imin, imax |
4321 |
hfaczclosedw = hfacs(i,j,k,bi,bj)-hfacz(i,j) |
4322 |
hfaczclosede = hfacs(i,j,k,bi,bj)-hfacz(i+1,j) |
4323 |
adv4f(i,j) = adv4f(i,j)+2.*adgv(i,j,k,bi,bj)*recip_hfacs(i, |
4324 |
$j,k,bi,bj)*recip_drf(k)/ras(i,j,bi,bj)*(hfaczclosedw*dyu(i,j,bi, |
4325 |
$bj)*recip_dxv(i,j,bi,bj)+hfaczclosede*dyu(i+1,j,bi,bj)* |
4326 |
$recip_dxv(i+1,j,bi,bj))*rkfac*drf(k)*visca4*cosfacv(j) |
4327 |
advvel(i,j,k,bi,bj) = advvel(i,j,k,bi,bj)-2.*adgv(i,j,k,bi, |
4328 |
$bj)*recip_hfacs(i,j,k,bi,bj)*recip_drf(k)/ras(i,j,bi,bj)* |
4329 |
$(hfaczclosedw*dyu(i,j,bi,bj)*recip_dxv(i,j,bi,bj)+hfaczclosede* |
4330 |
$dyu(i+1,j,bi,bj)*recip_dxv(i+1,j,bi,bj))*rkfac*drf(k)*viscah* |
4331 |
$cosfacv(j) |
4332 |
end do |
4333 |
end do |
4334 |
endif |
4335 |
do j = jmin, jmax |
4336 |
do i = imin, imax |
4337 |
adfmer(i,j-1) = adfmer(i,j-1)+adgv(i,j,k,bi,bj)*recip_hfacs(i, |
4338 |
$j,k,bi,bj)*recip_drf(k)*recip_ras(i,j,bi,bj) |
4339 |
adfmer(i,j) = adfmer(i,j)-adgv(i,j,k,bi,bj)*recip_hfacs(i,j,k, |
4340 |
$bi,bj)*recip_drf(k)*recip_ras(i,j,bi,bj) |
4341 |
adfverv(i,j,kdown) = adfverv(i,j,kdown)+adgv(i,j,k,bi,bj)* |
4342 |
$recip_hfacs(i,j,k,bi,bj)*recip_drf(k)*recip_ras(i,j,bi,bj)*rkfac |
4343 |
adfverv(i,j,kup) = adfverv(i,j,kup)-adgv(i,j,k,bi,bj)* |
4344 |
$recip_hfacs(i,j,k,bi,bj)*recip_drf(k)*recip_ras(i,j,bi,bj)*rkfac |
4345 |
adfzon(i+1,j) = adfzon(i+1,j)-adgv(i,j,k,bi,bj)*recip_hfacs(i, |
4346 |
$j,k,bi,bj)*recip_drf(k)*recip_ras(i,j,bi,bj) |
4347 |
adfzon(i,j) = adfzon(i,j)+adgv(i,j,k,bi,bj)*recip_hfacs(i,j,k, |
4348 |
$bi,bj)*recip_drf(k)*recip_ras(i,j,bi,bj) |
4349 |
adpf(i,j) = adpf(i,j)+adgv(i,j,k,bi,bj)*phyfac |
4350 |
adgv(i,j,k,bi,bj) = 0.d0 |
4351 |
end do |
4352 |
end do |
4353 |
do j = jmin, jmax |
4354 |
do i = imin, imax |
4355 |
adphihyd(i,j-1,k) = adphihyd(i,j-1,k)+adpf(i,j)*recip_dyc(i,j, |
4356 |
$bi,bj) |
4357 |
adphihyd(i,j,k) = adphihyd(i,j,k)-adpf(i,j)*recip_dyc(i,j,bi, |
4358 |
$bj) |
4359 |
adpf(i,j) = 0.d0 |
4360 |
end do |
4361 |
end do |
4362 |
if (implicitviscosity) then |
4363 |
do j = jmin, jmax |
4364 |
do i = imin, imax |
4365 |
adaf(i,j) = adaf(i,j)+adfverv(i,j,kdown)*rveldvdrfac |
4366 |
adfverv(i,j,kdown) = 0.d0 |
4367 |
end do |
4368 |
end do |
4369 |
else |
4370 |
do j = jmin, jmax |
4371 |
do i = imin, imax |
4372 |
adaf(i,j) = adaf(i,j)+adfverv(i,j,kdown)*rveldvdrfac |
4373 |
advf(i,j) = advf(i,j)+adfverv(i,j,kdown)*ardvdrfac |
4374 |
adfverv(i,j,kdown) = 0.d0 |
4375 |
end do |
4376 |
end do |
4377 |
endif |
4378 |
if ( .not. implicitviscosity) then |
4379 |
do j = jmin, jmax |
4380 |
do i = imin, imax |
4381 |
adkapparv(i,j,kp1) = adkapparv(i,j,kp1)-advf(i,j)*ras(i,j, |
4382 |
$bi,bj)*(vvel(i,j,k,bi,bj)-vvel(i,j,kp1,bi,bj))*rkfac* |
4383 |
$recip_drc(kp1)*masks(i,j,kp1,bi,bj) |
4384 |
advvel(i,j,k,bi,bj) = advvel(i,j,k,bi,bj)-advf(i,j)* |
4385 |
$kapparv(i,j,kp1)*ras(i,j,bi,bj)*rkfac*recip_drc(kp1)*masks(i,j, |
4386 |
$kp1,bi,bj) |
4387 |
advvel(i,j,kp1,bi,bj) = advvel(i,j,kp1,bi,bj)+advf(i,j)* |
4388 |
$kapparv(i,j,kp1)*ras(i,j,bi,bj)*rkfac*recip_drc(kp1)*masks(i,j, |
4389 |
$kp1,bi,bj) |
4390 |
advf(i,j) = 0.d0 |
4391 |
end do |
4392 |
end do |
4393 |
endif |
4394 |
do j = jmin, jmax |
4395 |
do i = imin, imax |
4396 |
advvel(i,j,k,bi,bj) = advvel(i,j,k,bi,bj)+0.25d0*adaf(i,j)* |
4397 |
$wvelbottomoverride*(wvel(i,j,kp1,bi,bj)*ra(i,j,bi,bj)+wvel(i,j-1, |
4398 |
$kp1,bi,bj)*ra(i,j-1,bi,bj)) |
4399 |
advvel(i,j,kp1,bi,bj) = advvel(i,j,kp1,bi,bj)+0.25d0*adaf(i,j) |
4400 |
$*wvelbottomoverride*(wvel(i,j,kp1,bi,bj)*ra(i,j,bi,bj)+wvel(i,j-1, |
4401 |
$kp1,bi,bj)*ra(i,j-1,bi,bj)) |
4402 |
adwvel(i,j-1,kp1,bi,bj) = adwvel(i,j-1,kp1,bi,bj)+0.25d0* |
4403 |
$adaf(i,j)*wvelbottomoverride*ra(i,j-1,bi,bj)*(vvel(i,j,kp1,bi,bj)+ |
4404 |
$vvel(i,j,k,bi,bj)) |
4405 |
adwvel(i,j,kp1,bi,bj) = adwvel(i,j,kp1,bi,bj)+0.25d0*adaf(i,j) |
4406 |
$*wvelbottomoverride*ra(i,j,bi,bj)*(vvel(i,j,kp1,bi,bj)+vvel(i,j,k, |
4407 |
$bi,bj)) |
4408 |
adaf(i,j) = 0.d0 |
4409 |
end do |
4410 |
end do |
4411 |
if (k .eq. 1) then |
4412 |
do j = jmin, jmax |
4413 |
do i = imin, imax |
4414 |
advvel(i,j,k,bi,bj) = advvel(i,j,k,bi,bj)+0.5*adfverv(i,j, |
4415 |
$kup)*rvelmaskoverride*(wvel(i,j,k,bi,bj)*ra(i,j,bi,bj)+wvel(i,j-1, |
4416 |
$k,bi,bj)*ra(i,j-1,bi,bj)) |
4417 |
adwvel(i,j-1,k,bi,bj) = adwvel(i,j-1,k,bi,bj)+0.5*adfverv(i, |
4418 |
$j,kup)*rvelmaskoverride*ra(i,j-1,bi,bj)*vvel(i,j,k,bi,bj) |
4419 |
adwvel(i,j,k,bi,bj) = adwvel(i,j,k,bi,bj)+0.5*adfverv(i,j, |
4420 |
$kup)*rvelmaskoverride*ra(i,j,bi,bj)*vvel(i,j,k,bi,bj) |
4421 |
adfverv(i,j,kup) = 0.d0 |
4422 |
end do |
4423 |
end do |
4424 |
endif |
4425 |
do j = jmin, jmax |
4426 |
do i = imin, imax |
4427 |
adaf(i,j) = adaf(i,j)+adfmer(i,j)*vdvdyfac |
4428 |
advf(i,j) = advf(i,j)+adfmer(i,j)*ahdvdyfac |
4429 |
adfmer(i,j) = 0.d0 |
4430 |
end do |
4431 |
end do |
4432 |
do j = jmin, jmax |
4433 |
do i = imin, imax |
4434 |
adv4f(i,j+1) = adv4f(i,j+1)+advf(i,j)*dxf(i,j,bi,bj)*drf(k)* |
4435 |
$hfacc(i,j,k,bi,bj)*visca4*cosfacu(j)*recip_dyf(i,j,bi,bj) |
4436 |
adv4f(i,j) = adv4f(i,j)-advf(i,j)*dxf(i,j,bi,bj)*drf(k)* |
4437 |
$hfacc(i,j,k,bi,bj)*visca4*cosfacu(j)*recip_dyf(i,j,bi,bj) |
4438 |
advvel(i,j+1,k,bi,bj) = advvel(i,j+1,k,bi,bj)-advf(i,j)*dxf(i, |
4439 |
$j,bi,bj)*drf(k)*hfacc(i,j,k,bi,bj)*viscah*cosfacu(j)*recip_dyf(i, |
4440 |
$j,bi,bj) |
4441 |
advvel(i,j,k,bi,bj) = advvel(i,j,k,bi,bj)+advf(i,j)*dxf(i,j, |
4442 |
$bi,bj)*drf(k)*hfacc(i,j,k,bi,bj)*viscah*cosfacu(j)*recip_dyf(i,j, |
4443 |
$bi,bj) |
4444 |
advf(i,j) = 0.d0 |
4445 |
end do |
4446 |
end do |
4447 |
do j = jmin, jmax |
4448 |
do i = imin, imax |
4449 |
advtrans(i,j+1) = advtrans(i,j+1)+0.25d0*adaf(i,j)*(vvel(i,j, |
4450 |
$k,bi,bj)+vvel(i,j+1,k,bi,bj)) |
4451 |
advtrans(i,j) = advtrans(i,j)+0.25d0*adaf(i,j)*(vvel(i,j,k,bi, |
4452 |
$bj)+vvel(i,j+1,k,bi,bj)) |
4453 |
advvel(i,j+1,k,bi,bj) = advvel(i,j+1,k,bi,bj)+0.25d0*adaf(i,j) |
4454 |
$*(vtrans(i,j)+vtrans(i,j+1)) |
4455 |
advvel(i,j,k,bi,bj) = advvel(i,j,k,bi,bj)+0.25d0*adaf(i,j)* |
4456 |
$(vtrans(i,j)+vtrans(i,j+1)) |
4457 |
adaf(i,j) = 0.d0 |
4458 |
end do |
4459 |
end do |
4460 |
do j = jmin, jmax |
4461 |
do i = imin, imax |
4462 |
adaf(i,j) = adaf(i,j)+adfzon(i,j)*udvdxfac |
4463 |
advf(i,j) = advf(i,j)+adfzon(i,j)*ahdvdxfac |
4464 |
adfzon(i,j) = 0.d0 |
4465 |
end do |
4466 |
end do |
4467 |
do j = jmin, jmax |
4468 |
do i = imin, imax |
4469 |
adv4f(i-1,j) = adv4f(i-1,j)-advf(i,j)*dyu(i,j,bi,bj)*drf(k)* |
4470 |
$hfacz(i,j)*visca4*cosfacv(j)*recip_dxv(i,j,bi,bj) |
4471 |
adv4f(i,j) = adv4f(i,j)+advf(i,j)*dyu(i,j,bi,bj)*drf(k)* |
4472 |
$hfacz(i,j)*visca4*cosfacv(j)*recip_dxv(i,j,bi,bj) |
4473 |
advvel(i-1,j,k,bi,bj) = advvel(i-1,j,k,bi,bj)+advf(i,j)*dyu(i, |
4474 |
$j,bi,bj)*drf(k)*hfacz(i,j)*viscah*cosfacv(j)*recip_dxv(i,j,bi,bj) |
4475 |
advvel(i,j,k,bi,bj) = advvel(i,j,k,bi,bj)-advf(i,j)*dyu(i,j, |
4476 |
$bi,bj)*drf(k)*hfacz(i,j)*viscah*cosfacv(j)*recip_dxv(i,j,bi,bj) |
4477 |
advf(i,j) = 0.d0 |
4478 |
end do |
4479 |
end do |
4480 |
do j = jmin, jmax |
4481 |
do i = imin, imax |
4482 |
adutrans(i,j-1) = adutrans(i,j-1)+0.25d0*adaf(i,j)*(vvel(i,j, |
4483 |
$k,bi,bj)+vvel(i-1,j,k,bi,bj)) |
4484 |
adutrans(i,j) = adutrans(i,j)+0.25d0*adaf(i,j)*(vvel(i,j,k,bi, |
4485 |
$bj)+vvel(i-1,j,k,bi,bj)) |
4486 |
advvel(i-1,j,k,bi,bj) = advvel(i-1,j,k,bi,bj)+0.25d0*adaf(i,j) |
4487 |
$*(utrans(i,j)+utrans(i,j-1)) |
4488 |
advvel(i,j,k,bi,bj) = advvel(i,j,k,bi,bj)+0.25d0*adaf(i,j)* |
4489 |
$(utrans(i,j)+utrans(i,j-1)) |
4490 |
adaf(i,j) = 0.d0 |
4491 |
end do |
4492 |
end do |
4493 |
if (no_slip_sides) then |
4494 |
do j = 0, sny+2 |
4495 |
do i = 0, snx+1 |
4496 |
hfaczclosedw = hfacs(i,j,k,bi,bj)-hfacz(i,j) |
4497 |
hfaczclosede = hfacs(i,j,k,bi,bj)-hfacz(i+1,j) |
4498 |
advvel(i,j,k,bi,bj) = advvel(i,j,k,bi,bj)-2*adv4f(i,j)* |
4499 |
$recip_hfacs(i,j,k,bi,bj)*recip_drf(k)*recip_ras(i,j,bi,bj)* |
4500 |
$(hfaczclosedw*dyu(i,j,bi,bj)*recip_dxv(i,j,bi,bj)+hfaczclosede* |
4501 |
$dyu(i+1,j,bi,bj)*recip_dxv(i+1,j,bi,bj))*drf(k)*masks(i,j,k,bi,bj) |
4502 |
end do |
4503 |
end do |
4504 |
endif |
4505 |
do j = 0, sny+2 |
4506 |
do i = 0, snx+1 |
4507 |
adfmer(i,j-1) = adfmer(i,j-1)-adv4f(i,j)*recip_drf(k)* |
4508 |
$recip_hfacs(i,j,k,bi,bj)*recip_ras(i,j,bi,bj)*masks(i,j,k,bi,bj) |
4509 |
adfmer(i,j) = adfmer(i,j)+adv4f(i,j)*recip_drf(k)* |
4510 |
$recip_hfacs(i,j,k,bi,bj)*recip_ras(i,j,bi,bj)*masks(i,j,k,bi,bj) |
4511 |
adfzon(i+1,j) = adfzon(i+1,j)+adv4f(i,j)*recip_drf(k)* |
4512 |
$recip_hfacs(i,j,k,bi,bj)*recip_ras(i,j,bi,bj)*masks(i,j,k,bi,bj) |
4513 |
adfzon(i,j) = adfzon(i,j)-adv4f(i,j)*recip_drf(k)* |
4514 |
$recip_hfacs(i,j,k,bi,bj)*recip_ras(i,j,bi,bj)*masks(i,j,k,bi,bj) |
4515 |
adv4f(i,j) = 0.d0 |
4516 |
end do |
4517 |
end do |
4518 |
do j = 1-oly, sny+oly-1 |
4519 |
do i = 1-olx, snx+olx |
4520 |
advvel(i,j+1,k,bi,bj) = advvel(i,j+1,k,bi,bj)+adfmer(i,j)* |
4521 |
$drf(k)*hfacc(i,j,k,bi,bj)*dxf(i,j,bi,bj)*recip_dyf(i,j,bi,bj) |
4522 |
advvel(i,j,k,bi,bj) = advvel(i,j,k,bi,bj)-adfmer(i,j)*drf(k)* |
4523 |
$hfacc(i,j,k,bi,bj)*dxf(i,j,bi,bj)*recip_dyf(i,j,bi,bj) |
4524 |
adfmer(i,j) = 0.d0 |
4525 |
end do |
4526 |
end do |
4527 |
do j = 1-oly, sny+oly |
4528 |
do i = 1-olx+1, snx+olx |
4529 |
advvel(i-1,j,k,bi,bj) = advvel(i-1,j,k,bi,bj)-adfzon(i,j)* |
4530 |
$drf(k)*hfacz(i,j)*dyu(i,j,bi,bj)*recip_dxv(i,j,bi,bj) |
4531 |
advvel(i,j,k,bi,bj) = advvel(i,j,k,bi,bj)+adfzon(i,j)*drf(k)* |
4532 |
$hfacz(i,j)*dyu(i,j,bi,bj)*recip_dxv(i,j,bi,bj) |
4533 |
adfzon(i,j) = 0.d0 |
4534 |
end do |
4535 |
end do |
4536 |
do j = jmin, jmax |
4537 |
do i = imin, imax |
4538 |
adgu(i,j,k,bi,bj) = adgu(i,j,k,bi,bj)*maskw(i,j,k,bi,bj) |
4539 |
end do |
4540 |
end do |
4541 |
if (usingsphericalpolarmterms) then |
4542 |
do j = jmin, jmax |
4543 |
do i = imin, imax |
4544 |
admt(i,j) = admt(i,j)+adgu(i,j,k,bi,bj)*mtfacu |
4545 |
end do |
4546 |
end do |
4547 |
do j = jmin, jmax |
4548 |
do i = imin, imax |
4549 |
aduvel(i,j,k,bi,bj) = aduvel(i,j,k,bi,bj)+0.25d0*admt(i,j)* |
4550 |
$recip_rsphere*(vvel(i,j,k,bi,bj)+vvel(i-1,j,k,bi,bj)+vvel(i,j+1,k, |
4551 |
$bi,bj)+vvel(i-1,j+1,k,bi,bj))*tanphiatu(i,j,bi,bj) |
4552 |
advvel(i-1,j+1,k,bi,bj) = advvel(i-1,j+1,k,bi,bj)+0.25d0* |
4553 |
$admt(i,j)*uvel(i,j,k,bi,bj)*recip_rsphere*tanphiatu(i,j,bi,bj) |
4554 |
advvel(i,j+1,k,bi,bj) = advvel(i,j+1,k,bi,bj)+0.25d0*admt(i, |
4555 |
$j)*uvel(i,j,k,bi,bj)*recip_rsphere*tanphiatu(i,j,bi,bj) |
4556 |
advvel(i-1,j,k,bi,bj) = advvel(i-1,j,k,bi,bj)+0.25d0*admt(i, |
4557 |
$j)*uvel(i,j,k,bi,bj)*recip_rsphere*tanphiatu(i,j,bi,bj) |
4558 |
advvel(i,j,k,bi,bj) = advvel(i,j,k,bi,bj)+0.25d0*admt(i,j)* |
4559 |
$uvel(i,j,k,bi,bj)*recip_rsphere*tanphiatu(i,j,bi,bj) |
4560 |
end do |
4561 |
end do |
4562 |
do j = jmin, jmax |
4563 |
do i = imin, imax |
4564 |
aduvel(i,j,k,bi,bj) = aduvel(i,j,k,bi,bj)-0.25d0*admt(i,j)* |
4565 |
$recip_rsphere*(wvelbottomoverride*(wvel(i-1,j,kp1,bi,bj)+wvel(i,j, |
4566 |
$kp1,bi,bj))+wvel(i-1,j,k,bi,bj)+wvel(i,j,k,bi,bj))*rkfac* |
4567 |
$recip_horivertratio |
4568 |
adwvel(i-1,j,k,bi,bj) = adwvel(i-1,j,k,bi,bj)-0.25d0*admt(i, |
4569 |
$j)*uvel(i,j,k,bi,bj)*recip_rsphere*rkfac*recip_horivertratio |
4570 |
adwvel(i,j,k,bi,bj) = adwvel(i,j,k,bi,bj)-0.25d0*admt(i,j)* |
4571 |
$uvel(i,j,k,bi,bj)*recip_rsphere*rkfac*recip_horivertratio |
4572 |
adwvel(i-1,j,kp1,bi,bj) = adwvel(i-1,j,kp1,bi,bj)-0.25d0* |
4573 |
$admt(i,j)*uvel(i,j,k,bi,bj)*recip_rsphere*wvelbottomoverride* |
4574 |
$rkfac*recip_horivertratio |
4575 |
adwvel(i,j,kp1,bi,bj) = adwvel(i,j,kp1,bi,bj)-0.25d0*admt(i, |
4576 |
$j)*uvel(i,j,k,bi,bj)*recip_rsphere*wvelbottomoverride*rkfac* |
4577 |
$recip_horivertratio |
4578 |
admt(i,j) = 0.d0 |
4579 |
end do |
4580 |
end do |
4581 |
endif |
4582 |
call adexternal_forcing_u( imin,imax,jmin,jmax,bi,bj,k ) |
4583 |
if (bottomdragterms) then |
4584 |
rdrckp1 = recip_drc(kp1) |
4585 |
if (k .eq. nr) then |
4586 |
rdrckp1 = recip_drf(k) |
4587 |
endif |
4588 |
do j = jmin, jmax |
4589 |
do i = imin, imax |
4590 |
maskdown = maskw(i,j,kp1,bi,bj) |
4591 |
if (k .eq. nr) then |
4592 |
maskdown = 0.d0 |
4593 |
endif |
4594 |
if (ke(i,j)+ke(i-1,j) .ne. 0.) then |
4595 |
adke(i-1,j) = adke(i-1,j)-adgu(i,j,k,bi,bj)*recip_hfacw(i, |
4596 |
$j,k,bi,bj)*recip_drf(k)*bottomdragquadratic*1./(2.*sqrt(ke(i,j)+ |
4597 |
$ke(i-1,j)))*(1.-maskdown)*uvel(i,j,k,bi,bj) |
4598 |
adke(i,j) = adke(i,j)-adgu(i,j,k,bi,bj)*recip_hfacw(i,j,k, |
4599 |
$bi,bj)*recip_drf(k)*bottomdragquadratic*1./(2.*sqrt(ke(i,j)+ke(i- |
4600 |
$1,j)))*(1.-maskdown)*uvel(i,j,k,bi,bj) |
4601 |
aduvel(i,j,k,bi,bj) = aduvel(i,j,k,bi,bj)-adgu(i,j,k,bi, |
4602 |
$bj)*recip_hfacw(i,j,k,bi,bj)*recip_drf(k)*bottomdragquadratic*(1.- |
4603 |
$maskdown)*sqrt(ke(i,j)+ke(i-1,j)) |
4604 |
endif |
4605 |
adkapparu(i,j,kp1) = adkapparu(i,j,kp1)-2*adgu(i,j,k,bi,bj)* |
4606 |
$recip_hfacw(i,j,k,bi,bj)*recip_drf(k)*rkfac*rdrckp1*(1.-maskdown)* |
4607 |
$uvel(i,j,k,bi,bj) |
4608 |
aduvel(i,j,k,bi,bj) = aduvel(i,j,k,bi,bj)-adgu(i,j,k,bi,bj)* |
4609 |
$recip_hfacw(i,j,k,bi,bj)*recip_drf(k)*(2.*kapparu(i,j,kp1)*rkfac* |
4610 |
$rdrckp1+bottomdraglinear)*(1.-maskdown) |
4611 |
end do |
4612 |
end do |
4613 |
endif |
4614 |
if (no_slip_sides) then |
4615 |
do j = jmin, jmax |
4616 |
do i = imin, imax |
4617 |
hfaczcloseds = hfacw(i,j,k,bi,bj)-hfacz(i,j) |
4618 |
hfaczclosedn = hfacw(i,j,k,bi,bj)-hfacz(i,j+1) |
4619 |
aduvel(i,j,k,bi,bj) = aduvel(i,j,k,bi,bj)-2.*adgu(i,j,k,bi, |
4620 |
$bj)*recip_hfacw(i,j,k,bi,bj)*recip_drf(k)*recip_raw(i,j,bi,bj)* |
4621 |
$(hfaczcloseds*dxv(i,j,bi,bj)*recip_dyu(i,j,bi,bj)+hfaczclosedn* |
4622 |
$dxv(i,j+1,bi,bj)*recip_dyu(i,j+1,bi,bj))*drf(k)*viscah*cosfacu(j) |
4623 |
adv4f(i,j) = adv4f(i,j)+2.*adgu(i,j,k,bi,bj)*recip_hfacw(i, |
4624 |
$j,k,bi,bj)*recip_drf(k)*recip_raw(i,j,bi,bj)*(hfaczcloseds*dxv(i, |
4625 |
$j,bi,bj)*recip_dyu(i,j,bi,bj)+hfaczclosedn*dxv(i,j+1,bi,bj)* |
4626 |
$recip_dyu(i,j+1,bi,bj))*drf(k)*visca4*cosfacu(j) |
4627 |
end do |
4628 |
end do |
4629 |
endif |
4630 |
do j = jmin, jmax |
4631 |
do i = imin, imax |
4632 |
adfmer(i,j+1) = adfmer(i,j+1)-adgu(i,j,k,bi,bj)*recip_hfacw(i, |
4633 |
$j,k,bi,bj)*recip_drf(k)*recip_raw(i,j,bi,bj) |
4634 |
adfmer(i,j) = adfmer(i,j)+adgu(i,j,k,bi,bj)*recip_hfacw(i,j,k, |
4635 |
$bi,bj)*recip_drf(k)*recip_raw(i,j,bi,bj) |
4636 |
adfveru(i,j,kdown) = adfveru(i,j,kdown)+adgu(i,j,k,bi,bj)* |
4637 |
$recip_hfacw(i,j,k,bi,bj)*recip_drf(k)*recip_raw(i,j,bi,bj)*rkfac |
4638 |
adfveru(i,j,kup) = adfveru(i,j,kup)-adgu(i,j,k,bi,bj)* |
4639 |
$recip_hfacw(i,j,k,bi,bj)*recip_drf(k)*recip_raw(i,j,bi,bj)*rkfac |
4640 |
adfzon(i-1,j) = adfzon(i-1,j)+adgu(i,j,k,bi,bj)*recip_hfacw(i, |
4641 |
$j,k,bi,bj)*recip_drf(k)*recip_raw(i,j,bi,bj) |
4642 |
adfzon(i,j) = adfzon(i,j)-adgu(i,j,k,bi,bj)*recip_hfacw(i,j,k, |
4643 |
$bi,bj)*recip_drf(k)*recip_raw(i,j,bi,bj) |
4644 |
adpf(i,j) = adpf(i,j)+adgu(i,j,k,bi,bj)*phxfac |
4645 |
adgu(i,j,k,bi,bj) = 0.d0 |
4646 |
end do |
4647 |
end do |
4648 |
do j = jmin, jmax |
4649 |
do i = imin, imax |
4650 |
adphihyd(i-1,j,k) = adphihyd(i-1,j,k)+adpf(i,j)*recip_dxc(i,j, |
4651 |
$bi,bj) |
4652 |
adphihyd(i,j,k) = adphihyd(i,j,k)-adpf(i,j)*recip_dxc(i,j,bi, |
4653 |
$bj) |
4654 |
adpf(i,j) = 0.d0 |
4655 |
end do |
4656 |
end do |
4657 |
if (implicitviscosity) then |
4658 |
do j = jmin, jmax |
4659 |
do i = imin, imax |
4660 |
adaf(i,j) = adaf(i,j)+adfveru(i,j,kdown)*rveldudrfac |
4661 |
adfveru(i,j,kdown) = 0.d0 |
4662 |
end do |
4663 |
end do |
4664 |
else |
4665 |
do j = jmin, jmax |
4666 |
do i = imin, imax |
4667 |
adaf(i,j) = adaf(i,j)+adfveru(i,j,kdown)*rveldudrfac |
4668 |
advf(i,j) = advf(i,j)+adfveru(i,j,kdown)*ardudrfac |
4669 |
adfveru(i,j,kdown) = 0.d0 |
4670 |
end do |
4671 |
end do |
4672 |
endif |
4673 |
if ( .not. implicitviscosity) then |
4674 |
do j = jmin, jmax |
4675 |
do i = imin, imax |
4676 |
adkapparu(i,j,kp1) = adkapparu(i,j,kp1)-advf(i,j)*raw(i,j, |
4677 |
$bi,bj)*(uvel(i,j,k,bi,bj)-uvel(i,j,kp1,bi,bj))*rkfac* |
4678 |
$recip_drc(kp1)*maskw(i,j,kp1,bi,bj) |
4679 |
aduvel(i,j,k,bi,bj) = aduvel(i,j,k,bi,bj)-advf(i,j)* |
4680 |
$kapparu(i,j,kp1)*raw(i,j,bi,bj)*rkfac*recip_drc(kp1)*maskw(i,j, |
4681 |
$kp1,bi,bj) |
4682 |
aduvel(i,j,kp1,bi,bj) = aduvel(i,j,kp1,bi,bj)+advf(i,j)* |
4683 |
$kapparu(i,j,kp1)*raw(i,j,bi,bj)*rkfac*recip_drc(kp1)*maskw(i,j, |
4684 |
$kp1,bi,bj) |
4685 |
advf(i,j) = 0.d0 |
4686 |
end do |
4687 |
end do |
4688 |
endif |
4689 |
do j = jmin, jmax |
4690 |
do i = imin, imax |
4691 |
aduvel(i,j,k,bi,bj) = aduvel(i,j,k,bi,bj)+0.25d0*adaf(i,j)* |
4692 |
$wvelbottomoverride*(wvel(i,j,kp1,bi,bj)*ra(i,j,bi,bj)+wvel(i-1,j, |
4693 |
$kp1,bi,bj)*ra(i-1,j,bi,bj)) |
4694 |
aduvel(i,j,kp1,bi,bj) = aduvel(i,j,kp1,bi,bj)+0.25d0*adaf(i,j) |
4695 |
$*wvelbottomoverride*(wvel(i,j,kp1,bi,bj)*ra(i,j,bi,bj)+wvel(i-1,j, |
4696 |
$kp1,bi,bj)*ra(i-1,j,bi,bj)) |
4697 |
adwvel(i-1,j,kp1,bi,bj) = adwvel(i-1,j,kp1,bi,bj)+0.25d0* |
4698 |
$adaf(i,j)*wvelbottomoverride*ra(i-1,j,bi,bj)*(uvel(i,j,kp1,bi,bj)+ |
4699 |
$uvel(i,j,k,bi,bj)) |
4700 |
adwvel(i,j,kp1,bi,bj) = adwvel(i,j,kp1,bi,bj)+0.25d0*adaf(i,j) |
4701 |
$*wvelbottomoverride*ra(i,j,bi,bj)*(uvel(i,j,kp1,bi,bj)+uvel(i,j,k, |
4702 |
$bi,bj)) |
4703 |
adaf(i,j) = 0.d0 |
4704 |
end do |
4705 |
end do |
4706 |
if (k .eq. 1) then |
4707 |
do j = jmin, jmax |
4708 |
do i = imin, imax |
4709 |
aduvel(i,j,k,bi,bj) = aduvel(i,j,k,bi,bj)+0.5*adfveru(i,j, |
4710 |
$kup)*rvelmaskoverride*(wvel(i,j,k,bi,bj)*ra(i,j,bi,bj)+wvel(i-1,j, |
4711 |
$k,bi,bj)*ra(i-1,j,bi,bj)) |
4712 |
adwvel(i-1,j,k,bi,bj) = adwvel(i-1,j,k,bi,bj)+0.5*adfveru(i, |
4713 |
$j,kup)*rvelmaskoverride*ra(i-1,j,bi,bj)*uvel(i,j,k,bi,bj) |
4714 |
adwvel(i,j,k,bi,bj) = adwvel(i,j,k,bi,bj)+0.5*adfveru(i,j, |
4715 |
$kup)*rvelmaskoverride*ra(i,j,bi,bj)*uvel(i,j,k,bi,bj) |
4716 |
adfveru(i,j,kup) = 0.d0 |
4717 |
end do |
4718 |
end do |
4719 |
endif |
4720 |
do j = jmin, jmax |
4721 |
do i = imin, imax |
4722 |
adaf(i,j) = adaf(i,j)+adfmer(i,j)*vdudyfac |
4723 |
advf(i,j) = advf(i,j)+adfmer(i,j)*ahdudyfac |
4724 |
adfmer(i,j) = 0.d0 |
4725 |
end do |
4726 |
end do |
4727 |
do j = jmin, jmax |
4728 |
do i = imin, imax |
4729 |
aduvel(i,j-1,k,bi,bj) = aduvel(i,j-1,k,bi,bj)+advf(i,j)*dxv(i, |
4730 |
$j,bi,bj)*drf(k)*hfacz(i,j)*viscah*cosfacv(j)*recip_dyu(i,j,bi,bj) |
4731 |
aduvel(i,j,k,bi,bj) = aduvel(i,j,k,bi,bj)-advf(i,j)*dxv(i,j, |
4732 |
$bi,bj)*drf(k)*hfacz(i,j)*viscah*cosfacv(j)*recip_dyu(i,j,bi,bj) |
4733 |
adv4f(i,j-1) = adv4f(i,j-1)-advf(i,j)*dxv(i,j,bi,bj)*drf(k)* |
4734 |
$hfacz(i,j)*visca4*cosfacv(j)*recip_dyu(i,j,bi,bj) |
4735 |
adv4f(i,j) = adv4f(i,j)+advf(i,j)*dxv(i,j,bi,bj)*drf(k)* |
4736 |
$hfacz(i,j)*visca4*cosfacv(j)*recip_dyu(i,j,bi,bj) |
4737 |
advf(i,j) = 0.d0 |
4738 |
end do |
4739 |
end do |
4740 |
do j = jmin, jmax |
4741 |
do i = imin, imax |
4742 |
aduvel(i,j-1,k,bi,bj) = aduvel(i,j-1,k,bi,bj)+0.25d0*adaf(i,j) |
4743 |
$*(vtrans(i,j)+vtrans(i-1,j)) |
4744 |
aduvel(i,j,k,bi,bj) = aduvel(i,j,k,bi,bj)+0.25d0*adaf(i,j)* |
4745 |
$(vtrans(i,j)+vtrans(i-1,j)) |
4746 |
advtrans(i-1,j) = advtrans(i-1,j)+0.25d0*adaf(i,j)*(uvel(i,j, |
4747 |
$k,bi,bj)+uvel(i,j-1,k,bi,bj)) |
4748 |
advtrans(i,j) = advtrans(i,j)+0.25d0*adaf(i,j)*(uvel(i,j,k,bi, |
4749 |
$bj)+uvel(i,j-1,k,bi,bj)) |
4750 |
adaf(i,j) = 0.d0 |
4751 |
end do |
4752 |
end do |
4753 |
do j = jmin, jmax |
4754 |
do i = imin, imax |
4755 |
adaf(i,j) = adaf(i,j)+adfzon(i,j)*ududxfac |
4756 |
advf(i,j) = advf(i,j)+adfzon(i,j)*ahdudxfac |
4757 |
adfzon(i,j) = 0.d0 |
4758 |
end do |
4759 |
end do |
4760 |
do j = jmin, jmax |
4761 |
do i = imin, imax |
4762 |
aduvel(i+1,j,k,bi,bj) = aduvel(i+1,j,k,bi,bj)-advf(i,j)*dyf(i, |
4763 |
$j,bi,bj)*drf(k)*hfacc(i,j,k,bi,bj)*viscah*cosfacu(j)*recip_dxf(i, |
4764 |
$j,bi,bj) |
4765 |
aduvel(i,j,k,bi,bj) = aduvel(i,j,k,bi,bj)+advf(i,j)*dyf(i,j, |
4766 |
$bi,bj)*drf(k)*hfacc(i,j,k,bi,bj)*viscah*cosfacu(j)*recip_dxf(i,j, |
4767 |
$bi,bj) |
4768 |
adv4f(i+1,j) = adv4f(i+1,j)+advf(i,j)*dyf(i,j,bi,bj)*drf(k)* |
4769 |
$hfacc(i,j,k,bi,bj)*visca4*cosfacu(j)*recip_dxf(i,j,bi,bj) |
4770 |
adv4f(i,j) = adv4f(i,j)-advf(i,j)*dyf(i,j,bi,bj)*drf(k)* |
4771 |
$hfacc(i,j,k,bi,bj)*visca4*cosfacu(j)*recip_dxf(i,j,bi,bj) |
4772 |
advf(i,j) = 0.d0 |
4773 |
end do |
4774 |
end do |
4775 |
do j = jmin, jmax |
4776 |
do i = imin, imax |
4777 |
adutrans(i+1,j) = adutrans(i+1,j)+0.25d0*adaf(i,j)*(uvel(i,j, |
4778 |
$k,bi,bj)+uvel(i+1,j,k,bi,bj)) |
4779 |
adutrans(i,j) = adutrans(i,j)+0.25d0*adaf(i,j)*(uvel(i,j,k,bi, |
4780 |
$bj)+uvel(i+1,j,k,bi,bj)) |
4781 |
aduvel(i+1,j,k,bi,bj) = aduvel(i+1,j,k,bi,bj)+0.25d0*adaf(i,j) |
4782 |
$*(utrans(i,j)+utrans(i+1,j)) |
4783 |
aduvel(i,j,k,bi,bj) = aduvel(i,j,k,bi,bj)+0.25d0*adaf(i,j)* |
4784 |
$(utrans(i,j)+utrans(i+1,j)) |
4785 |
adaf(i,j) = 0.d0 |
4786 |
end do |
4787 |
end do |
4788 |
if (no_slip_sides) then |
4789 |
do j = 0, sny+1 |
4790 |
do i = 0, snx+2 |
4791 |
hfaczcloseds = hfacw(i,j,k,bi,bj)-hfacz(i,j) |
4792 |
hfaczclosedn = hfacw(i,j,k,bi,bj)-hfacz(i,j+1) |
4793 |
aduvel(i,j,k,bi,bj) = aduvel(i,j,k,bi,bj)-2*adv4f(i,j)* |
4794 |
$recip_hfacw(i,j,k,bi,bj)*recip_drf(k)*recip_raw(i,j,bi,bj)* |
4795 |
$(hfaczcloseds*dxv(i,j,bi,bj)*recip_dyu(i,j,bi,bj)+hfaczclosedn* |
4796 |
$dxv(i,j+1,bi,bj)*recip_dyu(i,j+1,bi,bj))*drf(k)*maskw(i,j,k,bi,bj) |
4797 |
end do |
4798 |
end do |
4799 |
endif |
4800 |
do j = 0, sny+1 |
4801 |
do i = 0, snx+2 |
4802 |
adfmer(i,j+1) = adfmer(i,j+1)+adv4f(i,j)*recip_drf(k)* |
4803 |
$recip_hfacw(i,j,k,bi,bj)*recip_raw(i,j,bi,bj)*maskw(i,j,k,bi,bj) |
4804 |
adfmer(i,j) = adfmer(i,j)-adv4f(i,j)*recip_drf(k)* |
4805 |
$recip_hfacw(i,j,k,bi,bj)*recip_raw(i,j,bi,bj)*maskw(i,j,k,bi,bj) |
4806 |
adfzon(i-1,j) = adfzon(i-1,j)-adv4f(i,j)*recip_drf(k)* |
4807 |
$recip_hfacw(i,j,k,bi,bj)*recip_raw(i,j,bi,bj)*maskw(i,j,k,bi,bj) |
4808 |
adfzon(i,j) = adfzon(i,j)+adv4f(i,j)*recip_drf(k)* |
4809 |
$recip_hfacw(i,j,k,bi,bj)*recip_raw(i,j,bi,bj)*maskw(i,j,k,bi,bj) |
4810 |
adv4f(i,j) = 0.d0 |
4811 |
end do |
4812 |
end do |
4813 |
do j = 1-oly+1, sny+oly |
4814 |
do i = 1-olx, snx+olx |
4815 |
aduvel(i,j-1,k,bi,bj) = aduvel(i,j-1,k,bi,bj)-adfmer(i,j)* |
4816 |
$drf(k)*hfacz(i,j)*dxv(i,j,bi,bj)*recip_dyu(i,j,bi,bj) |
4817 |
aduvel(i,j,k,bi,bj) = aduvel(i,j,k,bi,bj)+adfmer(i,j)*drf(k)* |
4818 |
$hfacz(i,j)*dxv(i,j,bi,bj)*recip_dyu(i,j,bi,bj) |
4819 |
adfmer(i,j) = 0.d0 |
4820 |
end do |
4821 |
end do |
4822 |
do j = 1-oly, sny+oly |
4823 |
do i = 1-olx, snx+olx-1 |
4824 |
aduvel(i+1,j,k,bi,bj) = aduvel(i+1,j,k,bi,bj)+adfzon(i,j)* |
4825 |
$drf(k)*hfacc(i,j,k,bi,bj)*dyf(i,j,bi,bj)*recip_dxf(i,j,bi,bj) |
4826 |
aduvel(i,j,k,bi,bj) = aduvel(i,j,k,bi,bj)-adfzon(i,j)*drf(k)* |
4827 |
$hfacc(i,j,k,bi,bj)*dyf(i,j,bi,bj)*recip_dxf(i,j,bi,bj) |
4828 |
adfzon(i,j) = 0.d0 |
4829 |
end do |
4830 |
end do |
4831 |
do j = 1-oly, sny+oly |
4832 |
do i = 1-olx, snx+olx |
4833 |
advvel(i,j,k,bi,bj) = advvel(i,j,k,bi,bj)+advtrans(i,j)*ya(i, |
4834 |
$j) |
4835 |
advtrans(i,j) = 0.d0 |
4836 |
aduvel(i,j,k,bi,bj) = aduvel(i,j,k,bi,bj)+adutrans(i,j)*xa(i, |
4837 |
$j) |
4838 |
adutrans(i,j) = 0.d0 |
4839 |
end do |
4840 |
end do |
4841 |
do j = 1-oly, sny+oly-1 |
4842 |
do i = 1-olx, snx+olx-1 |
4843 |
aduvel(i+1,j,k,bi,bj) = aduvel(i+1,j,k,bi,bj)+0.5*adke(i,j)* |
4844 |
$uvel(i+1,j,k,bi,bj) |
4845 |
aduvel(i,j,k,bi,bj) = aduvel(i,j,k,bi,bj)+0.5*adke(i,j)* |
4846 |
$uvel(i,j,k,bi,bj) |
4847 |
advvel(i,j+1,k,bi,bj) = advvel(i,j+1,k,bi,bj)+0.5*adke(i,j)* |
4848 |
$vvel(i,j+1,k,bi,bj) |
4849 |
advvel(i,j,k,bi,bj) = advvel(i,j,k,bi,bj)+0.5*adke(i,j)* |
4850 |
$vvel(i,j,k,bi,bj) |
4851 |
adke(i,j) = 0.d0 |
4852 |
end do |
4853 |
end do |
4854 |
|
4855 |
end |
4856 |
|
4857 |
|
4858 |
subroutine mdcalc_phi_hyd( bi, bj, imin, imax, jmin, jmax, k, |
4859 |
$theta, salt, phihyd, mythid ) |
4860 |
C*************************************************************** |
4861 |
C*************************************************************** |
4862 |
C** This routine was generated by the ** |
4863 |
C** Tangent linear and Adjoint Model Compiler, TAMC 5.2.14 ** |
4864 |
C*************************************************************** |
4865 |
C*************************************************************** |
4866 |
C============================================== |
4867 |
C all entries are defined explicitly |
4868 |
C============================================== |
4869 |
implicit none |
4870 |
|
4871 |
C============================================== |
4872 |
C define parameters |
4873 |
C============================================== |
4874 |
integer max_len_fnam |
4875 |
parameter ( max_len_fnam = 512 ) |
4876 |
integer max_no_threads |
4877 |
parameter ( max_no_threads = 32 ) |
4878 |
integer maxnochkptlev |
4879 |
parameter ( maxnochkptlev = 2 ) |
4880 |
integer npx |
4881 |
parameter ( npx = 1 ) |
4882 |
integer npy |
4883 |
parameter ( npy = 1 ) |
4884 |
integer nr |
4885 |
parameter ( nr = 15 ) |
4886 |
integer nsx |
4887 |
parameter ( nsx = 1 ) |
4888 |
integer nsy |
4889 |
parameter ( nsy = 1 ) |
4890 |
integer snx |
4891 |
parameter ( snx = 20 ) |
4892 |
integer nx |
4893 |
parameter ( nx = snx*nsx*npx ) |
4894 |
integer sny |
4895 |
parameter ( sny = 40 ) |
4896 |
integer ny |
4897 |
parameter ( ny = sny*nsy*npy ) |
4898 |
integer olx |
4899 |
parameter ( olx = 3 ) |
4900 |
integer oly |
4901 |
parameter ( oly = 3 ) |
4902 |
|
4903 |
C============================================== |
4904 |
C define common blocks |
4905 |
C============================================== |
4906 |
common /cadsalv/ salth |
4907 |
real*4 salth(1+snx+olx-(1-olx),1+sny+oly-(1-oly),540) |
4908 |
|
4909 |
common /cadthetc/ thetah |
4910 |
real*4 thetah(1+snx+olx-(1-olx),1+sny+oly-(1-oly),540) |
4911 |
|
4912 |
common /eeparams_i/ errormessageunit, standardmessageunit, |
4913 |
$scrunit1, scrunit2, eedataunit, modeldataunit, numberofprocs, |
4914 |
$pidio, myprocid, mypx, mypy, myxgloballo, myygloballo, nthreads, |
4915 |
$mybxlo, mybxhi, mybylo, mybyhi, ntx, nty, ioerrorcount |
4916 |
integer eedataunit |
4917 |
integer errormessageunit |
4918 |
integer ioerrorcount(max_no_threads) |
4919 |
integer modeldataunit |
4920 |
integer mybxhi(max_no_threads) |
4921 |
integer mybxlo(max_no_threads) |
4922 |
integer mybyhi(max_no_threads) |
4923 |
integer mybylo(max_no_threads) |
4924 |
integer myprocid |
4925 |
integer mypx |
4926 |
integer mypy |
4927 |
integer myxgloballo |
4928 |
integer myygloballo |
4929 |
integer nthreads |
4930 |
integer ntx |
4931 |
integer nty |
4932 |
integer numberofprocs |
4933 |
integer pidio |
4934 |
integer scrunit1 |
4935 |
integer scrunit2 |
4936 |
integer standardmessageunit |
4937 |
|
4938 |
common /grid_r/ dxc, dxf, dxg, dxv, dyc, dyf, dyg, dyu, drc, drf, |
4939 |
$h, hfacc, hfacw, hfacs, depthink, recip_dxc, recip_dxf, recip_dxg, |
4940 |
$ recip_dxv, recip_dyc, recip_dyf, recip_dyg, recip_dyu, recip_drc, |
4941 |
$ recip_drf, recip_h, recip_hfacc, recip_hfacw, recip_hfacs, rkfac, |
4942 |
$ recip_rkfac, safac, xc, yc, ra, raw, ras, raz, rc, rf, yc0, xc0, |
4943 |
$xg, yg, maskw, masks, recip_ra, recip_raw, recip_ras, recip_raz, |
4944 |
$tanphiatu, tanphiatv |
4945 |
double precision depthink(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
4946 |
double precision drc(1:nr) |
4947 |
double precision drf(1:nr) |
4948 |
double precision dxc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
4949 |
double precision dxf(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
4950 |
double precision dxg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
4951 |
double precision dxv(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
4952 |
double precision dyc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
4953 |
double precision dyf(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
4954 |
double precision dyg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
4955 |
double precision dyu(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
4956 |
double precision h(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
4957 |
double precision hfacc(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) |
4958 |
double precision hfacs(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) |
4959 |
double precision hfacw(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) |
4960 |
double precision masks(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) |
4961 |
double precision maskw(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) |
4962 |
double precision ra(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
4963 |
double precision ras(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
4964 |
double precision raw(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
4965 |
double precision raz(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
4966 |
double precision rc(1:nr) |
4967 |
double precision recip_drc(1:nr) |
4968 |
double precision recip_drf(1:nr) |
4969 |
double precision recip_dxc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
4970 |
double precision recip_dxf(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
4971 |
double precision recip_dxg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
4972 |
double precision recip_dxv(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
4973 |
double precision recip_dyc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
4974 |
double precision recip_dyf(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
4975 |
double precision recip_dyg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
4976 |
double precision recip_dyu(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
4977 |
double precision recip_h(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
4978 |
double precision recip_hfacc(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx, |
4979 |
$nsy) |
4980 |
double precision recip_hfacs(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx, |
4981 |
$nsy) |
4982 |
double precision recip_hfacw(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx, |
4983 |
$nsy) |
4984 |
double precision recip_ra(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
4985 |
double precision recip_ras(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
4986 |
double precision recip_raw(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
4987 |
double precision recip_raz(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
4988 |
double precision recip_rkfac |
4989 |
double precision rf(1:nr+1) |
4990 |
double precision rkfac |
4991 |
double precision safac(1:nr) |
4992 |
double precision tanphiatu(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
4993 |
double precision tanphiatv(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
4994 |
double precision xc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
4995 |
double precision xc0 |
4996 |
double precision xg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
4997 |
double precision yc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
4998 |
double precision yc0 |
4999 |
double precision yg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
5000 |
|
5001 |
common /parm_c/ checkptsuff, bathyfile, hydrogthetafile, |
5002 |
$hydrogsaltfile, zonalwindfile, meridwindfile, thetaclimfile, |
5003 |
$saltclimfile, buoyancyrelation, empmrfile, surfqfile, surfqswfile, |
5004 |
$ uvelinitfile, vvelinitfile, psurfinitfile, dqdtfile |
5005 |
character*(max_len_fnam) bathyfile |
5006 |
character*(max_len_fnam) buoyancyrelation |
5007 |
character*(5) checkptsuff(maxnochkptlev) |
5008 |
character*(max_len_fnam) dqdtfile |
5009 |
character*(max_len_fnam) empmrfile |
5010 |
character*(max_len_fnam) hydrogsaltfile |
5011 |
character*(max_len_fnam) hydrogthetafile |
5012 |
character*(max_len_fnam) meridwindfile |
5013 |
character*(max_len_fnam) psurfinitfile |
5014 |
character*(max_len_fnam) saltclimfile |
5015 |
character*(max_len_fnam) surfqfile |
5016 |
character*(max_len_fnam) surfqswfile |
5017 |
character*(max_len_fnam) thetaclimfile |
5018 |
character*(max_len_fnam) uvelinitfile |
5019 |
character*(max_len_fnam) vvelinitfile |
5020 |
character*(max_len_fnam) zonalwindfile |
5021 |
|
5022 |
common /parm_eos_lin/ talpha, sbeta, eostype |
5023 |
character*(6) eostype |
5024 |
double precision sbeta |
5025 |
double precision talpha |
5026 |
|
5027 |
common /parm_r/ cg2dtargetresidual, cg2dpcoffdfac, |
5028 |
$cg3dtargetresidual, delp, delz, delr, delx, dely, deltat, |
5029 |
$deltatmom, deltattracer, deltatclock, abeps, starttime, phimin, |
5030 |
$thetamin, rsphere, recip_rsphere, f0, fcori, beta, viscah, viscaz, |
5031 |
$ visca4, viscar, diffkht, diffkzt, diffk4t, diffkrt, diffkhs, |
5032 |
$diffkzs, diffk4s, diffkrs, delt, taucd, rcd, freesurffac, |
5033 |
$implicsurfpress, implicdiv2dflow, hfacmin, hfacmindz, gravity, |
5034 |
$recip_gravity, gbaro, rhonil, recip_rhonil, recip_rhoconst, |
5035 |
$rhoconst, tref, sref, endtime, chkptfreq, pchkptfreq, dumpfreq, |
5036 |
$tavefreq, affacmom, vffacmom, pffacmom, cffacmom, fofacmom, |
5037 |
$mtfacmom, cospower, cadjfreq, omega, tauthetaclimrelax, |
5038 |
$lambdathetaclimrelax, tausaltclimrelax, lambdasaltclimrelax, |
5039 |
$externforcingcycle, externforcingperiod, viscap, diffkpt, diffkps, |
5040 |
$ hfacmindr, hfacmindp, theta_s, specvol_s, horivertratio, |
5041 |
$recip_horivertratio, latfftfiltlo, ivdc_kappa, ro_sealevel, |
5042 |
$zonal_filt_lat, bottomdraglinear, bottomdragquadratic |
5043 |
double precision abeps |
5044 |
double precision affacmom |
5045 |
double precision beta |
5046 |
double precision bottomdraglinear |
5047 |
double precision bottomdragquadratic |
5048 |
double precision cadjfreq |
5049 |
double precision cffacmom |
5050 |
double precision cg2dpcoffdfac |
5051 |
double precision cg2dtargetresidual |
5052 |
double precision cg3dtargetresidual |
5053 |
double precision chkptfreq |
5054 |
double precision cospower |
5055 |
double precision delp(nr) |
5056 |
double precision delr(nr) |
5057 |
double precision delt |
5058 |
double precision deltat |
5059 |
double precision deltatclock |
5060 |
double precision deltatmom |
5061 |
double precision deltattracer |
5062 |
double precision delx(nx) |
5063 |
double precision dely(ny) |
5064 |
double precision delz(nr) |
5065 |
double precision diffk4s |
5066 |
double precision diffk4t |
5067 |
double precision diffkhs |
5068 |
double precision diffkht |
5069 |
double precision diffkps |
5070 |
double precision diffkpt |
5071 |
double precision diffkrs |
5072 |
double precision diffkrt |
5073 |
double precision diffkzs |
5074 |
double precision diffkzt |
5075 |
double precision dumpfreq |
5076 |
double precision endtime |
5077 |
double precision externforcingcycle |
5078 |
double precision externforcingperiod |
5079 |
double precision f0 |
5080 |
double precision fcori(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
5081 |
double precision fofacmom |
5082 |
double precision freesurffac |
5083 |
double precision gbaro |
5084 |
double precision gravity |
5085 |
double precision hfacmin |
5086 |
double precision hfacmindp |
5087 |
double precision hfacmindr |
5088 |
double precision hfacmindz |
5089 |
double precision horivertratio |
5090 |
double precision implicdiv2dflow |
5091 |
double precision implicsurfpress |
5092 |
double precision ivdc_kappa |
5093 |
double precision lambdasaltclimrelax |
5094 |
double precision lambdathetaclimrelax |
5095 |
double precision latfftfiltlo |
5096 |
double precision mtfacmom |
5097 |
double precision omega |
5098 |
double precision pchkptfreq |
5099 |
double precision pffacmom |
5100 |
double precision phimin |
5101 |
double precision rcd |
5102 |
double precision recip_gravity |
5103 |
double precision recip_horivertratio |
5104 |
double precision recip_rhoconst |
5105 |
double precision recip_rhonil |
5106 |
double precision recip_rsphere |
5107 |
double precision rhoconst |
5108 |
double precision rhonil |
5109 |
double precision ro_sealevel |
5110 |
double precision rsphere |
5111 |
double precision specvol_s(nr) |
5112 |
double precision sref(nr) |
5113 |
double precision starttime |
5114 |
double precision taucd |
5115 |
double precision tausaltclimrelax |
5116 |
double precision tauthetaclimrelax |
5117 |
double precision tavefreq |
5118 |
double precision theta_s(nr) |
5119 |
double precision thetamin |
5120 |
double precision tref(nr) |
5121 |
double precision vffacmom |
5122 |
double precision visca4 |
5123 |
double precision viscah |
5124 |
double precision viscap |
5125 |
double precision viscar |
5126 |
double precision viscaz |
5127 |
double precision zonal_filt_lat |
5128 |
|
5129 |
common /tamc_keys_i/ ikey_dynamics, ikey_yearly, ikey_daily_1, |
5130 |
$ikey_daily_2, iloop_daily |
5131 |
integer ikey_daily_1 |
5132 |
integer ikey_daily_2 |
5133 |
integer ikey_dynamics |
5134 |
integer ikey_yearly |
5135 |
integer iloop_daily |
5136 |
|
5137 |
common /tamckeys/ key, ikey, idkey |
5138 |
integer idkey |
5139 |
integer ikey |
5140 |
integer key |
5141 |
|
5142 |
C============================================== |
5143 |
C define arguments |
5144 |
C============================================== |
5145 |
integer bi |
5146 |
integer bj |
5147 |
integer imax |
5148 |
integer imin |
5149 |
integer jmax |
5150 |
integer jmin |
5151 |
integer k |
5152 |
integer mythid |
5153 |
double precision phihyd(1-olx:snx+olx,1-oly:sny+oly,nr) |
5154 |
double precision salt(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
5155 |
double precision theta(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
5156 |
|
5157 |
C============================================== |
5158 |
C define local variables |
5159 |
C============================================== |
5160 |
integer act1 |
5161 |
integer act2 |
5162 |
integer act3 |
5163 |
integer act4 |
5164 |
double precision alpharho(1-olx:snx+olx,1-oly:sny+oly) |
5165 |
double precision atm_cp |
5166 |
double precision atm_kappa |
5167 |
double precision atm_po |
5168 |
double precision ddrm |
5169 |
double precision ddrm1 |
5170 |
double precision ddrp |
5171 |
double precision ddrp1 |
5172 |
double precision drloc |
5173 |
double precision drlockp1 |
5174 |
integer i |
5175 |
integer ip1 |
5176 |
integer ip2 |
5177 |
integer j |
5178 |
integer kkey |
5179 |
integer max1 |
5180 |
integer max2 |
5181 |
integer max3 |
5182 |
|
5183 |
C********************************************** |
5184 |
C executable statements of routine |
5185 |
C********************************************** |
5186 |
act1 = bi-mybxlo(mythid) |
5187 |
max1 = mybxhi(mythid)-mybxlo(mythid)+1 |
5188 |
act2 = bj-mybylo(mythid) |
5189 |
max2 = mybyhi(mythid)-mybylo(mythid)+1 |
5190 |
act3 = mythid-1 |
5191 |
max3 = ntx*nty |
5192 |
act4 = ikey_dynamics-1 |
5193 |
ikey = act1+1+act2*max1+act3*max1*max2+act4*max1*max2*max3 |
5194 |
if (buoyancyrelation .eq. 'OCEANIC') then |
5195 |
drloc = drc(k) |
5196 |
if (k .eq. 1) then |
5197 |
drloc = drf(1) |
5198 |
endif |
5199 |
if (k .eq. nr) then |
5200 |
drlockp1 = 0. |
5201 |
else |
5202 |
drlockp1 = drc(k+1) |
5203 |
endif |
5204 |
if (k .eq. 1) then |
5205 |
do j = jmin, jmax |
5206 |
do i = imin, imax |
5207 |
phihyd(i,j,k) = 0. |
5208 |
end do |
5209 |
end do |
5210 |
endif |
5211 |
kkey = (ikey-1)*nr+k |
5212 |
do ip2 = 1, 1+sny+oly-(1-oly) |
5213 |
do ip1 = 1, 1+snx+olx-(1-olx) |
5214 |
thetah(ip1,ip2,kkey) = theta(ip1-1+1-olx,ip2-1+1-oly,k,bi, |
5215 |
$bj) |
5216 |
end do |
5217 |
end do |
5218 |
do ip2 = 1, 1+sny+oly-(1-oly) |
5219 |
do ip1 = 1, 1+snx+olx-(1-olx) |
5220 |
salth(ip1,ip2,kkey) = salt(ip1-1+1-olx,ip2-1+1-oly,k,bi,bj) |
5221 |
end do |
5222 |
end do |
5223 |
call find_rho( bi,bj,imin,imax,jmin,jmax,k,k,eostype,theta,salt, |
5224 |
$alpharho,mythid ) |
5225 |
do j = jmin, jmax |
5226 |
do i = imin, imax |
5227 |
phihyd(i,j,k) = phihyd(i,j,k)+0.5*drloc*gravity*alpharho(i, |
5228 |
$j)*recip_rhoconst |
5229 |
if (k .lt. nr) then |
5230 |
phihyd(i,j,k+1) = phihyd(i,j,k)+0.5*drlockp1*gravity* |
5231 |
$alpharho(i,j)*recip_rhoconst |
5232 |
endif |
5233 |
end do |
5234 |
end do |
5235 |
else if (buoyancyrelation .eq. 'ATMOSPHERIC') then |
5236 |
atm_cp = 1004.d0 |
5237 |
atm_kappa = 2.d0/7.d0 |
5238 |
atm_po = 1.d+5 |
5239 |
if (k .eq. 1) then |
5240 |
ddrp1 = atm_cp*((rc(k)/atm_po)**atm_kappa-(rf(k)/atm_po)** |
5241 |
$atm_kappa) |
5242 |
do j = jmin, jmax |
5243 |
do i = imin, imax |
5244 |
ddrp = ddrp1 |
5245 |
if (hfacc(i,j,k,bi,bj) .eq. 0.) then |
5246 |
ddrp = 0. |
5247 |
endif |
5248 |
phihyd(i,j,k) = 0.-ddrp*(theta(i,j,k,bi,bj)-tref(k)) |
5249 |
end do |
5250 |
end do |
5251 |
else |
5252 |
ddrp1 = atm_cp*((rc(k)/atm_po)**atm_kappa-(rc(k-1)/atm_po)** |
5253 |
$atm_kappa)*0.5 |
5254 |
ddrm1 = ddrp1 |
5255 |
do j = jmin, jmax |
5256 |
do i = imin, imax |
5257 |
ddrp = ddrp1 |
5258 |
ddrm = ddrm1 |
5259 |
if (hfacc(i,j,k,bi,bj) .eq. 0.) then |
5260 |
ddrp = 0. |
5261 |
endif |
5262 |
if (hfacc(i,j,k-1,bi,bj) .eq. 0.) then |
5263 |
ddrm = 0. |
5264 |
endif |
5265 |
phihyd(i,j,k) = phihyd(i,j,k-1)-(ddrm*(theta(i,j,k-1,bi, |
5266 |
$bj)-tref(k-1))+ddrp*(theta(i,j,k,bi,bj)-tref(k))) |
5267 |
end do |
5268 |
end do |
5269 |
endif |
5270 |
endif |
5271 |
end |
5272 |
|
5273 |
|
5274 |
subroutine adcalc_phi_hyd( bi, bj, imin, imax, jmin, jmax, k, |
5275 |
$mythid, adtheta, adsalt, adphihyd ) |
5276 |
C*************************************************************** |
5277 |
C*************************************************************** |
5278 |
C** This routine was generated by the ** |
5279 |
C** Tangent linear and Adjoint Model Compiler, TAMC 5.2.14 ** |
5280 |
C*************************************************************** |
5281 |
C*************************************************************** |
5282 |
C============================================== |
5283 |
C all entries are defined explicitly |
5284 |
C============================================== |
5285 |
implicit none |
5286 |
|
5287 |
C============================================== |
5288 |
C define parameters |
5289 |
C============================================== |
5290 |
integer max_len_fnam |
5291 |
parameter ( max_len_fnam = 512 ) |
5292 |
integer max_no_threads |
5293 |
parameter ( max_no_threads = 32 ) |
5294 |
integer maxnochkptlev |
5295 |
parameter ( maxnochkptlev = 2 ) |
5296 |
integer npx |
5297 |
parameter ( npx = 1 ) |
5298 |
integer npy |
5299 |
parameter ( npy = 1 ) |
5300 |
integer nr |
5301 |
parameter ( nr = 15 ) |
5302 |
integer nsx |
5303 |
parameter ( nsx = 1 ) |
5304 |
integer nsy |
5305 |
parameter ( nsy = 1 ) |
5306 |
integer snx |
5307 |
parameter ( snx = 20 ) |
5308 |
integer nx |
5309 |
parameter ( nx = snx*nsx*npx ) |
5310 |
integer sny |
5311 |
parameter ( sny = 40 ) |
5312 |
integer ny |
5313 |
parameter ( ny = sny*nsy*npy ) |
5314 |
integer olx |
5315 |
parameter ( olx = 3 ) |
5316 |
integer oly |
5317 |
parameter ( oly = 3 ) |
5318 |
|
5319 |
C============================================== |
5320 |
C define common blocks |
5321 |
C============================================== |
5322 |
common /cadsalv/ salth |
5323 |
real*4 salth(1+snx+olx-(1-olx),1+sny+oly-(1-oly),540) |
5324 |
|
5325 |
common /cadthetc/ thetah |
5326 |
real*4 thetah(1+snx+olx-(1-olx),1+sny+oly-(1-oly),540) |
5327 |
|
5328 |
common /eeparams_i/ errormessageunit, standardmessageunit, |
5329 |
$scrunit1, scrunit2, eedataunit, modeldataunit, numberofprocs, |
5330 |
$pidio, myprocid, mypx, mypy, myxgloballo, myygloballo, nthreads, |
5331 |
$mybxlo, mybxhi, mybylo, mybyhi, ntx, nty, ioerrorcount |
5332 |
integer eedataunit |
5333 |
integer errormessageunit |
5334 |
integer ioerrorcount(max_no_threads) |
5335 |
integer modeldataunit |
5336 |
integer mybxhi(max_no_threads) |
5337 |
integer mybxlo(max_no_threads) |
5338 |
integer mybyhi(max_no_threads) |
5339 |
integer mybylo(max_no_threads) |
5340 |
integer myprocid |
5341 |
integer mypx |
5342 |
integer mypy |
5343 |
integer myxgloballo |
5344 |
integer myygloballo |
5345 |
integer nthreads |
5346 |
integer ntx |
5347 |
integer nty |
5348 |
integer numberofprocs |
5349 |
integer pidio |
5350 |
integer scrunit1 |
5351 |
integer scrunit2 |
5352 |
integer standardmessageunit |
5353 |
|
5354 |
common /grid_r/ dxc, dxf, dxg, dxv, dyc, dyf, dyg, dyu, drc, drf, |
5355 |
$h, hfacc, hfacw, hfacs, depthink, recip_dxc, recip_dxf, recip_dxg, |
5356 |
$ recip_dxv, recip_dyc, recip_dyf, recip_dyg, recip_dyu, recip_drc, |
5357 |
$ recip_drf, recip_h, recip_hfacc, recip_hfacw, recip_hfacs, rkfac, |
5358 |
$ recip_rkfac, safac, xc, yc, ra, raw, ras, raz, rc, rf, yc0, xc0, |
5359 |
$xg, yg, maskw, masks, recip_ra, recip_raw, recip_ras, recip_raz, |
5360 |
$tanphiatu, tanphiatv |
5361 |
double precision depthink(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
5362 |
double precision drc(1:nr) |
5363 |
double precision drf(1:nr) |
5364 |
double precision dxc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
5365 |
double precision dxf(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
5366 |
double precision dxg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
5367 |
double precision dxv(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
5368 |
double precision dyc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
5369 |
double precision dyf(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
5370 |
double precision dyg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
5371 |
double precision dyu(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
5372 |
double precision h(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
5373 |
double precision hfacc(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) |
5374 |
double precision hfacs(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) |
5375 |
double precision hfacw(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) |
5376 |
double precision masks(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) |
5377 |
double precision maskw(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) |
5378 |
double precision ra(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
5379 |
double precision ras(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
5380 |
double precision raw(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
5381 |
double precision raz(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
5382 |
double precision rc(1:nr) |
5383 |
double precision recip_drc(1:nr) |
5384 |
double precision recip_drf(1:nr) |
5385 |
double precision recip_dxc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
5386 |
double precision recip_dxf(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
5387 |
double precision recip_dxg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
5388 |
double precision recip_dxv(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
5389 |
double precision recip_dyc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
5390 |
double precision recip_dyf(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
5391 |
double precision recip_dyg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
5392 |
double precision recip_dyu(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
5393 |
double precision recip_h(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
5394 |
double precision recip_hfacc(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx, |
5395 |
$nsy) |
5396 |
double precision recip_hfacs(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx, |
5397 |
$nsy) |
5398 |
double precision recip_hfacw(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx, |
5399 |
$nsy) |
5400 |
double precision recip_ra(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
5401 |
double precision recip_ras(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
5402 |
double precision recip_raw(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
5403 |
double precision recip_raz(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
5404 |
double precision recip_rkfac |
5405 |
double precision rf(1:nr+1) |
5406 |
double precision rkfac |
5407 |
double precision safac(1:nr) |
5408 |
double precision tanphiatu(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
5409 |
double precision tanphiatv(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
5410 |
double precision xc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
5411 |
double precision xc0 |
5412 |
double precision xg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
5413 |
double precision yc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
5414 |
double precision yc0 |
5415 |
double precision yg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
5416 |
|
5417 |
common /parm_c/ checkptsuff, bathyfile, hydrogthetafile, |
5418 |
$hydrogsaltfile, zonalwindfile, meridwindfile, thetaclimfile, |
5419 |
$saltclimfile, buoyancyrelation, empmrfile, surfqfile, surfqswfile, |
5420 |
$ uvelinitfile, vvelinitfile, psurfinitfile, dqdtfile |
5421 |
character*(max_len_fnam) bathyfile |
5422 |
character*(max_len_fnam) buoyancyrelation |
5423 |
character*(5) checkptsuff(maxnochkptlev) |
5424 |
character*(max_len_fnam) dqdtfile |
5425 |
character*(max_len_fnam) empmrfile |
5426 |
character*(max_len_fnam) hydrogsaltfile |
5427 |
character*(max_len_fnam) hydrogthetafile |
5428 |
character*(max_len_fnam) meridwindfile |
5429 |
character*(max_len_fnam) psurfinitfile |
5430 |
character*(max_len_fnam) saltclimfile |
5431 |
character*(max_len_fnam) surfqfile |
5432 |
character*(max_len_fnam) surfqswfile |
5433 |
character*(max_len_fnam) thetaclimfile |
5434 |
character*(max_len_fnam) uvelinitfile |
5435 |
character*(max_len_fnam) vvelinitfile |
5436 |
character*(max_len_fnam) zonalwindfile |
5437 |
|
5438 |
common /parm_eos_lin/ talpha, sbeta, eostype |
5439 |
character*(6) eostype |
5440 |
double precision sbeta |
5441 |
double precision talpha |
5442 |
|
5443 |
common /parm_r/ cg2dtargetresidual, cg2dpcoffdfac, |
5444 |
$cg3dtargetresidual, delp, delz, delr, delx, dely, deltat, |
5445 |
$deltatmom, deltattracer, deltatclock, abeps, starttime, phimin, |
5446 |
$thetamin, rsphere, recip_rsphere, f0, fcori, beta, viscah, viscaz, |
5447 |
$ visca4, viscar, diffkht, diffkzt, diffk4t, diffkrt, diffkhs, |
5448 |
$diffkzs, diffk4s, diffkrs, delt, taucd, rcd, freesurffac, |
5449 |
$implicsurfpress, implicdiv2dflow, hfacmin, hfacmindz, gravity, |
5450 |
$recip_gravity, gbaro, rhonil, recip_rhonil, recip_rhoconst, |
5451 |
$rhoconst, tref, sref, endtime, chkptfreq, pchkptfreq, dumpfreq, |
5452 |
$tavefreq, affacmom, vffacmom, pffacmom, cffacmom, fofacmom, |
5453 |
$mtfacmom, cospower, cadjfreq, omega, tauthetaclimrelax, |
5454 |
$lambdathetaclimrelax, tausaltclimrelax, lambdasaltclimrelax, |
5455 |
$externforcingcycle, externforcingperiod, viscap, diffkpt, diffkps, |
5456 |
$ hfacmindr, hfacmindp, theta_s, specvol_s, horivertratio, |
5457 |
$recip_horivertratio, latfftfiltlo, ivdc_kappa, ro_sealevel, |
5458 |
$zonal_filt_lat, bottomdraglinear, bottomdragquadratic |
5459 |
double precision abeps |
5460 |
double precision affacmom |
5461 |
double precision beta |
5462 |
double precision bottomdraglinear |
5463 |
double precision bottomdragquadratic |
5464 |
double precision cadjfreq |
5465 |
double precision cffacmom |
5466 |
double precision cg2dpcoffdfac |
5467 |
double precision cg2dtargetresidual |
5468 |
double precision cg3dtargetresidual |
5469 |
double precision chkptfreq |
5470 |
double precision cospower |
5471 |
double precision delp(nr) |
5472 |
double precision delr(nr) |
5473 |
double precision delt |
5474 |
double precision deltat |
5475 |
double precision deltatclock |
5476 |
double precision deltatmom |
5477 |
double precision deltattracer |
5478 |
double precision delx(nx) |
5479 |
double precision dely(ny) |
5480 |
double precision delz(nr) |
5481 |
double precision diffk4s |
5482 |
double precision diffk4t |
5483 |
double precision diffkhs |
5484 |
double precision diffkht |
5485 |
double precision diffkps |
5486 |
double precision diffkpt |
5487 |
double precision diffkrs |
5488 |
double precision diffkrt |
5489 |
double precision diffkzs |
5490 |
double precision diffkzt |
5491 |
double precision dumpfreq |
5492 |
double precision endtime |
5493 |
double precision externforcingcycle |
5494 |
double precision externforcingperiod |
5495 |
double precision f0 |
5496 |
double precision fcori(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
5497 |
double precision fofacmom |
5498 |
double precision freesurffac |
5499 |
double precision gbaro |
5500 |
double precision gravity |
5501 |
double precision hfacmin |
5502 |
double precision hfacmindp |
5503 |
double precision hfacmindr |
5504 |
double precision hfacmindz |
5505 |
double precision horivertratio |
5506 |
double precision implicdiv2dflow |
5507 |
double precision implicsurfpress |
5508 |
double precision ivdc_kappa |
5509 |
double precision lambdasaltclimrelax |
5510 |
double precision lambdathetaclimrelax |
5511 |
double precision latfftfiltlo |
5512 |
double precision mtfacmom |
5513 |
double precision omega |
5514 |
double precision pchkptfreq |
5515 |
double precision pffacmom |
5516 |
double precision phimin |
5517 |
double precision rcd |
5518 |
double precision recip_gravity |
5519 |
double precision recip_horivertratio |
5520 |
double precision recip_rhoconst |
5521 |
double precision recip_rhonil |
5522 |
double precision recip_rsphere |
5523 |
double precision rhoconst |
5524 |
double precision rhonil |
5525 |
double precision ro_sealevel |
5526 |
double precision rsphere |
5527 |
double precision specvol_s(nr) |
5528 |
double precision sref(nr) |
5529 |
double precision starttime |
5530 |
double precision taucd |
5531 |
double precision tausaltclimrelax |
5532 |
double precision tauthetaclimrelax |
5533 |
double precision tavefreq |
5534 |
double precision theta_s(nr) |
5535 |
double precision thetamin |
5536 |
double precision tref(nr) |
5537 |
double precision vffacmom |
5538 |
double precision visca4 |
5539 |
double precision viscah |
5540 |
double precision viscap |
5541 |
double precision viscar |
5542 |
double precision viscaz |
5543 |
double precision zonal_filt_lat |
5544 |
|
5545 |
common /tamc_keys_i/ ikey_dynamics, ikey_yearly, ikey_daily_1, |
5546 |
$ikey_daily_2, iloop_daily |
5547 |
integer ikey_daily_1 |
5548 |
integer ikey_daily_2 |
5549 |
integer ikey_dynamics |
5550 |
integer ikey_yearly |
5551 |
integer iloop_daily |
5552 |
|
5553 |
common /tamckeys/ key, ikey, idkey |
5554 |
integer idkey |
5555 |
integer ikey |
5556 |
integer key |
5557 |
|
5558 |
C============================================== |
5559 |
C define arguments |
5560 |
C============================================== |
5561 |
double precision adphihyd(1-olx:snx+olx,1-oly:sny+oly,nr) |
5562 |
double precision adsalt(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
5563 |
double precision adtheta(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
5564 |
integer bi |
5565 |
integer bj |
5566 |
integer imax |
5567 |
integer imin |
5568 |
integer jmax |
5569 |
integer jmin |
5570 |
integer k |
5571 |
integer mythid |
5572 |
|
5573 |
C============================================== |
5574 |
C define local variables |
5575 |
C============================================== |
5576 |
integer act1 |
5577 |
integer act2 |
5578 |
integer act3 |
5579 |
integer act4 |
5580 |
double precision adalpharho(1-olx:snx+olx,1-oly:sny+oly) |
5581 |
double precision adphihydh |
5582 |
double precision atm_cp |
5583 |
double precision atm_kappa |
5584 |
double precision atm_po |
5585 |
double precision ddrm |
5586 |
double precision ddrm1 |
5587 |
double precision ddrp |
5588 |
double precision ddrp1 |
5589 |
double precision drloc |
5590 |
double precision drlockp1 |
5591 |
integer i |
5592 |
integer ip1 |
5593 |
integer ip2 |
5594 |
integer j |
5595 |
integer kkey |
5596 |
integer max1 |
5597 |
integer max2 |
5598 |
integer max3 |
5599 |
double precision salt(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
5600 |
double precision theta(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
5601 |
|
5602 |
C---------------------------------------------- |
5603 |
C RESET LOCAL ADJOINT VARIABLES |
5604 |
C---------------------------------------------- |
5605 |
do ip2 = 1-oly, sny+oly |
5606 |
do ip1 = 1-olx, snx+olx |
5607 |
adalpharho(ip1,ip2) = 0.d0 |
5608 |
end do |
5609 |
end do |
5610 |
|
5611 |
C---------------------------------------------- |
5612 |
C ROUTINE BODY |
5613 |
C---------------------------------------------- |
5614 |
act1 = bi-mybxlo(mythid) |
5615 |
max1 = mybxhi(mythid)-mybxlo(mythid)+1 |
5616 |
act2 = bj-mybylo(mythid) |
5617 |
max2 = mybyhi(mythid)-mybylo(mythid)+1 |
5618 |
act3 = mythid-1 |
5619 |
max3 = ntx*nty |
5620 |
act4 = ikey_dynamics-1 |
5621 |
ikey = act1+1+act2*max1+act3*max1*max2+act4*max1*max2*max3 |
5622 |
if (buoyancyrelation .eq. 'OCEANIC') then |
5623 |
drloc = drc(k) |
5624 |
if (k .eq. 1) then |
5625 |
drloc = drf(1) |
5626 |
endif |
5627 |
if (k .eq. nr) then |
5628 |
drlockp1 = 0. |
5629 |
else |
5630 |
drlockp1 = drc(k+1) |
5631 |
endif |
5632 |
kkey = (ikey-1)*nr+k |
5633 |
do ip2 = 1, 1+sny+oly-(1-oly) |
5634 |
do ip1 = 1, 1+snx+olx-(1-olx) |
5635 |
theta(ip1-1+1-olx,ip2-1+1-oly,k,bi,bj) = thetah(ip1,ip2, |
5636 |
$kkey) |
5637 |
end do |
5638 |
end do |
5639 |
do ip2 = 1, 1+sny+oly-(1-oly) |
5640 |
do ip1 = 1, 1+snx+olx-(1-olx) |
5641 |
salt(ip1-1+1-olx,ip2-1+1-oly,k,bi,bj) = salth(ip1,ip2,kkey) |
5642 |
end do |
5643 |
end do |
5644 |
do j = jmin, jmax |
5645 |
do i = imin, imax |
5646 |
if (k .lt. nr) then |
5647 |
adalpharho(i,j) = adalpharho(i,j)+0.5*adphihyd(i,j,k+1)* |
5648 |
$drlockp1*gravity*recip_rhoconst |
5649 |
adphihyd(i,j,k) = adphihyd(i,j,k)+adphihyd(i,j,k+1) |
5650 |
adphihyd(i,j,k+1) = 0.d0 |
5651 |
endif |
5652 |
adphihydh = adphihyd(i,j,k) |
5653 |
adphihyd(i,j,k) = 0.d0 |
5654 |
adalpharho(i,j) = adalpharho(i,j)+0.5*adphihydh*drloc* |
5655 |
$gravity*recip_rhoconst |
5656 |
adphihyd(i,j,k) = adphihyd(i,j,k)+adphihydh |
5657 |
end do |
5658 |
end do |
5659 |
call adfind_rho( bi,bj,imin,imax,jmin,jmax,k,k,eostype,theta, |
5660 |
$salt,adtheta,adsalt,adalpharho ) |
5661 |
if (k .eq. 1) then |
5662 |
do j = jmin, jmax |
5663 |
do i = imin, imax |
5664 |
adphihyd(i,j,k) = 0.d0 |
5665 |
end do |
5666 |
end do |
5667 |
endif |
5668 |
else if (buoyancyrelation .eq. 'ATMOSPHERIC') then |
5669 |
atm_cp = 1004.d0 |
5670 |
atm_kappa = 2.d0/7.d0 |
5671 |
atm_po = 1.d+5 |
5672 |
if (k .eq. 1) then |
5673 |
ddrp1 = atm_cp*((rc(k)/atm_po)**atm_kappa-(rf(k)/atm_po)** |
5674 |
$atm_kappa) |
5675 |
do j = jmin, jmax |
5676 |
do i = imin, imax |
5677 |
ddrp = ddrp1 |
5678 |
if (hfacc(i,j,k,bi,bj) .eq. 0.) then |
5679 |
ddrp = 0. |
5680 |
endif |
5681 |
adtheta(i,j,k,bi,bj) = adtheta(i,j,k,bi,bj)-adphihyd(i,j, |
5682 |
$k)*ddrp |
5683 |
adphihyd(i,j,k) = 0.d0 |
5684 |
end do |
5685 |
end do |
5686 |
else |
5687 |
ddrp1 = atm_cp*((rc(k)/atm_po)**atm_kappa-(rc(k-1)/atm_po)** |
5688 |
$atm_kappa)*0.5 |
5689 |
ddrm1 = ddrp1 |
5690 |
do j = jmin, jmax |
5691 |
do i = imin, imax |
5692 |
ddrp = ddrp1 |
5693 |
ddrm = ddrm1 |
5694 |
if (hfacc(i,j,k,bi,bj) .eq. 0.) then |
5695 |
ddrp = 0. |
5696 |
endif |
5697 |
if (hfacc(i,j,k-1,bi,bj) .eq. 0.) then |
5698 |
ddrm = 0. |
5699 |
endif |
5700 |
adtheta(i,j,k-1,bi,bj) = adtheta(i,j,k-1,bi,bj)- |
5701 |
$adphihyd(i,j,k)*ddrm |
5702 |
adtheta(i,j,k,bi,bj) = adtheta(i,j,k,bi,bj)-adphihyd(i,j, |
5703 |
$k)*ddrp |
5704 |
adphihyd(i,j,k-1) = adphihyd(i,j,k-1)+adphihyd(i,j,k) |
5705 |
adphihyd(i,j,k) = 0.d0 |
5706 |
end do |
5707 |
end do |
5708 |
endif |
5709 |
endif |
5710 |
|
5711 |
end |
5712 |
|
5713 |
|
5714 |
subroutine adconvect( bi, bj, imin, imax, jmin, jmax, k, rhokm1, |
5715 |
$rhokp1, mytime, adrhokm1, adrhokp1 ) |
5716 |
C*************************************************************** |
5717 |
C*************************************************************** |
5718 |
C** This routine was generated by the ** |
5719 |
C** Tangent linear and Adjoint Model Compiler, TAMC 5.2.14 ** |
5720 |
C*************************************************************** |
5721 |
C*************************************************************** |
5722 |
C============================================== |
5723 |
C all entries are defined explicitly |
5724 |
C============================================== |
5725 |
implicit none |
5726 |
|
5727 |
C============================================== |
5728 |
C define parameters |
5729 |
C============================================== |
5730 |
integer npx |
5731 |
parameter ( npx = 1 ) |
5732 |
integer npy |
5733 |
parameter ( npy = 1 ) |
5734 |
integer nr |
5735 |
parameter ( nr = 15 ) |
5736 |
integer nsx |
5737 |
parameter ( nsx = 1 ) |
5738 |
integer nsy |
5739 |
parameter ( nsy = 1 ) |
5740 |
integer snx |
5741 |
parameter ( snx = 20 ) |
5742 |
integer nx |
5743 |
parameter ( nx = snx*nsx*npx ) |
5744 |
integer sny |
5745 |
parameter ( sny = 40 ) |
5746 |
integer ny |
5747 |
parameter ( ny = sny*nsy*npy ) |
5748 |
integer olx |
5749 |
parameter ( olx = 3 ) |
5750 |
integer oly |
5751 |
parameter ( oly = 3 ) |
5752 |
|
5753 |
C============================================== |
5754 |
C define common blocks |
5755 |
C============================================== |
5756 |
common /addynvars_r/ adetan, aduvel, advvel, adwvel, adtheta, |
5757 |
$adsalt, adgu, adgv, adgt, adgs, adgunm1, adgvnm1, adgtnm1, adgsnm1 |
5758 |
double precision adetan(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
5759 |
double precision adgs(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
5760 |
double precision adgsnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
5761 |
double precision adgt(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
5762 |
double precision adgtnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
5763 |
double precision adgu(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
5764 |
double precision adgunm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
5765 |
double precision adgv(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
5766 |
double precision adgvnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
5767 |
double precision adsalt(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
5768 |
double precision adtheta(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
5769 |
double precision aduvel(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
5770 |
double precision advvel(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
5771 |
double precision adwvel(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
5772 |
|
5773 |
common /grid_r/ dxc, dxf, dxg, dxv, dyc, dyf, dyg, dyu, drc, drf, |
5774 |
$h, hfacc, hfacw, hfacs, depthink, recip_dxc, recip_dxf, recip_dxg, |
5775 |
$ recip_dxv, recip_dyc, recip_dyf, recip_dyg, recip_dyu, recip_drc, |
5776 |
$ recip_drf, recip_h, recip_hfacc, recip_hfacw, recip_hfacs, rkfac, |
5777 |
$ recip_rkfac, safac, xc, yc, ra, raw, ras, raz, rc, rf, yc0, xc0, |
5778 |
$xg, yg, maskw, masks, recip_ra, recip_raw, recip_ras, recip_raz, |
5779 |
$tanphiatu, tanphiatv |
5780 |
double precision depthink(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
5781 |
double precision drc(1:nr) |
5782 |
double precision drf(1:nr) |
5783 |
double precision dxc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
5784 |
double precision dxf(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
5785 |
double precision dxg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
5786 |
double precision dxv(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
5787 |
double precision dyc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
5788 |
double precision dyf(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
5789 |
double precision dyg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
5790 |
double precision dyu(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
5791 |
double precision h(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
5792 |
double precision hfacc(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) |
5793 |
double precision hfacs(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) |
5794 |
double precision hfacw(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) |
5795 |
double precision masks(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) |
5796 |
double precision maskw(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) |
5797 |
double precision ra(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
5798 |
double precision ras(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
5799 |
double precision raw(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
5800 |
double precision raz(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
5801 |
double precision rc(1:nr) |
5802 |
double precision recip_drc(1:nr) |
5803 |
double precision recip_drf(1:nr) |
5804 |
double precision recip_dxc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
5805 |
double precision recip_dxf(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
5806 |
double precision recip_dxg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
5807 |
double precision recip_dxv(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
5808 |
double precision recip_dyc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
5809 |
double precision recip_dyf(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
5810 |
double precision recip_dyg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
5811 |
double precision recip_dyu(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
5812 |
double precision recip_h(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
5813 |
double precision recip_hfacc(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx, |
5814 |
$nsy) |
5815 |
double precision recip_hfacs(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx, |
5816 |
$nsy) |
5817 |
double precision recip_hfacw(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx, |
5818 |
$nsy) |
5819 |
double precision recip_ra(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
5820 |
double precision recip_ras(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
5821 |
double precision recip_raw(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
5822 |
double precision recip_raz(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
5823 |
double precision recip_rkfac |
5824 |
double precision rf(1:nr+1) |
5825 |
double precision rkfac |
5826 |
double precision safac(1:nr) |
5827 |
double precision tanphiatu(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
5828 |
double precision tanphiatv(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
5829 |
double precision xc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
5830 |
double precision xc0 |
5831 |
double precision xg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
5832 |
double precision yc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
5833 |
double precision yc0 |
5834 |
double precision yg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
5835 |
|
5836 |
common /parm_r/ cg2dtargetresidual, cg2dpcoffdfac, |
5837 |
$cg3dtargetresidual, delp, delz, delr, delx, dely, deltat, |
5838 |
$deltatmom, deltattracer, deltatclock, abeps, starttime, phimin, |
5839 |
$thetamin, rsphere, recip_rsphere, f0, fcori, beta, viscah, viscaz, |
5840 |
$ visca4, viscar, diffkht, diffkzt, diffk4t, diffkrt, diffkhs, |
5841 |
$diffkzs, diffk4s, diffkrs, delt, taucd, rcd, freesurffac, |
5842 |
$implicsurfpress, implicdiv2dflow, hfacmin, hfacmindz, gravity, |
5843 |
$recip_gravity, gbaro, rhonil, recip_rhonil, recip_rhoconst, |
5844 |
$rhoconst, tref, sref, endtime, chkptfreq, pchkptfreq, dumpfreq, |
5845 |
$tavefreq, affacmom, vffacmom, pffacmom, cffacmom, fofacmom, |
5846 |
$mtfacmom, cospower, cadjfreq, omega, tauthetaclimrelax, |
5847 |
$lambdathetaclimrelax, tausaltclimrelax, lambdasaltclimrelax, |
5848 |
$externforcingcycle, externforcingperiod, viscap, diffkpt, diffkps, |
5849 |
$ hfacmindr, hfacmindp, theta_s, specvol_s, horivertratio, |
5850 |
$recip_horivertratio, latfftfiltlo, ivdc_kappa, ro_sealevel, |
5851 |
$zonal_filt_lat, bottomdraglinear, bottomdragquadratic |
5852 |
double precision abeps |
5853 |
double precision affacmom |
5854 |
double precision beta |
5855 |
double precision bottomdraglinear |
5856 |
double precision bottomdragquadratic |
5857 |
double precision cadjfreq |
5858 |
double precision cffacmom |
5859 |
double precision cg2dpcoffdfac |
5860 |
double precision cg2dtargetresidual |
5861 |
double precision cg3dtargetresidual |
5862 |
double precision chkptfreq |
5863 |
double precision cospower |
5864 |
double precision delp(nr) |
5865 |
double precision delr(nr) |
5866 |
double precision delt |
5867 |
double precision deltat |
5868 |
double precision deltatclock |
5869 |
double precision deltatmom |
5870 |
double precision deltattracer |
5871 |
double precision delx(nx) |
5872 |
double precision dely(ny) |
5873 |
double precision delz(nr) |
5874 |
double precision diffk4s |
5875 |
double precision diffk4t |
5876 |
double precision diffkhs |
5877 |
double precision diffkht |
5878 |
double precision diffkps |
5879 |
double precision diffkpt |
5880 |
double precision diffkrs |
5881 |
double precision diffkrt |
5882 |
double precision diffkzs |
5883 |
double precision diffkzt |
5884 |
double precision dumpfreq |
5885 |
double precision endtime |
5886 |
double precision externforcingcycle |
5887 |
double precision externforcingperiod |
5888 |
double precision f0 |
5889 |
double precision fcori(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
5890 |
double precision fofacmom |
5891 |
double precision freesurffac |
5892 |
double precision gbaro |
5893 |
double precision gravity |
5894 |
double precision hfacmin |
5895 |
double precision hfacmindp |
5896 |
double precision hfacmindr |
5897 |
double precision hfacmindz |
5898 |
double precision horivertratio |
5899 |
double precision implicdiv2dflow |
5900 |
double precision implicsurfpress |
5901 |
double precision ivdc_kappa |
5902 |
double precision lambdasaltclimrelax |
5903 |
double precision lambdathetaclimrelax |
5904 |
double precision latfftfiltlo |
5905 |
double precision mtfacmom |
5906 |
double precision omega |
5907 |
double precision pchkptfreq |
5908 |
double precision pffacmom |
5909 |
double precision phimin |
5910 |
double precision rcd |
5911 |
double precision recip_gravity |
5912 |
double precision recip_horivertratio |
5913 |
double precision recip_rhoconst |
5914 |
double precision recip_rhonil |
5915 |
double precision recip_rsphere |
5916 |
double precision rhoconst |
5917 |
double precision rhonil |
5918 |
double precision ro_sealevel |
5919 |
double precision rsphere |
5920 |
double precision specvol_s(nr) |
5921 |
double precision sref(nr) |
5922 |
double precision starttime |
5923 |
double precision taucd |
5924 |
double precision tausaltclimrelax |
5925 |
double precision tauthetaclimrelax |
5926 |
double precision tavefreq |
5927 |
double precision theta_s(nr) |
5928 |
double precision thetamin |
5929 |
double precision tref(nr) |
5930 |
double precision vffacmom |
5931 |
double precision visca4 |
5932 |
double precision viscah |
5933 |
double precision viscap |
5934 |
double precision viscar |
5935 |
double precision viscaz |
5936 |
double precision zonal_filt_lat |
5937 |
|
5938 |
C============================================== |
5939 |
C define arguments |
5940 |
C============================================== |
5941 |
double precision adrhokm1(1-olx:snx+olx,1-oly:sny+oly) |
5942 |
double precision adrhokp1(1-olx:snx+olx,1-oly:sny+oly) |
5943 |
integer bi |
5944 |
integer bj |
5945 |
integer imax |
5946 |
integer imin |
5947 |
integer jmax |
5948 |
integer jmin |
5949 |
integer k |
5950 |
double precision mytime |
5951 |
double precision rhokm1(1-olx:snx+olx,1-oly:sny+oly) |
5952 |
double precision rhokp1(1-olx:snx+olx,1-oly:sny+oly) |
5953 |
|
5954 |
C============================================== |
5955 |
C define local variables |
5956 |
C============================================== |
5957 |
double precision adsmix(1-olx:snx+olx,1-oly:sny+oly) |
5958 |
double precision adtmix(1-olx:snx+olx,1-oly:sny+oly) |
5959 |
double precision dsum(1-olx:snx+olx,1-oly:sny+oly) |
5960 |
integer i |
5961 |
integer ip1 |
5962 |
integer ip2 |
5963 |
integer j |
5964 |
|
5965 |
C============================================== |
5966 |
C define external procedures and functions |
5967 |
C============================================== |
5968 |
logical different_multiple |
5969 |
external different_multiple |
5970 |
|
5971 |
C---------------------------------------------- |
5972 |
C RESET LOCAL ADJOINT VARIABLES |
5973 |
C---------------------------------------------- |
5974 |
do ip2 = 1-oly, sny+oly |
5975 |
do ip1 = 1-olx, snx+olx |
5976 |
adsmix(ip1,ip2) = 0.d0 |
5977 |
end do |
5978 |
end do |
5979 |
do ip2 = 1-oly, sny+oly |
5980 |
do ip1 = 1-olx, snx+olx |
5981 |
adtmix(ip1,ip2) = 0.d0 |
5982 |
end do |
5983 |
end do |
5984 |
|
5985 |
C---------------------------------------------- |
5986 |
C ROUTINE BODY |
5987 |
C---------------------------------------------- |
5988 |
if (different_multiple(cadjfreq,mytime,mytime-deltatclock)) then |
5989 |
do j = jmin, jmax |
5990 |
do i = imin, imax |
5991 |
dsum(i,j) = hfacc(i,j,k-1,bi,bj)*drf(k-1)+hfacc(i,j,k,bi,bj) |
5992 |
$*drf(k) |
5993 |
end do |
5994 |
end do |
5995 |
do j = jmin, jmax |
5996 |
do i = imin, imax |
5997 |
if (hfacc(i,j,k,bi,bj) .gt. 0. .and. rhokm1(i,j) .gt. |
5998 |
$rhokp1(i,j)) then |
5999 |
adsmix(i,j) = adsmix(i,j)+adsalt(i,j,k,bi,bj)/dsum(i,j) |
6000 |
adsalt(i,j,k,bi,bj) = 0.d0 |
6001 |
adsmix(i,j) = adsmix(i,j)+adsalt(i,j,k-1,bi,bj)/dsum(i,j) |
6002 |
adsalt(i,j,k-1,bi,bj) = 0.d0 |
6003 |
adtmix(i,j) = adtmix(i,j)+adtheta(i,j,k,bi,bj)/dsum(i,j) |
6004 |
adtheta(i,j,k,bi,bj) = 0.d0 |
6005 |
adtmix(i,j) = adtmix(i,j)+adtheta(i,j,k-1,bi,bj)/dsum(i,j) |
6006 |
adtheta(i,j,k-1,bi,bj) = 0.d0 |
6007 |
endif |
6008 |
end do |
6009 |
end do |
6010 |
do j = jmin, jmax |
6011 |
do i = imin, imax |
6012 |
adsalt(i,j,k-1,bi,bj) = adsalt(i,j,k-1,bi,bj)+adsmix(i,j)* |
6013 |
$hfacc(i,j,k-1,bi,bj)*drf(k-1) |
6014 |
adsalt(i,j,k,bi,bj) = adsalt(i,j,k,bi,bj)+adsmix(i,j)* |
6015 |
$hfacc(i,j,k,bi,bj)*drf(k) |
6016 |
adsmix(i,j) = 0.d0 |
6017 |
adtheta(i,j,k-1,bi,bj) = adtheta(i,j,k-1,bi,bj)+adtmix(i,j)* |
6018 |
$hfacc(i,j,k-1,bi,bj)*drf(k-1) |
6019 |
adtheta(i,j,k,bi,bj) = adtheta(i,j,k,bi,bj)+adtmix(i,j)* |
6020 |
$hfacc(i,j,k,bi,bj)*drf(k) |
6021 |
adtmix(i,j) = 0.d0 |
6022 |
end do |
6023 |
end do |
6024 |
endif |
6025 |
|
6026 |
end |
6027 |
|
6028 |
|
6029 |
subroutine mdconvective_adjustment( bi, bj, imin, imax, jmin, |
6030 |
$jmax, mytime, myiter, mythid ) |
6031 |
C*************************************************************** |
6032 |
C*************************************************************** |
6033 |
C** This routine was generated by the ** |
6034 |
C** Tangent linear and Adjoint Model Compiler, TAMC 5.2.14 ** |
6035 |
C*************************************************************** |
6036 |
C*************************************************************** |
6037 |
C============================================== |
6038 |
C all entries are defined explicitly |
6039 |
C============================================== |
6040 |
implicit none |
6041 |
|
6042 |
C============================================== |
6043 |
C define parameters |
6044 |
C============================================== |
6045 |
integer max_no_threads |
6046 |
parameter ( max_no_threads = 32 ) |
6047 |
integer npx |
6048 |
parameter ( npx = 1 ) |
6049 |
integer npy |
6050 |
parameter ( npy = 1 ) |
6051 |
integer nr |
6052 |
parameter ( nr = 15 ) |
6053 |
integer nsx |
6054 |
parameter ( nsx = 1 ) |
6055 |
integer nsy |
6056 |
parameter ( nsy = 1 ) |
6057 |
integer snx |
6058 |
parameter ( snx = 20 ) |
6059 |
integer nx |
6060 |
parameter ( nx = snx*nsx*npx ) |
6061 |
integer sny |
6062 |
parameter ( sny = 40 ) |
6063 |
integer ny |
6064 |
parameter ( ny = sny*nsy*npy ) |
6065 |
integer olx |
6066 |
parameter ( olx = 3 ) |
6067 |
integer oly |
6068 |
parameter ( oly = 3 ) |
6069 |
|
6070 |
C============================================== |
6071 |
C define common blocks |
6072 |
C============================================== |
6073 |
common /cadrhok/ rhokh |
6074 |
real*4 rhokh(1+snx+olx-(1-olx),1+sny+oly-(1-oly),540) |
6075 |
|
6076 |
common /cadrhokm1/ rhokm1h |
6077 |
real*4 rhokm1h(1+snx+olx-(1-olx),1+sny+oly-(1-oly),540) |
6078 |
|
6079 |
common /cadsalt/ salth |
6080 |
real*4 salth(1+snx+olx-(1-olx),1+sny+oly-(1-oly),540) |
6081 |
|
6082 |
common /cadsalu/ salti |
6083 |
real*4 salti(1+snx+olx-(1-olx),1+sny+oly-(1-oly),540) |
6084 |
|
6085 |
common /cadtheta/ thetah |
6086 |
real*4 thetah(1+snx+olx-(1-olx),1+sny+oly-(1-oly),540) |
6087 |
|
6088 |
common /cadthetb/ thetai |
6089 |
real*4 thetai(1+snx+olx-(1-olx),1+sny+oly-(1-oly),540) |
6090 |
|
6091 |
common /dynvars_r/ etan, uvel, vvel, wvel, theta, salt, gu, gv, |
6092 |
$gt, gs, gunm1, gvnm1, gtnm1, gsnm1 |
6093 |
double precision etan(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
6094 |
double precision gs(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
6095 |
double precision gsnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
6096 |
double precision gt(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
6097 |
double precision gtnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
6098 |
double precision gu(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
6099 |
double precision gunm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
6100 |
double precision gv(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
6101 |
double precision gvnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
6102 |
double precision salt(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
6103 |
double precision theta(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
6104 |
double precision uvel(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
6105 |
double precision vvel(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
6106 |
double precision wvel(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
6107 |
|
6108 |
common /eeparams_i/ errormessageunit, standardmessageunit, |
6109 |
$scrunit1, scrunit2, eedataunit, modeldataunit, numberofprocs, |
6110 |
$pidio, myprocid, mypx, mypy, myxgloballo, myygloballo, nthreads, |
6111 |
$mybxlo, mybxhi, mybylo, mybyhi, ntx, nty, ioerrorcount |
6112 |
integer eedataunit |
6113 |
integer errormessageunit |
6114 |
integer ioerrorcount(max_no_threads) |
6115 |
integer modeldataunit |
6116 |
integer mybxhi(max_no_threads) |
6117 |
integer mybxlo(max_no_threads) |
6118 |
integer mybyhi(max_no_threads) |
6119 |
integer mybylo(max_no_threads) |
6120 |
integer myprocid |
6121 |
integer mypx |
6122 |
integer mypy |
6123 |
integer myxgloballo |
6124 |
integer myygloballo |
6125 |
integer nthreads |
6126 |
integer ntx |
6127 |
integer nty |
6128 |
integer numberofprocs |
6129 |
integer pidio |
6130 |
integer scrunit1 |
6131 |
integer scrunit2 |
6132 |
integer standardmessageunit |
6133 |
|
6134 |
common /parm_eos_lin/ talpha, sbeta, eostype |
6135 |
character*(6) eostype |
6136 |
double precision sbeta |
6137 |
double precision talpha |
6138 |
|
6139 |
common /parm_packages/ usekpp, usegmredi, useobcs, useaim, useecco |
6140 |
logical useaim |
6141 |
logical useecco |
6142 |
logical usegmredi |
6143 |
logical usekpp |
6144 |
logical useobcs |
6145 |
|
6146 |
common /parm_r/ cg2dtargetresidual, cg2dpcoffdfac, |
6147 |
$cg3dtargetresidual, delp, delz, delr, delx, dely, deltat, |
6148 |
$deltatmom, deltattracer, deltatclock, abeps, starttime, phimin, |
6149 |
$thetamin, rsphere, recip_rsphere, f0, fcori, beta, viscah, viscaz, |
6150 |
$ visca4, viscar, diffkht, diffkzt, diffk4t, diffkrt, diffkhs, |
6151 |
$diffkzs, diffk4s, diffkrs, delt, taucd, rcd, freesurffac, |
6152 |
$implicsurfpress, implicdiv2dflow, hfacmin, hfacmindz, gravity, |
6153 |
$recip_gravity, gbaro, rhonil, recip_rhonil, recip_rhoconst, |
6154 |
$rhoconst, tref, sref, endtime, chkptfreq, pchkptfreq, dumpfreq, |
6155 |
$tavefreq, affacmom, vffacmom, pffacmom, cffacmom, fofacmom, |
6156 |
$mtfacmom, cospower, cadjfreq, omega, tauthetaclimrelax, |
6157 |
$lambdathetaclimrelax, tausaltclimrelax, lambdasaltclimrelax, |
6158 |
$externforcingcycle, externforcingperiod, viscap, diffkpt, diffkps, |
6159 |
$ hfacmindr, hfacmindp, theta_s, specvol_s, horivertratio, |
6160 |
$recip_horivertratio, latfftfiltlo, ivdc_kappa, ro_sealevel, |
6161 |
$zonal_filt_lat, bottomdraglinear, bottomdragquadratic |
6162 |
double precision abeps |
6163 |
double precision affacmom |
6164 |
double precision beta |
6165 |
double precision bottomdraglinear |
6166 |
double precision bottomdragquadratic |
6167 |
double precision cadjfreq |
6168 |
double precision cffacmom |
6169 |
double precision cg2dpcoffdfac |
6170 |
double precision cg2dtargetresidual |
6171 |
double precision cg3dtargetresidual |
6172 |
double precision chkptfreq |
6173 |
double precision cospower |
6174 |
double precision delp(nr) |
6175 |
double precision delr(nr) |
6176 |
double precision delt |
6177 |
double precision deltat |
6178 |
double precision deltatclock |
6179 |
double precision deltatmom |
6180 |
double precision deltattracer |
6181 |
double precision delx(nx) |
6182 |
double precision dely(ny) |
6183 |
double precision delz(nr) |
6184 |
double precision diffk4s |
6185 |
double precision diffk4t |
6186 |
double precision diffkhs |
6187 |
double precision diffkht |
6188 |
double precision diffkps |
6189 |
double precision diffkpt |
6190 |
double precision diffkrs |
6191 |
double precision diffkrt |
6192 |
double precision diffkzs |
6193 |
double precision diffkzt |
6194 |
double precision dumpfreq |
6195 |
double precision endtime |
6196 |
double precision externforcingcycle |
6197 |
double precision externforcingperiod |
6198 |
double precision f0 |
6199 |
double precision fcori(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
6200 |
double precision fofacmom |
6201 |
double precision freesurffac |
6202 |
double precision gbaro |
6203 |
double precision gravity |
6204 |
double precision hfacmin |
6205 |
double precision hfacmindp |
6206 |
double precision hfacmindr |
6207 |
double precision hfacmindz |
6208 |
double precision horivertratio |
6209 |
double precision implicdiv2dflow |
6210 |
double precision implicsurfpress |
6211 |
double precision ivdc_kappa |
6212 |
double precision lambdasaltclimrelax |
6213 |
double precision lambdathetaclimrelax |
6214 |
double precision latfftfiltlo |
6215 |
double precision mtfacmom |
6216 |
double precision omega |
6217 |
double precision pchkptfreq |
6218 |
double precision pffacmom |
6219 |
double precision phimin |
6220 |
double precision rcd |
6221 |
double precision recip_gravity |
6222 |
double precision recip_horivertratio |
6223 |
double precision recip_rhoconst |
6224 |
double precision recip_rhonil |
6225 |
double precision recip_rsphere |
6226 |
double precision rhoconst |
6227 |
double precision rhonil |
6228 |
double precision ro_sealevel |
6229 |
double precision rsphere |
6230 |
double precision specvol_s(nr) |
6231 |
double precision sref(nr) |
6232 |
double precision starttime |
6233 |
double precision taucd |
6234 |
double precision tausaltclimrelax |
6235 |
double precision tauthetaclimrelax |
6236 |
double precision tavefreq |
6237 |
double precision theta_s(nr) |
6238 |
double precision thetamin |
6239 |
double precision tref(nr) |
6240 |
double precision vffacmom |
6241 |
double precision visca4 |
6242 |
double precision viscah |
6243 |
double precision viscap |
6244 |
double precision viscar |
6245 |
double precision viscaz |
6246 |
double precision zonal_filt_lat |
6247 |
|
6248 |
common /tamc_keys_i/ ikey_dynamics, ikey_yearly, ikey_daily_1, |
6249 |
$ikey_daily_2, iloop_daily |
6250 |
integer ikey_daily_1 |
6251 |
integer ikey_daily_2 |
6252 |
integer ikey_dynamics |
6253 |
integer ikey_yearly |
6254 |
integer iloop_daily |
6255 |
|
6256 |
common /tamckeys/ key, ikey, idkey |
6257 |
integer idkey |
6258 |
integer ikey |
6259 |
integer key |
6260 |
|
6261 |
C============================================== |
6262 |
C define arguments |
6263 |
C============================================== |
6264 |
integer bi |
6265 |
integer bj |
6266 |
integer imax |
6267 |
integer imin |
6268 |
integer jmax |
6269 |
integer jmin |
6270 |
integer myiter |
6271 |
integer mythid |
6272 |
double precision mytime |
6273 |
|
6274 |
C============================================== |
6275 |
C define local variables |
6276 |
C============================================== |
6277 |
integer act1 |
6278 |
integer act2 |
6279 |
integer act3 |
6280 |
integer act4 |
6281 |
double precision convectcount(1-olx:snx+olx,1-oly:sny+oly,nr) |
6282 |
integer help_h |
6283 |
integer help_i |
6284 |
integer help_j |
6285 |
integer ip1 |
6286 |
integer ip2 |
6287 |
integer k |
6288 |
integer kkey |
6289 |
integer max1 |
6290 |
integer max2 |
6291 |
integer max3 |
6292 |
double precision rhok(1-olx:snx+olx,1-oly:sny+oly) |
6293 |
double precision rhokm1(1-olx:snx+olx,1-oly:sny+oly) |
6294 |
|
6295 |
C============================================== |
6296 |
C define external procedures and functions |
6297 |
C============================================== |
6298 |
logical different_multiple |
6299 |
external different_multiple |
6300 |
|
6301 |
C********************************************** |
6302 |
C executable statements of routine |
6303 |
C********************************************** |
6304 |
if (different_multiple(cadjfreq,mytime,mytime-deltatclock)) then |
6305 |
k = nr |
6306 |
act1 = bi-mybxlo(mythid) |
6307 |
max1 = mybxhi(mythid)-mybxlo(mythid)+1 |
6308 |
act2 = bj-mybylo(mythid) |
6309 |
max2 = mybyhi(mythid)-mybylo(mythid)+1 |
6310 |
act3 = mythid-1 |
6311 |
max3 = ntx*nty |
6312 |
act4 = ikey_dynamics-1 |
6313 |
ikey = act1+1+act2*max1+act3*max1*max2+act4*max1*max2*max3 |
6314 |
if ( .not. usekpp) then |
6315 |
do k = 2, nr |
6316 |
kkey = (ikey-1)*nr+k |
6317 |
do ip2 = 1, 1+sny+oly-(1-oly) |
6318 |
do ip1 = 1, 1+snx+olx-(1-olx) |
6319 |
thetai(ip1,ip2,kkey) = theta(ip1-1+1-olx,ip2-1+1-oly,k- |
6320 |
$1,bi,bj) |
6321 |
end do |
6322 |
end do |
6323 |
do ip2 = 1, 1+sny+oly-(1-oly) |
6324 |
do ip1 = 1, 1+snx+olx-(1-olx) |
6325 |
salti(ip1,ip2,kkey) = salt(ip1-1+1-olx,ip2-1+1-oly,k-1, |
6326 |
$bi,bj) |
6327 |
end do |
6328 |
end do |
6329 |
help_h = k-1 |
6330 |
help_i = k-1 |
6331 |
call find_rho( bi,bj,imin,imax,jmin,jmax,help_h,help_i, |
6332 |
$eostype,theta,salt,rhokm1,mythid ) |
6333 |
do ip2 = 1, 1+sny+oly-(1-oly) |
6334 |
do ip1 = 1, 1+snx+olx-(1-olx) |
6335 |
thetah(ip1,ip2,kkey) = theta(ip1-1+1-olx,ip2-1+1-oly,k, |
6336 |
$bi,bj) |
6337 |
end do |
6338 |
end do |
6339 |
do ip2 = 1, 1+sny+oly-(1-oly) |
6340 |
do ip1 = 1, 1+snx+olx-(1-olx) |
6341 |
salth(ip1,ip2,kkey) = salt(ip1-1+1-olx,ip2-1+1-oly,k,bi, |
6342 |
$bj) |
6343 |
end do |
6344 |
end do |
6345 |
help_j = k-1 |
6346 |
call find_rho( bi,bj,imin,imax,jmin,jmax,k,help_j,eostype, |
6347 |
$theta,salt,rhok,mythid ) |
6348 |
do ip2 = 1, 1+sny+oly-(1-oly) |
6349 |
do ip1 = 1, 1+snx+olx-(1-olx) |
6350 |
rhokm1h(ip1,ip2,kkey) = rhokm1(ip1-1+1-olx,ip2-1+1-oly) |
6351 |
end do |
6352 |
end do |
6353 |
do ip2 = 1, 1+sny+oly-(1-oly) |
6354 |
do ip1 = 1, 1+snx+olx-(1-olx) |
6355 |
rhokh(ip1,ip2,kkey) = rhok(ip1-1+1-olx,ip2-1+1-oly) |
6356 |
end do |
6357 |
end do |
6358 |
call convect( bi,bj,imin,imax,jmin,jmax,k,rhokm1,rhok, |
6359 |
$convectcount,mytime,myiter,mythid ) |
6360 |
end do |
6361 |
endif |
6362 |
endif |
6363 |
end |
6364 |
|
6365 |
|
6366 |
subroutine adconvective_adjustment( bi, bj, imin, imax, jmin, |
6367 |
$jmax, mytime, mythid ) |
6368 |
C*************************************************************** |
6369 |
C*************************************************************** |
6370 |
C** This routine was generated by the ** |
6371 |
C** Tangent linear and Adjoint Model Compiler, TAMC 5.2.14 ** |
6372 |
C*************************************************************** |
6373 |
C*************************************************************** |
6374 |
C============================================== |
6375 |
C all entries are defined explicitly |
6376 |
C============================================== |
6377 |
implicit none |
6378 |
|
6379 |
C============================================== |
6380 |
C define parameters |
6381 |
C============================================== |
6382 |
integer max_no_threads |
6383 |
parameter ( max_no_threads = 32 ) |
6384 |
integer npx |
6385 |
parameter ( npx = 1 ) |
6386 |
integer npy |
6387 |
parameter ( npy = 1 ) |
6388 |
integer nr |
6389 |
parameter ( nr = 15 ) |
6390 |
integer nsx |
6391 |
parameter ( nsx = 1 ) |
6392 |
integer nsy |
6393 |
parameter ( nsy = 1 ) |
6394 |
integer snx |
6395 |
parameter ( snx = 20 ) |
6396 |
integer nx |
6397 |
parameter ( nx = snx*nsx*npx ) |
6398 |
integer sny |
6399 |
parameter ( sny = 40 ) |
6400 |
integer ny |
6401 |
parameter ( ny = sny*nsy*npy ) |
6402 |
integer olx |
6403 |
parameter ( olx = 3 ) |
6404 |
integer oly |
6405 |
parameter ( oly = 3 ) |
6406 |
|
6407 |
C============================================== |
6408 |
C define common blocks |
6409 |
C============================================== |
6410 |
common /addynvars_r/ adetan, aduvel, advvel, adwvel, adtheta, |
6411 |
$adsalt, adgu, adgv, adgt, adgs, adgunm1, adgvnm1, adgtnm1, adgsnm1 |
6412 |
double precision adetan(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
6413 |
double precision adgs(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
6414 |
double precision adgsnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
6415 |
double precision adgt(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
6416 |
double precision adgtnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
6417 |
double precision adgu(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
6418 |
double precision adgunm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
6419 |
double precision adgv(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
6420 |
double precision adgvnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
6421 |
double precision adsalt(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
6422 |
double precision adtheta(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
6423 |
double precision aduvel(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
6424 |
double precision advvel(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
6425 |
double precision adwvel(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
6426 |
|
6427 |
common /cadrhok/ rhokh |
6428 |
real*4 rhokh(1+snx+olx-(1-olx),1+sny+oly-(1-oly),540) |
6429 |
|
6430 |
common /cadrhokm1/ rhokm1h |
6431 |
real*4 rhokm1h(1+snx+olx-(1-olx),1+sny+oly-(1-oly),540) |
6432 |
|
6433 |
common /cadsalt/ salth |
6434 |
real*4 salth(1+snx+olx-(1-olx),1+sny+oly-(1-oly),540) |
6435 |
|
6436 |
common /cadsalu/ salti |
6437 |
real*4 salti(1+snx+olx-(1-olx),1+sny+oly-(1-oly),540) |
6438 |
|
6439 |
common /cadtheta/ thetah |
6440 |
real*4 thetah(1+snx+olx-(1-olx),1+sny+oly-(1-oly),540) |
6441 |
|
6442 |
common /cadthetb/ thetai |
6443 |
real*4 thetai(1+snx+olx-(1-olx),1+sny+oly-(1-oly),540) |
6444 |
|
6445 |
common /dynvars_r/ etan, uvel, vvel, wvel, theta, salt, gu, gv, |
6446 |
$gt, gs, gunm1, gvnm1, gtnm1, gsnm1 |
6447 |
double precision etan(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
6448 |
double precision gs(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
6449 |
double precision gsnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
6450 |
double precision gt(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
6451 |
double precision gtnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
6452 |
double precision gu(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
6453 |
double precision gunm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
6454 |
double precision gv(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
6455 |
double precision gvnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
6456 |
double precision salt(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
6457 |
double precision theta(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
6458 |
double precision uvel(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
6459 |
double precision vvel(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
6460 |
double precision wvel(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
6461 |
|
6462 |
common /eeparams_i/ errormessageunit, standardmessageunit, |
6463 |
$scrunit1, scrunit2, eedataunit, modeldataunit, numberofprocs, |
6464 |
$pidio, myprocid, mypx, mypy, myxgloballo, myygloballo, nthreads, |
6465 |
$mybxlo, mybxhi, mybylo, mybyhi, ntx, nty, ioerrorcount |
6466 |
integer eedataunit |
6467 |
integer errormessageunit |
6468 |
integer ioerrorcount(max_no_threads) |
6469 |
integer modeldataunit |
6470 |
integer mybxhi(max_no_threads) |
6471 |
integer mybxlo(max_no_threads) |
6472 |
integer mybyhi(max_no_threads) |
6473 |
integer mybylo(max_no_threads) |
6474 |
integer myprocid |
6475 |
integer mypx |
6476 |
integer mypy |
6477 |
integer myxgloballo |
6478 |
integer myygloballo |
6479 |
integer nthreads |
6480 |
integer ntx |
6481 |
integer nty |
6482 |
integer numberofprocs |
6483 |
integer pidio |
6484 |
integer scrunit1 |
6485 |
integer scrunit2 |
6486 |
integer standardmessageunit |
6487 |
|
6488 |
common /parm_eos_lin/ talpha, sbeta, eostype |
6489 |
character*(6) eostype |
6490 |
double precision sbeta |
6491 |
double precision talpha |
6492 |
|
6493 |
common /parm_packages/ usekpp, usegmredi, useobcs, useaim, useecco |
6494 |
logical useaim |
6495 |
logical useecco |
6496 |
logical usegmredi |
6497 |
logical usekpp |
6498 |
logical useobcs |
6499 |
|
6500 |
common /parm_r/ cg2dtargetresidual, cg2dpcoffdfac, |
6501 |
$cg3dtargetresidual, delp, delz, delr, delx, dely, deltat, |
6502 |
$deltatmom, deltattracer, deltatclock, abeps, starttime, phimin, |
6503 |
$thetamin, rsphere, recip_rsphere, f0, fcori, beta, viscah, viscaz, |
6504 |
$ visca4, viscar, diffkht, diffkzt, diffk4t, diffkrt, diffkhs, |
6505 |
$diffkzs, diffk4s, diffkrs, delt, taucd, rcd, freesurffac, |
6506 |
$implicsurfpress, implicdiv2dflow, hfacmin, hfacmindz, gravity, |
6507 |
$recip_gravity, gbaro, rhonil, recip_rhonil, recip_rhoconst, |
6508 |
$rhoconst, tref, sref, endtime, chkptfreq, pchkptfreq, dumpfreq, |
6509 |
$tavefreq, affacmom, vffacmom, pffacmom, cffacmom, fofacmom, |
6510 |
$mtfacmom, cospower, cadjfreq, omega, tauthetaclimrelax, |
6511 |
$lambdathetaclimrelax, tausaltclimrelax, lambdasaltclimrelax, |
6512 |
$externforcingcycle, externforcingperiod, viscap, diffkpt, diffkps, |
6513 |
$ hfacmindr, hfacmindp, theta_s, specvol_s, horivertratio, |
6514 |
$recip_horivertratio, latfftfiltlo, ivdc_kappa, ro_sealevel, |
6515 |
$zonal_filt_lat, bottomdraglinear, bottomdragquadratic |
6516 |
double precision abeps |
6517 |
double precision affacmom |
6518 |
double precision beta |
6519 |
double precision bottomdraglinear |
6520 |
double precision bottomdragquadratic |
6521 |
double precision cadjfreq |
6522 |
double precision cffacmom |
6523 |
double precision cg2dpcoffdfac |
6524 |
double precision cg2dtargetresidual |
6525 |
double precision cg3dtargetresidual |
6526 |
double precision chkptfreq |
6527 |
double precision cospower |
6528 |
double precision delp(nr) |
6529 |
double precision delr(nr) |
6530 |
double precision delt |
6531 |
double precision deltat |
6532 |
double precision deltatclock |
6533 |
double precision deltatmom |
6534 |
double precision deltattracer |
6535 |
double precision delx(nx) |
6536 |
double precision dely(ny) |
6537 |
double precision delz(nr) |
6538 |
double precision diffk4s |
6539 |
double precision diffk4t |
6540 |
double precision diffkhs |
6541 |
double precision diffkht |
6542 |
double precision diffkps |
6543 |
double precision diffkpt |
6544 |
double precision diffkrs |
6545 |
double precision diffkrt |
6546 |
double precision diffkzs |
6547 |
double precision diffkzt |
6548 |
double precision dumpfreq |
6549 |
double precision endtime |
6550 |
double precision externforcingcycle |
6551 |
double precision externforcingperiod |
6552 |
double precision f0 |
6553 |
double precision fcori(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
6554 |
double precision fofacmom |
6555 |
double precision freesurffac |
6556 |
double precision gbaro |
6557 |
double precision gravity |
6558 |
double precision hfacmin |
6559 |
double precision hfacmindp |
6560 |
double precision hfacmindr |
6561 |
double precision hfacmindz |
6562 |
double precision horivertratio |
6563 |
double precision implicdiv2dflow |
6564 |
double precision implicsurfpress |
6565 |
double precision ivdc_kappa |
6566 |
double precision lambdasaltclimrelax |
6567 |
double precision lambdathetaclimrelax |
6568 |
double precision latfftfiltlo |
6569 |
double precision mtfacmom |
6570 |
double precision omega |
6571 |
double precision pchkptfreq |
6572 |
double precision pffacmom |
6573 |
double precision phimin |
6574 |
double precision rcd |
6575 |
double precision recip_gravity |
6576 |
double precision recip_horivertratio |
6577 |
double precision recip_rhoconst |
6578 |
double precision recip_rhonil |
6579 |
double precision recip_rsphere |
6580 |
double precision rhoconst |
6581 |
double precision rhonil |
6582 |
double precision ro_sealevel |
6583 |
double precision rsphere |
6584 |
double precision specvol_s(nr) |
6585 |
double precision sref(nr) |
6586 |
double precision starttime |
6587 |
double precision taucd |
6588 |
double precision tausaltclimrelax |
6589 |
double precision tauthetaclimrelax |
6590 |
double precision tavefreq |
6591 |
double precision theta_s(nr) |
6592 |
double precision thetamin |
6593 |
double precision tref(nr) |
6594 |
double precision vffacmom |
6595 |
double precision visca4 |
6596 |
double precision viscah |
6597 |
double precision viscap |
6598 |
double precision viscar |
6599 |
double precision viscaz |
6600 |
double precision zonal_filt_lat |
6601 |
|
6602 |
common /tamc_keys_i/ ikey_dynamics, ikey_yearly, ikey_daily_1, |
6603 |
$ikey_daily_2, iloop_daily |
6604 |
integer ikey_daily_1 |
6605 |
integer ikey_daily_2 |
6606 |
integer ikey_dynamics |
6607 |
integer ikey_yearly |
6608 |
integer iloop_daily |
6609 |
|
6610 |
common /tamckeys/ key, ikey, idkey |
6611 |
integer idkey |
6612 |
integer ikey |
6613 |
integer key |
6614 |
|
6615 |
C============================================== |
6616 |
C define arguments |
6617 |
C============================================== |
6618 |
integer bi |
6619 |
integer bj |
6620 |
integer imax |
6621 |
integer imin |
6622 |
integer jmax |
6623 |
integer jmin |
6624 |
integer mythid |
6625 |
double precision mytime |
6626 |
|
6627 |
C============================================== |
6628 |
C define local variables |
6629 |
C============================================== |
6630 |
integer act1 |
6631 |
integer act2 |
6632 |
integer act3 |
6633 |
integer act4 |
6634 |
double precision adrhok(1-olx:snx+olx,1-oly:sny+oly) |
6635 |
double precision adrhokm1(1-olx:snx+olx,1-oly:sny+oly) |
6636 |
integer help_h |
6637 |
integer help_i |
6638 |
integer help_j |
6639 |
integer ip1 |
6640 |
integer ip2 |
6641 |
integer k |
6642 |
integer kkey |
6643 |
integer max1 |
6644 |
integer max2 |
6645 |
integer max3 |
6646 |
double precision rhok(1-olx:snx+olx,1-oly:sny+oly) |
6647 |
double precision rhokm1(1-olx:snx+olx,1-oly:sny+oly) |
6648 |
|
6649 |
C============================================== |
6650 |
C define external procedures and functions |
6651 |
C============================================== |
6652 |
logical different_multiple |
6653 |
external different_multiple |
6654 |
|
6655 |
C---------------------------------------------- |
6656 |
C RESET LOCAL ADJOINT VARIABLES |
6657 |
C---------------------------------------------- |
6658 |
do ip2 = 1-oly, sny+oly |
6659 |
do ip1 = 1-olx, snx+olx |
6660 |
adrhok(ip1,ip2) = 0.d0 |
6661 |
end do |
6662 |
end do |
6663 |
do ip2 = 1-oly, sny+oly |
6664 |
do ip1 = 1-olx, snx+olx |
6665 |
adrhokm1(ip1,ip2) = 0.d0 |
6666 |
end do |
6667 |
end do |
6668 |
|
6669 |
C---------------------------------------------- |
6670 |
C ROUTINE BODY |
6671 |
C---------------------------------------------- |
6672 |
if (different_multiple(cadjfreq,mytime,mytime-deltatclock)) then |
6673 |
act1 = bi-mybxlo(mythid) |
6674 |
max1 = mybxhi(mythid)-mybxlo(mythid)+1 |
6675 |
act2 = bj-mybylo(mythid) |
6676 |
max2 = mybyhi(mythid)-mybylo(mythid)+1 |
6677 |
act3 = mythid-1 |
6678 |
max3 = ntx*nty |
6679 |
act4 = ikey_dynamics-1 |
6680 |
ikey = act1+1+act2*max1+act3*max1*max2+act4*max1*max2*max3 |
6681 |
if ( .not. usekpp) then |
6682 |
do k = nr, 2, -1 |
6683 |
kkey = (ikey-1)*nr+k |
6684 |
help_h = k-1 |
6685 |
help_i = k-1 |
6686 |
do ip2 = 1, 1+sny+oly-(1-oly) |
6687 |
do ip1 = 1, 1+snx+olx-(1-olx) |
6688 |
theta(ip1-1+1-olx,ip2-1+1-oly,k,bi,bj) = thetah(ip1,ip2, |
6689 |
$kkey) |
6690 |
end do |
6691 |
end do |
6692 |
do ip2 = 1, 1+sny+oly-(1-oly) |
6693 |
do ip1 = 1, 1+snx+olx-(1-olx) |
6694 |
salt(ip1-1+1-olx,ip2-1+1-oly,k,bi,bj) = salth(ip1,ip2, |
6695 |
$kkey) |
6696 |
end do |
6697 |
end do |
6698 |
help_j = k-1 |
6699 |
do ip2 = 1, 1+sny+oly-(1-oly) |
6700 |
do ip1 = 1, 1+snx+olx-(1-olx) |
6701 |
rhokm1(ip1-1+1-olx,ip2-1+1-oly) = rhokm1h(ip1,ip2,kkey) |
6702 |
end do |
6703 |
end do |
6704 |
do ip2 = 1, 1+sny+oly-(1-oly) |
6705 |
do ip1 = 1, 1+snx+olx-(1-olx) |
6706 |
rhok(ip1-1+1-olx,ip2-1+1-oly) = rhokh(ip1,ip2,kkey) |
6707 |
end do |
6708 |
end do |
6709 |
call adconvect( bi,bj,imin,imax,jmin,jmax,k,rhokm1,rhok, |
6710 |
$mytime,adrhokm1,adrhok ) |
6711 |
call adfind_rho( bi,bj,imin,imax,jmin,jmax,k,help_j,eostype, |
6712 |
$theta,salt,adtheta,adsalt,adrhok ) |
6713 |
do ip2 = 1, 1+sny+oly-(1-oly) |
6714 |
do ip1 = 1, 1+snx+olx-(1-olx) |
6715 |
theta(ip1-1+1-olx,ip2-1+1-oly,k-1,bi,bj) = thetai(ip1, |
6716 |
$ip2,kkey) |
6717 |
end do |
6718 |
end do |
6719 |
do ip2 = 1, 1+sny+oly-(1-oly) |
6720 |
do ip1 = 1, 1+snx+olx-(1-olx) |
6721 |
salt(ip1-1+1-olx,ip2-1+1-oly,k-1,bi,bj) = salti(ip1,ip2, |
6722 |
$kkey) |
6723 |
end do |
6724 |
end do |
6725 |
call adfind_rho( bi,bj,imin,imax,jmin,jmax,help_h,help_i, |
6726 |
$eostype,theta,salt,adtheta,adsalt,adrhokm1 ) |
6727 |
end do |
6728 |
endif |
6729 |
endif |
6730 |
|
6731 |
end |
6732 |
|
6733 |
|
6734 |
subroutine adcorrection_step( bi, bj, imin, imax, jmin, jmax, k, |
6735 |
$adphisurfx, adphisurfy ) |
6736 |
C*************************************************************** |
6737 |
C*************************************************************** |
6738 |
C** This routine was generated by the ** |
6739 |
C** Tangent linear and Adjoint Model Compiler, TAMC 5.2.14 ** |
6740 |
C*************************************************************** |
6741 |
C*************************************************************** |
6742 |
C============================================== |
6743 |
C all entries are defined explicitly |
6744 |
C============================================== |
6745 |
implicit none |
6746 |
|
6747 |
C============================================== |
6748 |
C define parameters |
6749 |
C============================================== |
6750 |
integer npx |
6751 |
parameter ( npx = 1 ) |
6752 |
integer npy |
6753 |
parameter ( npy = 1 ) |
6754 |
integer nr |
6755 |
parameter ( nr = 15 ) |
6756 |
integer nsx |
6757 |
parameter ( nsx = 1 ) |
6758 |
integer nsy |
6759 |
parameter ( nsy = 1 ) |
6760 |
integer snx |
6761 |
parameter ( snx = 20 ) |
6762 |
integer nx |
6763 |
parameter ( nx = snx*nsx*npx ) |
6764 |
integer sny |
6765 |
parameter ( sny = 40 ) |
6766 |
integer ny |
6767 |
parameter ( ny = sny*nsy*npy ) |
6768 |
integer olx |
6769 |
parameter ( olx = 3 ) |
6770 |
integer oly |
6771 |
parameter ( oly = 3 ) |
6772 |
|
6773 |
C============================================== |
6774 |
C define common blocks |
6775 |
C============================================== |
6776 |
common /addynvars_r/ adetan, aduvel, advvel, adwvel, adtheta, |
6777 |
$adsalt, adgu, adgv, adgt, adgs, adgunm1, adgvnm1, adgtnm1, adgsnm1 |
6778 |
double precision adetan(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
6779 |
double precision adgs(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
6780 |
double precision adgsnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
6781 |
double precision adgt(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
6782 |
double precision adgtnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
6783 |
double precision adgu(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
6784 |
double precision adgunm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
6785 |
double precision adgv(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
6786 |
double precision adgvnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
6787 |
double precision adsalt(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
6788 |
double precision adtheta(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
6789 |
double precision aduvel(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
6790 |
double precision advvel(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
6791 |
double precision adwvel(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
6792 |
|
6793 |
common /grid_r/ dxc, dxf, dxg, dxv, dyc, dyf, dyg, dyu, drc, drf, |
6794 |
$h, hfacc, hfacw, hfacs, depthink, recip_dxc, recip_dxf, recip_dxg, |
6795 |
$ recip_dxv, recip_dyc, recip_dyf, recip_dyg, recip_dyu, recip_drc, |
6796 |
$ recip_drf, recip_h, recip_hfacc, recip_hfacw, recip_hfacs, rkfac, |
6797 |
$ recip_rkfac, safac, xc, yc, ra, raw, ras, raz, rc, rf, yc0, xc0, |
6798 |
$xg, yg, maskw, masks, recip_ra, recip_raw, recip_ras, recip_raz, |
6799 |
$tanphiatu, tanphiatv |
6800 |
double precision depthink(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
6801 |
double precision drc(1:nr) |
6802 |
double precision drf(1:nr) |
6803 |
double precision dxc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
6804 |
double precision dxf(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
6805 |
double precision dxg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
6806 |
double precision dxv(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
6807 |
double precision dyc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
6808 |
double precision dyf(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
6809 |
double precision dyg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
6810 |
double precision dyu(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
6811 |
double precision h(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
6812 |
double precision hfacc(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) |
6813 |
double precision hfacs(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) |
6814 |
double precision hfacw(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) |
6815 |
double precision masks(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) |
6816 |
double precision maskw(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) |
6817 |
double precision ra(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
6818 |
double precision ras(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
6819 |
double precision raw(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
6820 |
double precision raz(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
6821 |
double precision rc(1:nr) |
6822 |
double precision recip_drc(1:nr) |
6823 |
double precision recip_drf(1:nr) |
6824 |
double precision recip_dxc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
6825 |
double precision recip_dxf(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
6826 |
double precision recip_dxg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
6827 |
double precision recip_dxv(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
6828 |
double precision recip_dyc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
6829 |
double precision recip_dyf(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
6830 |
double precision recip_dyg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
6831 |
double precision recip_dyu(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
6832 |
double precision recip_h(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
6833 |
double precision recip_hfacc(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx, |
6834 |
$nsy) |
6835 |
double precision recip_hfacs(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx, |
6836 |
$nsy) |
6837 |
double precision recip_hfacw(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx, |
6838 |
$nsy) |
6839 |
double precision recip_ra(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
6840 |
double precision recip_ras(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
6841 |
double precision recip_raw(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
6842 |
double precision recip_raz(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
6843 |
double precision recip_rkfac |
6844 |
double precision rf(1:nr+1) |
6845 |
double precision rkfac |
6846 |
double precision safac(1:nr) |
6847 |
double precision tanphiatu(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
6848 |
double precision tanphiatv(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
6849 |
double precision xc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
6850 |
double precision xc0 |
6851 |
double precision xg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
6852 |
double precision yc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
6853 |
double precision yc0 |
6854 |
double precision yg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
6855 |
|
6856 |
common /parm_r/ cg2dtargetresidual, cg2dpcoffdfac, |
6857 |
$cg3dtargetresidual, delp, delz, delr, delx, dely, deltat, |
6858 |
$deltatmom, deltattracer, deltatclock, abeps, starttime, phimin, |
6859 |
$thetamin, rsphere, recip_rsphere, f0, fcori, beta, viscah, viscaz, |
6860 |
$ visca4, viscar, diffkht, diffkzt, diffk4t, diffkrt, diffkhs, |
6861 |
$diffkzs, diffk4s, diffkrs, delt, taucd, rcd, freesurffac, |
6862 |
$implicsurfpress, implicdiv2dflow, hfacmin, hfacmindz, gravity, |
6863 |
$recip_gravity, gbaro, rhonil, recip_rhonil, recip_rhoconst, |
6864 |
$rhoconst, tref, sref, endtime, chkptfreq, pchkptfreq, dumpfreq, |
6865 |
$tavefreq, affacmom, vffacmom, pffacmom, cffacmom, fofacmom, |
6866 |
$mtfacmom, cospower, cadjfreq, omega, tauthetaclimrelax, |
6867 |
$lambdathetaclimrelax, tausaltclimrelax, lambdasaltclimrelax, |
6868 |
$externforcingcycle, externforcingperiod, viscap, diffkpt, diffkps, |
6869 |
$ hfacmindr, hfacmindp, theta_s, specvol_s, horivertratio, |
6870 |
$recip_horivertratio, latfftfiltlo, ivdc_kappa, ro_sealevel, |
6871 |
$zonal_filt_lat, bottomdraglinear, bottomdragquadratic |
6872 |
double precision abeps |
6873 |
double precision affacmom |
6874 |
double precision beta |
6875 |
double precision bottomdraglinear |
6876 |
double precision bottomdragquadratic |
6877 |
double precision cadjfreq |
6878 |
double precision cffacmom |
6879 |
double precision cg2dpcoffdfac |
6880 |
double precision cg2dtargetresidual |
6881 |
double precision cg3dtargetresidual |
6882 |
double precision chkptfreq |
6883 |
double precision cospower |
6884 |
double precision delp(nr) |
6885 |
double precision delr(nr) |
6886 |
double precision delt |
6887 |
double precision deltat |
6888 |
double precision deltatclock |
6889 |
double precision deltatmom |
6890 |
double precision deltattracer |
6891 |
double precision delx(nx) |
6892 |
double precision dely(ny) |
6893 |
double precision delz(nr) |
6894 |
double precision diffk4s |
6895 |
double precision diffk4t |
6896 |
double precision diffkhs |
6897 |
double precision diffkht |
6898 |
double precision diffkps |
6899 |
double precision diffkpt |
6900 |
double precision diffkrs |
6901 |
double precision diffkrt |
6902 |
double precision diffkzs |
6903 |
double precision diffkzt |
6904 |
double precision dumpfreq |
6905 |
double precision endtime |
6906 |
double precision externforcingcycle |
6907 |
double precision externforcingperiod |
6908 |
double precision f0 |
6909 |
double precision fcori(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
6910 |
double precision fofacmom |
6911 |
double precision freesurffac |
6912 |
double precision gbaro |
6913 |
double precision gravity |
6914 |
double precision hfacmin |
6915 |
double precision hfacmindp |
6916 |
double precision hfacmindr |
6917 |
double precision hfacmindz |
6918 |
double precision horivertratio |
6919 |
double precision implicdiv2dflow |
6920 |
double precision implicsurfpress |
6921 |
double precision ivdc_kappa |
6922 |
double precision lambdasaltclimrelax |
6923 |
double precision lambdathetaclimrelax |
6924 |
double precision latfftfiltlo |
6925 |
double precision mtfacmom |
6926 |
double precision omega |
6927 |
double precision pchkptfreq |
6928 |
double precision pffacmom |
6929 |
double precision phimin |
6930 |
double precision rcd |
6931 |
double precision recip_gravity |
6932 |
double precision recip_horivertratio |
6933 |
double precision recip_rhoconst |
6934 |
double precision recip_rhonil |
6935 |
double precision recip_rsphere |
6936 |
double precision rhoconst |
6937 |
double precision rhonil |
6938 |
double precision ro_sealevel |
6939 |
double precision rsphere |
6940 |
double precision specvol_s(nr) |
6941 |
double precision sref(nr) |
6942 |
double precision starttime |
6943 |
double precision taucd |
6944 |
double precision tausaltclimrelax |
6945 |
double precision tauthetaclimrelax |
6946 |
double precision tavefreq |
6947 |
double precision theta_s(nr) |
6948 |
double precision thetamin |
6949 |
double precision tref(nr) |
6950 |
double precision vffacmom |
6951 |
double precision visca4 |
6952 |
double precision viscah |
6953 |
double precision viscap |
6954 |
double precision viscar |
6955 |
double precision viscaz |
6956 |
double precision zonal_filt_lat |
6957 |
|
6958 |
C============================================== |
6959 |
C define arguments |
6960 |
C============================================== |
6961 |
double precision adphisurfx(1-olx:snx+olx,1-oly:sny+oly) |
6962 |
double precision adphisurfy(1-olx:snx+olx,1-oly:sny+oly) |
6963 |
integer bi |
6964 |
integer bj |
6965 |
integer imax |
6966 |
integer imin |
6967 |
integer jmax |
6968 |
integer jmin |
6969 |
integer k |
6970 |
|
6971 |
C============================================== |
6972 |
C define local variables |
6973 |
C============================================== |
6974 |
double precision hxfac |
6975 |
double precision hyfac |
6976 |
integer i |
6977 |
integer j |
6978 |
|
6979 |
C---------------------------------------------- |
6980 |
C ROUTINE BODY |
6981 |
C---------------------------------------------- |
6982 |
hxfac = pffacmom |
6983 |
hyfac = pffacmom |
6984 |
do j = jmin, jmax |
6985 |
do i = imin, imax |
6986 |
adgv(i,j,k,bi,bj) = adgv(i,j,k,bi,bj)+adgvnm1(i,j,k,bi,bj) |
6987 |
adgvnm1(i,j,k,bi,bj) = 0.d0 |
6988 |
adgvnm1(i,j,k,bi,bj) = adgvnm1(i,j,k,bi,bj)+advvel(i,j,k,bi, |
6989 |
$bj)*masks(i,j,k,bi,bj) |
6990 |
adphisurfy(i,j) = adphisurfy(i,j)-advvel(i,j,k,bi,bj)* |
6991 |
$deltatmom*hyfac*implicsurfpress*masks(i,j,k,bi,bj) |
6992 |
advvel(i,j,k,bi,bj) = 0.d0 |
6993 |
end do |
6994 |
end do |
6995 |
do j = jmin, jmax |
6996 |
do i = imin, imax |
6997 |
adgu(i,j,k,bi,bj) = adgu(i,j,k,bi,bj)+adgunm1(i,j,k,bi,bj) |
6998 |
adgunm1(i,j,k,bi,bj) = 0.d0 |
6999 |
adgunm1(i,j,k,bi,bj) = adgunm1(i,j,k,bi,bj)+aduvel(i,j,k,bi, |
7000 |
$bj)*maskw(i,j,k,bi,bj) |
7001 |
adphisurfx(i,j) = adphisurfx(i,j)-aduvel(i,j,k,bi,bj)* |
7002 |
$deltatmom*hxfac*implicsurfpress*maskw(i,j,k,bi,bj) |
7003 |
aduvel(i,j,k,bi,bj) = 0.d0 |
7004 |
end do |
7005 |
end do |
7006 |
|
7007 |
end |
7008 |
|
7009 |
|
7010 |
subroutine adcost_final( mythid ) |
7011 |
C*************************************************************** |
7012 |
C*************************************************************** |
7013 |
C** This routine was generated by the ** |
7014 |
C** Tangent linear and Adjoint Model Compiler, TAMC 5.2.14 ** |
7015 |
C*************************************************************** |
7016 |
C*************************************************************** |
7017 |
C============================================== |
7018 |
C all entries are defined explicitly |
7019 |
C============================================== |
7020 |
implicit none |
7021 |
|
7022 |
C============================================== |
7023 |
C define parameters |
7024 |
C============================================== |
7025 |
integer max_no_threads |
7026 |
parameter ( max_no_threads = 32 ) |
7027 |
integer nsx |
7028 |
parameter ( nsx = 1 ) |
7029 |
integer nsy |
7030 |
parameter ( nsy = 1 ) |
7031 |
|
7032 |
C============================================== |
7033 |
C define common blocks |
7034 |
C============================================== |
7035 |
common /adcost_r/ adfc, adobjf_test |
7036 |
double precision adfc |
7037 |
double precision adobjf_test(nsx,nsy) |
7038 |
|
7039 |
common /cost_aux_r/ mult_hq, mult_hs, mult_tauu, mult_tauv, |
7040 |
$mult_hmean, mult_h, mult_temp, mult_salt, mult_sst, mult_atl, |
7041 |
$mult_ctdt, mult_ctds, mult_test |
7042 |
double precision mult_atl |
7043 |
double precision mult_ctds |
7044 |
double precision mult_ctdt |
7045 |
double precision mult_h |
7046 |
double precision mult_hmean |
7047 |
double precision mult_hq |
7048 |
double precision mult_hs |
7049 |
double precision mult_salt |
7050 |
double precision mult_sst |
7051 |
double precision mult_tauu |
7052 |
double precision mult_tauv |
7053 |
double precision mult_temp |
7054 |
double precision mult_test |
7055 |
|
7056 |
common /eeparams_i/ errormessageunit, standardmessageunit, |
7057 |
$scrunit1, scrunit2, eedataunit, modeldataunit, numberofprocs, |
7058 |
$pidio, myprocid, mypx, mypy, myxgloballo, myygloballo, nthreads, |
7059 |
$mybxlo, mybxhi, mybylo, mybyhi, ntx, nty, ioerrorcount |
7060 |
integer eedataunit |
7061 |
integer errormessageunit |
7062 |
integer ioerrorcount(max_no_threads) |
7063 |
integer modeldataunit |
7064 |
integer mybxhi(max_no_threads) |
7065 |
integer mybxlo(max_no_threads) |
7066 |
integer mybyhi(max_no_threads) |
7067 |
integer mybylo(max_no_threads) |
7068 |
integer myprocid |
7069 |
integer mypx |
7070 |
integer mypy |
7071 |
integer myxgloballo |
7072 |
integer myygloballo |
7073 |
integer nthreads |
7074 |
integer ntx |
7075 |
integer nty |
7076 |
integer numberofprocs |
7077 |
integer pidio |
7078 |
integer scrunit1 |
7079 |
integer scrunit2 |
7080 |
integer standardmessageunit |
7081 |
|
7082 |
C============================================== |
7083 |
C define arguments |
7084 |
C============================================== |
7085 |
integer mythid |
7086 |
|
7087 |
C============================================== |
7088 |
C define local variables |
7089 |
C============================================== |
7090 |
integer bi |
7091 |
integer bj |
7092 |
integer ithi |
7093 |
integer itlo |
7094 |
integer jthi |
7095 |
integer jtlo |
7096 |
|
7097 |
C---------------------------------------------- |
7098 |
C ROUTINE BODY |
7099 |
C---------------------------------------------- |
7100 |
jtlo = mybylo(mythid) |
7101 |
jthi = mybyhi(mythid) |
7102 |
itlo = mybxlo(mythid) |
7103 |
ithi = mybxhi(mythid) |
7104 |
call global_adsum_r8( mythid,adfc ) |
7105 |
do bj = jtlo, jthi |
7106 |
do bi = itlo, ithi |
7107 |
adobjf_test(bi,bj) = adobjf_test(bi,bj)+adfc*mult_test |
7108 |
end do |
7109 |
end do |
7110 |
|
7111 |
end |
7112 |
|
7113 |
|
7114 |
subroutine adcost_test( mythid ) |
7115 |
C*************************************************************** |
7116 |
C*************************************************************** |
7117 |
C** This routine was generated by the ** |
7118 |
C** Tangent linear and Adjoint Model Compiler, TAMC 5.2.14 ** |
7119 |
C*************************************************************** |
7120 |
C*************************************************************** |
7121 |
C============================================== |
7122 |
C all entries are defined explicitly |
7123 |
C============================================== |
7124 |
implicit none |
7125 |
|
7126 |
C============================================== |
7127 |
C define parameters |
7128 |
C============================================== |
7129 |
integer max_no_threads |
7130 |
parameter ( max_no_threads = 32 ) |
7131 |
integer nr |
7132 |
parameter ( nr = 15 ) |
7133 |
integer nsx |
7134 |
parameter ( nsx = 1 ) |
7135 |
integer nsy |
7136 |
parameter ( nsy = 1 ) |
7137 |
integer olx |
7138 |
parameter ( olx = 3 ) |
7139 |
integer oly |
7140 |
parameter ( oly = 3 ) |
7141 |
integer snx |
7142 |
parameter ( snx = 20 ) |
7143 |
integer sny |
7144 |
parameter ( sny = 40 ) |
7145 |
|
7146 |
C============================================== |
7147 |
C define common blocks |
7148 |
C============================================== |
7149 |
common /adcost_r/ adfc, adobjf_test |
7150 |
double precision adfc |
7151 |
double precision adobjf_test(nsx,nsy) |
7152 |
|
7153 |
common /addynvars_r/ adetan, aduvel, advvel, adwvel, adtheta, |
7154 |
$adsalt, adgu, adgv, adgt, adgs, adgunm1, adgvnm1, adgtnm1, adgsnm1 |
7155 |
double precision adetan(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
7156 |
double precision adgs(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
7157 |
double precision adgsnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
7158 |
double precision adgt(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
7159 |
double precision adgtnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
7160 |
double precision adgu(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
7161 |
double precision adgunm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
7162 |
double precision adgv(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
7163 |
double precision adgvnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
7164 |
double precision adsalt(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
7165 |
double precision adtheta(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
7166 |
double precision aduvel(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
7167 |
double precision advvel(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
7168 |
double precision adwvel(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
7169 |
|
7170 |
common /cost_test_i/ ilocout, jlocout, klocout |
7171 |
integer ilocout |
7172 |
integer jlocout |
7173 |
integer klocout |
7174 |
|
7175 |
common /eeparams_i/ errormessageunit, standardmessageunit, |
7176 |
$scrunit1, scrunit2, eedataunit, modeldataunit, numberofprocs, |
7177 |
$pidio, myprocid, mypx, mypy, myxgloballo, myygloballo, nthreads, |
7178 |
$mybxlo, mybxhi, mybylo, mybyhi, ntx, nty, ioerrorcount |
7179 |
integer eedataunit |
7180 |
integer errormessageunit |
7181 |
integer ioerrorcount(max_no_threads) |
7182 |
integer modeldataunit |
7183 |
integer mybxhi(max_no_threads) |
7184 |
integer mybxlo(max_no_threads) |
7185 |
integer mybyhi(max_no_threads) |
7186 |
integer mybylo(max_no_threads) |
7187 |
integer myprocid |
7188 |
integer mypx |
7189 |
integer mypy |
7190 |
integer myxgloballo |
7191 |
integer myygloballo |
7192 |
integer nthreads |
7193 |
integer ntx |
7194 |
integer nty |
7195 |
integer numberofprocs |
7196 |
integer pidio |
7197 |
integer scrunit1 |
7198 |
integer scrunit2 |
7199 |
integer standardmessageunit |
7200 |
|
7201 |
C============================================== |
7202 |
C define arguments |
7203 |
C============================================== |
7204 |
integer mythid |
7205 |
|
7206 |
C============================================== |
7207 |
C define local variables |
7208 |
C============================================== |
7209 |
integer bi |
7210 |
integer bj |
7211 |
integer i |
7212 |
integer ig |
7213 |
integer ithi |
7214 |
integer itlo |
7215 |
integer j |
7216 |
integer jg |
7217 |
integer jthi |
7218 |
integer jtlo |
7219 |
|
7220 |
C---------------------------------------------- |
7221 |
C ROUTINE BODY |
7222 |
C---------------------------------------------- |
7223 |
jtlo = mybylo(mythid) |
7224 |
jthi = mybyhi(mythid) |
7225 |
itlo = mybxlo(mythid) |
7226 |
ithi = mybxhi(mythid) |
7227 |
ilocout = 6 |
7228 |
jlocout = 35 |
7229 |
klocout = 1 |
7230 |
do bj = jtlo, jthi |
7231 |
do bi = itlo, ithi |
7232 |
do j = 1, sny |
7233 |
jg = myygloballo-1+(bj-1)*sny+j |
7234 |
do i = 1, snx |
7235 |
ig = myxgloballo-1+(bi-1)*snx+i |
7236 |
if (ig .eq. ilocout .and. jg .eq. jlocout) then |
7237 |
adtheta(i,j,klocout,bi,bj) = adtheta(i,j,klocout,bi,bj)+ |
7238 |
$adobjf_test(bi,bj) |
7239 |
adobjf_test(bi,bj) = 0.d0 |
7240 |
endif |
7241 |
end do |
7242 |
end do |
7243 |
end do |
7244 |
end do |
7245 |
|
7246 |
end |
7247 |
|
7248 |
|
7249 |
subroutine adctrl_map_forcing( mythid ) |
7250 |
C*************************************************************** |
7251 |
C*************************************************************** |
7252 |
C** This routine was generated by the ** |
7253 |
C** Tangent linear and Adjoint Model Compiler, TAMC 5.2.14 ** |
7254 |
C*************************************************************** |
7255 |
C*************************************************************** |
7256 |
C============================================== |
7257 |
C all entries are defined explicitly |
7258 |
C============================================== |
7259 |
implicit none |
7260 |
|
7261 |
C============================================== |
7262 |
C define parameters |
7263 |
C============================================== |
7264 |
integer max_len_fnam |
7265 |
parameter ( max_len_fnam = 512 ) |
7266 |
integer max_no_threads |
7267 |
parameter ( max_no_threads = 32 ) |
7268 |
integer nr |
7269 |
parameter ( nr = 15 ) |
7270 |
integer nsx |
7271 |
parameter ( nsx = 1 ) |
7272 |
integer nsy |
7273 |
parameter ( nsy = 1 ) |
7274 |
integer olx |
7275 |
parameter ( olx = 3 ) |
7276 |
integer oly |
7277 |
parameter ( oly = 3 ) |
7278 |
integer optimcycle |
7279 |
parameter ( optimcycle = 0 ) |
7280 |
integer snx |
7281 |
parameter ( snx = 20 ) |
7282 |
integer sny |
7283 |
parameter ( sny = 40 ) |
7284 |
|
7285 |
C============================================== |
7286 |
C define common blocks |
7287 |
C============================================== |
7288 |
common /adcontrolvars_r/ adtmpfld2d, adtmpfld3d |
7289 |
double precision adtmpfld2d(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
7290 |
double precision adtmpfld3d(1-olx:snx+olx,1-oly:sny+oly,nr,nsx, |
7291 |
$nsy) |
7292 |
|
7293 |
common /adffields/ adfu, adfv, adqnet, adempmr |
7294 |
double precision adempmr(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
7295 |
double precision adfu(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
7296 |
double precision adfv(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
7297 |
double precision adqnet(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
7298 |
|
7299 |
common /controlfiles_c/ xx_theta_file, xx_salt_file, xx_tauu_file, |
7300 |
$ xx_tauv_file, xx_sflux_file, xx_hflux_file, xx_sss_file, |
7301 |
$xx_sst_file, xx_diffkr_file, xx_kapgm_file |
7302 |
character*(max_len_fnam) xx_diffkr_file |
7303 |
character*(max_len_fnam) xx_hflux_file |
7304 |
character*(max_len_fnam) xx_kapgm_file |
7305 |
character*(max_len_fnam) xx_salt_file |
7306 |
character*(max_len_fnam) xx_sflux_file |
7307 |
character*(max_len_fnam) xx_sss_file |
7308 |
character*(max_len_fnam) xx_sst_file |
7309 |
character*(max_len_fnam) xx_tauu_file |
7310 |
character*(max_len_fnam) xx_tauv_file |
7311 |
character*(max_len_fnam) xx_theta_file |
7312 |
|
7313 |
common /eeparams_i/ errormessageunit, standardmessageunit, |
7314 |
$scrunit1, scrunit2, eedataunit, modeldataunit, numberofprocs, |
7315 |
$pidio, myprocid, mypx, mypy, myxgloballo, myygloballo, nthreads, |
7316 |
$mybxlo, mybxhi, mybylo, mybyhi, ntx, nty, ioerrorcount |
7317 |
integer eedataunit |
7318 |
integer errormessageunit |
7319 |
integer ioerrorcount(max_no_threads) |
7320 |
integer modeldataunit |
7321 |
integer mybxhi(max_no_threads) |
7322 |
integer mybxlo(max_no_threads) |
7323 |
integer mybyhi(max_no_threads) |
7324 |
integer mybylo(max_no_threads) |
7325 |
integer myprocid |
7326 |
integer mypx |
7327 |
integer mypy |
7328 |
integer myxgloballo |
7329 |
integer myygloballo |
7330 |
integer nthreads |
7331 |
integer ntx |
7332 |
integer nty |
7333 |
integer numberofprocs |
7334 |
integer pidio |
7335 |
integer scrunit1 |
7336 |
integer scrunit2 |
7337 |
integer standardmessageunit |
7338 |
|
7339 |
C============================================== |
7340 |
C define arguments |
7341 |
C============================================== |
7342 |
integer mythid |
7343 |
|
7344 |
C============================================== |
7345 |
C define local variables |
7346 |
C============================================== |
7347 |
integer bi |
7348 |
integer bj |
7349 |
logical doglobalread |
7350 |
character*(80) fnamehflux |
7351 |
character*(80) fnamesflux |
7352 |
character*(80) fnametauu |
7353 |
character*(80) fnametauv |
7354 |
integer i |
7355 |
integer il |
7356 |
integer imax |
7357 |
integer imin |
7358 |
integer ithi |
7359 |
integer itlo |
7360 |
integer j |
7361 |
integer jmax |
7362 |
integer jmin |
7363 |
integer jthi |
7364 |
integer jtlo |
7365 |
logical ladinit |
7366 |
|
7367 |
C============================================== |
7368 |
C define external procedures and functions |
7369 |
C============================================== |
7370 |
integer ilnblnk |
7371 |
external ilnblnk |
7372 |
|
7373 |
C---------------------------------------------- |
7374 |
C ROUTINE BODY |
7375 |
C---------------------------------------------- |
7376 |
jtlo = mybylo(mythid) |
7377 |
jthi = mybyhi(mythid) |
7378 |
itlo = mybxlo(mythid) |
7379 |
ithi = mybxhi(mythid) |
7380 |
jmin = 1-oly |
7381 |
jmax = sny+oly |
7382 |
imin = 1-olx |
7383 |
imax = snx+olx |
7384 |
doglobalread = .false. |
7385 |
ladinit = .false. |
7386 |
il = ilnblnk(xx_tauu_file) |
7387 |
write(fnametauu(1:80),'(2a,i10.10)') xx_tauu_file(1:il),'.', |
7388 |
$optimcycle |
7389 |
il = ilnblnk(xx_tauv_file) |
7390 |
write(fnametauv(1:80),'(2a,i10.10)') xx_tauv_file(1:il),'.', |
7391 |
$optimcycle |
7392 |
il = ilnblnk(xx_sflux_file) |
7393 |
write(fnamesflux(1:80),'(2a,i10.10)') xx_sflux_file(1:il),'.', |
7394 |
$optimcycle |
7395 |
il = ilnblnk(xx_hflux_file) |
7396 |
write(fnamehflux(1:80),'(2a,i10.10)') xx_hflux_file(1:il),'.', |
7397 |
$optimcycle |
7398 |
do bj = jtlo, jthi |
7399 |
do bi = itlo, ithi |
7400 |
do j = jmin, jmax |
7401 |
do i = imin, imax |
7402 |
adtmpfld2d(i,j,bi,bj) = adtmpfld2d(i,j,bi,bj)+adqnet(i,j, |
7403 |
$bi,bj) |
7404 |
end do |
7405 |
end do |
7406 |
end do |
7407 |
end do |
7408 |
call adactive_read_xy( fnamehflux,1,doglobalread,ladinit, |
7409 |
$optimcycle,mythid,adtmpfld2d ) |
7410 |
do bj = jtlo, jthi |
7411 |
do bi = itlo, ithi |
7412 |
do j = jmin, jmax |
7413 |
do i = imin, imax |
7414 |
adtmpfld2d(i,j,bi,bj) = adtmpfld2d(i,j,bi,bj)+adempmr(i,j, |
7415 |
$bi,bj) |
7416 |
end do |
7417 |
end do |
7418 |
end do |
7419 |
end do |
7420 |
call adactive_read_xy( fnamesflux,1,doglobalread,ladinit, |
7421 |
$optimcycle,mythid,adtmpfld2d ) |
7422 |
do bj = jtlo, jthi |
7423 |
do bi = itlo, ithi |
7424 |
do j = jmin, jmax |
7425 |
do i = imin, imax |
7426 |
adtmpfld2d(i,j,bi,bj) = adtmpfld2d(i,j,bi,bj)+adfv(i,j,bi, |
7427 |
$bj) |
7428 |
end do |
7429 |
end do |
7430 |
end do |
7431 |
end do |
7432 |
call adactive_read_xy( fnametauv,1,doglobalread,ladinit, |
7433 |
$optimcycle,mythid,adtmpfld2d ) |
7434 |
do bj = jtlo, jthi |
7435 |
do bi = itlo, ithi |
7436 |
do j = jmin, jmax |
7437 |
do i = imin, imax |
7438 |
adtmpfld2d(i,j,bi,bj) = adtmpfld2d(i,j,bi,bj)+adfu(i,j,bi, |
7439 |
$bj) |
7440 |
end do |
7441 |
end do |
7442 |
end do |
7443 |
end do |
7444 |
call adactive_read_xy( fnametauu,1,doglobalread,ladinit, |
7445 |
$optimcycle,mythid,adtmpfld2d ) |
7446 |
|
7447 |
end |
7448 |
|
7449 |
|
7450 |
subroutine adctrl_map_ini( mythid ) |
7451 |
C*************************************************************** |
7452 |
C*************************************************************** |
7453 |
C** This routine was generated by the ** |
7454 |
C** Tangent linear and Adjoint Model Compiler, TAMC 5.2.14 ** |
7455 |
C*************************************************************** |
7456 |
C*************************************************************** |
7457 |
C============================================== |
7458 |
C all entries are defined explicitly |
7459 |
C============================================== |
7460 |
implicit none |
7461 |
|
7462 |
C============================================== |
7463 |
C define parameters |
7464 |
C============================================== |
7465 |
integer max_len_fnam |
7466 |
parameter ( max_len_fnam = 512 ) |
7467 |
integer max_no_threads |
7468 |
parameter ( max_no_threads = 32 ) |
7469 |
integer nr |
7470 |
parameter ( nr = 15 ) |
7471 |
integer nsx |
7472 |
parameter ( nsx = 1 ) |
7473 |
integer nsy |
7474 |
parameter ( nsy = 1 ) |
7475 |
integer olx |
7476 |
parameter ( olx = 3 ) |
7477 |
integer oly |
7478 |
parameter ( oly = 3 ) |
7479 |
integer optimcycle |
7480 |
parameter ( optimcycle = 0 ) |
7481 |
integer snx |
7482 |
parameter ( snx = 20 ) |
7483 |
integer sny |
7484 |
parameter ( sny = 40 ) |
7485 |
|
7486 |
C============================================== |
7487 |
C define common blocks |
7488 |
C============================================== |
7489 |
common /adcontrolvars_r/ adtmpfld2d, adtmpfld3d |
7490 |
double precision adtmpfld2d(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
7491 |
double precision adtmpfld3d(1-olx:snx+olx,1-oly:sny+oly,nr,nsx, |
7492 |
$nsy) |
7493 |
|
7494 |
common /addynvars_r/ adetan, aduvel, advvel, adwvel, adtheta, |
7495 |
$adsalt, adgu, adgv, adgt, adgs, adgunm1, adgvnm1, adgtnm1, adgsnm1 |
7496 |
double precision adetan(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
7497 |
double precision adgs(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
7498 |
double precision adgsnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
7499 |
double precision adgt(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
7500 |
double precision adgtnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
7501 |
double precision adgu(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
7502 |
double precision adgunm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
7503 |
double precision adgv(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
7504 |
double precision adgvnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
7505 |
double precision adsalt(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
7506 |
double precision adtheta(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
7507 |
double precision aduvel(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
7508 |
double precision advvel(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
7509 |
double precision adwvel(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
7510 |
|
7511 |
common /controlfiles_c/ xx_theta_file, xx_salt_file, xx_tauu_file, |
7512 |
$ xx_tauv_file, xx_sflux_file, xx_hflux_file, xx_sss_file, |
7513 |
$xx_sst_file, xx_diffkr_file, xx_kapgm_file |
7514 |
character*(max_len_fnam) xx_diffkr_file |
7515 |
character*(max_len_fnam) xx_hflux_file |
7516 |
character*(max_len_fnam) xx_kapgm_file |
7517 |
character*(max_len_fnam) xx_salt_file |
7518 |
character*(max_len_fnam) xx_sflux_file |
7519 |
character*(max_len_fnam) xx_sss_file |
7520 |
character*(max_len_fnam) xx_sst_file |
7521 |
character*(max_len_fnam) xx_tauu_file |
7522 |
character*(max_len_fnam) xx_tauv_file |
7523 |
character*(max_len_fnam) xx_theta_file |
7524 |
|
7525 |
common /eeparams_i/ errormessageunit, standardmessageunit, |
7526 |
$scrunit1, scrunit2, eedataunit, modeldataunit, numberofprocs, |
7527 |
$pidio, myprocid, mypx, mypy, myxgloballo, myygloballo, nthreads, |
7528 |
$mybxlo, mybxhi, mybylo, mybyhi, ntx, nty, ioerrorcount |
7529 |
integer eedataunit |
7530 |
integer errormessageunit |
7531 |
integer ioerrorcount(max_no_threads) |
7532 |
integer modeldataunit |
7533 |
integer mybxhi(max_no_threads) |
7534 |
integer mybxlo(max_no_threads) |
7535 |
integer mybyhi(max_no_threads) |
7536 |
integer mybylo(max_no_threads) |
7537 |
integer myprocid |
7538 |
integer mypx |
7539 |
integer mypy |
7540 |
integer myxgloballo |
7541 |
integer myygloballo |
7542 |
integer nthreads |
7543 |
integer ntx |
7544 |
integer nty |
7545 |
integer numberofprocs |
7546 |
integer pidio |
7547 |
integer scrunit1 |
7548 |
integer scrunit2 |
7549 |
integer standardmessageunit |
7550 |
|
7551 |
C============================================== |
7552 |
C define arguments |
7553 |
C============================================== |
7554 |
integer mythid |
7555 |
|
7556 |
C============================================== |
7557 |
C define local variables |
7558 |
C============================================== |
7559 |
integer bi |
7560 |
integer bj |
7561 |
logical doglobalread |
7562 |
logical equal |
7563 |
double precision fac |
7564 |
character*(80) fnamesalt |
7565 |
character*(80) fnametheta |
7566 |
integer i |
7567 |
integer il |
7568 |
integer imax |
7569 |
integer imin |
7570 |
integer ithi |
7571 |
integer itlo |
7572 |
integer j |
7573 |
integer jmax |
7574 |
integer jmin |
7575 |
integer jthi |
7576 |
integer jtlo |
7577 |
integer k |
7578 |
logical ladinit |
7579 |
|
7580 |
C============================================== |
7581 |
C define external procedures and functions |
7582 |
C============================================== |
7583 |
integer ilnblnk |
7584 |
external ilnblnk |
7585 |
|
7586 |
C---------------------------------------------- |
7587 |
C ROUTINE BODY |
7588 |
C---------------------------------------------- |
7589 |
jtlo = mybylo(mythid) |
7590 |
jthi = mybyhi(mythid) |
7591 |
itlo = mybxlo(mythid) |
7592 |
ithi = mybxhi(mythid) |
7593 |
jmin = 1-oly |
7594 |
jmax = sny+oly |
7595 |
imin = 1-olx |
7596 |
imax = snx+olx |
7597 |
doglobalread = .false. |
7598 |
ladinit = .false. |
7599 |
equal = .true. |
7600 |
if (equal) then |
7601 |
fac = 1.d0 |
7602 |
else |
7603 |
fac = 0.d0 |
7604 |
endif |
7605 |
il = ilnblnk(xx_theta_file) |
7606 |
write(fnametheta(1:80),'(2a,i10.10)') xx_theta_file(1:il),'.', |
7607 |
$optimcycle |
7608 |
il = ilnblnk(xx_salt_file) |
7609 |
write(fnamesalt(1:80),'(2a,i10.10)') xx_salt_file(1:il),'.', |
7610 |
$optimcycle |
7611 |
call adexch_xyz_r8( mythid,adgsnm1 ) |
7612 |
call adexch_xyz_r8( mythid,adsalt ) |
7613 |
call adexch_xyz_r8( mythid,adgtnm1 ) |
7614 |
call adexch_xyz_r8( mythid,adtheta ) |
7615 |
do bj = jtlo, jthi |
7616 |
do bi = itlo, ithi |
7617 |
do k = 1, nr |
7618 |
do j = jmin, jmax |
7619 |
do i = imin, imax |
7620 |
adtmpfld3d(i,j,k,bi,bj) = adtmpfld3d(i,j,k,bi,bj)+ |
7621 |
$adgsnm1(i,j,k,bi,bj)*fac |
7622 |
adtmpfld3d(i,j,k,bi,bj) = adtmpfld3d(i,j,k,bi,bj)+ |
7623 |
$adsalt(i,j,k,bi,bj)*fac |
7624 |
end do |
7625 |
end do |
7626 |
end do |
7627 |
end do |
7628 |
end do |
7629 |
call adactive_read_xyz( fnamesalt,1,doglobalread,ladinit, |
7630 |
$optimcycle,mythid,adtmpfld3d ) |
7631 |
do bj = jtlo, jthi |
7632 |
do bi = itlo, ithi |
7633 |
do k = 1, nr |
7634 |
do j = jmin, jmax |
7635 |
do i = imin, imax |
7636 |
adtmpfld3d(i,j,k,bi,bj) = adtmpfld3d(i,j,k,bi,bj)+ |
7637 |
$adgtnm1(i,j,k,bi,bj)*fac |
7638 |
adtmpfld3d(i,j,k,bi,bj) = adtmpfld3d(i,j,k,bi,bj)+ |
7639 |
$adtheta(i,j,k,bi,bj)*fac |
7640 |
end do |
7641 |
end do |
7642 |
end do |
7643 |
end do |
7644 |
end do |
7645 |
call adactive_read_xyz( fnametheta,1,doglobalread,ladinit, |
7646 |
$optimcycle,mythid,adtmpfld3d ) |
7647 |
|
7648 |
end |
7649 |
|
7650 |
|
7651 |
subroutine adcycle_tracer( bi, bj, imin, imax, jmin, jmax, k, |
7652 |
$adtracer, adgtracer, adgtrnm1 ) |
7653 |
C*************************************************************** |
7654 |
C*************************************************************** |
7655 |
C** This routine was generated by the ** |
7656 |
C** Tangent linear and Adjoint Model Compiler, TAMC 5.2.14 ** |
7657 |
C*************************************************************** |
7658 |
C*************************************************************** |
7659 |
C============================================== |
7660 |
C all entries are defined explicitly |
7661 |
C============================================== |
7662 |
implicit none |
7663 |
|
7664 |
C============================================== |
7665 |
C define parameters |
7666 |
C============================================== |
7667 |
integer nr |
7668 |
parameter ( nr = 15 ) |
7669 |
integer nsx |
7670 |
parameter ( nsx = 1 ) |
7671 |
integer nsy |
7672 |
parameter ( nsy = 1 ) |
7673 |
integer olx |
7674 |
parameter ( olx = 3 ) |
7675 |
integer oly |
7676 |
parameter ( oly = 3 ) |
7677 |
integer snx |
7678 |
parameter ( snx = 20 ) |
7679 |
integer sny |
7680 |
parameter ( sny = 40 ) |
7681 |
|
7682 |
C============================================== |
7683 |
C define common blocks |
7684 |
C============================================== |
7685 |
C============================================== |
7686 |
C define arguments |
7687 |
C============================================== |
7688 |
double precision adgtracer(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
7689 |
double precision adgtrnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
7690 |
double precision adtracer(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
7691 |
integer bi |
7692 |
integer bj |
7693 |
integer imax |
7694 |
integer imin |
7695 |
integer jmax |
7696 |
integer jmin |
7697 |
integer k |
7698 |
|
7699 |
C============================================== |
7700 |
C define local variables |
7701 |
C============================================== |
7702 |
integer i |
7703 |
integer j |
7704 |
|
7705 |
C---------------------------------------------- |
7706 |
C ROUTINE BODY |
7707 |
C---------------------------------------------- |
7708 |
do j = jmin, jmax |
7709 |
do i = imin, imax |
7710 |
adgtracer(i,j,k,bi,bj) = adgtracer(i,j,k,bi,bj)+adgtrnm1(i,j, |
7711 |
$k,bi,bj) |
7712 |
adgtrnm1(i,j,k,bi,bj) = 0.d0 |
7713 |
adgtrnm1(i,j,k,bi,bj) = adgtrnm1(i,j,k,bi,bj)+adtracer(i,j,k, |
7714 |
$bi,bj) |
7715 |
adtracer(i,j,k,bi,bj) = 0.d0 |
7716 |
end do |
7717 |
end do |
7718 |
|
7719 |
end |
7720 |
|
7721 |
|
7722 |
subroutine addo_fields_blocking_exchanges( mythid ) |
7723 |
C*************************************************************** |
7724 |
C*************************************************************** |
7725 |
C** This routine was generated by the ** |
7726 |
C** Tangent linear and Adjoint Model Compiler, TAMC 5.2.14 ** |
7727 |
C*************************************************************** |
7728 |
C*************************************************************** |
7729 |
C============================================== |
7730 |
C all entries are defined explicitly |
7731 |
C============================================== |
7732 |
implicit none |
7733 |
|
7734 |
C============================================== |
7735 |
C define parameters |
7736 |
C============================================== |
7737 |
integer nr |
7738 |
parameter ( nr = 15 ) |
7739 |
integer nsx |
7740 |
parameter ( nsx = 1 ) |
7741 |
integer nsy |
7742 |
parameter ( nsy = 1 ) |
7743 |
integer olx |
7744 |
parameter ( olx = 3 ) |
7745 |
integer oly |
7746 |
parameter ( oly = 3 ) |
7747 |
integer snx |
7748 |
parameter ( snx = 20 ) |
7749 |
integer sny |
7750 |
parameter ( sny = 40 ) |
7751 |
|
7752 |
C============================================== |
7753 |
C define common blocks |
7754 |
C============================================== |
7755 |
common /addynvars_cd/ aduveld, advveld, adetanm1, adunm1, advnm1, |
7756 |
$adgucd, adgvcd |
7757 |
double precision adetanm1(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
7758 |
double precision adgucd(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
7759 |
double precision adgvcd(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
7760 |
double precision adunm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
7761 |
double precision aduveld(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
7762 |
double precision advnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
7763 |
double precision advveld(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
7764 |
|
7765 |
common /addynvars_r/ adetan, aduvel, advvel, adwvel, adtheta, |
7766 |
$adsalt, adgu, adgv, adgt, adgs, adgunm1, adgvnm1, adgtnm1, adgsnm1 |
7767 |
double precision adetan(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
7768 |
double precision adgs(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
7769 |
double precision adgsnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
7770 |
double precision adgt(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
7771 |
double precision adgtnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
7772 |
double precision adgu(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
7773 |
double precision adgunm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
7774 |
double precision adgv(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
7775 |
double precision adgvnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
7776 |
double precision adsalt(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
7777 |
double precision adtheta(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
7778 |
double precision aduvel(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
7779 |
double precision advvel(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
7780 |
double precision adwvel(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
7781 |
|
7782 |
C============================================== |
7783 |
C define arguments |
7784 |
C============================================== |
7785 |
integer mythid |
7786 |
|
7787 |
C---------------------------------------------- |
7788 |
C ROUTINE BODY |
7789 |
C---------------------------------------------- |
7790 |
call adexch_xyz_r8( mythid,advveld ) |
7791 |
call adexch_xyz_r8( mythid,aduveld ) |
7792 |
call adexch_xyz_r8( mythid,adsalt ) |
7793 |
call adexch_xyz_r8( mythid,adtheta ) |
7794 |
call adexch_xyz_r8( mythid,advvel ) |
7795 |
call adexch_xyz_r8( mythid,aduvel ) |
7796 |
|
7797 |
end |
7798 |
|
7799 |
|
7800 |
subroutine mddynamics( mytime, myiter, mythid ) |
7801 |
C*************************************************************** |
7802 |
C*************************************************************** |
7803 |
C** This routine was generated by the ** |
7804 |
C** Tangent linear and Adjoint Model Compiler, TAMC 5.2.14 ** |
7805 |
C*************************************************************** |
7806 |
C*************************************************************** |
7807 |
C============================================== |
7808 |
C all entries are defined explicitly |
7809 |
C============================================== |
7810 |
implicit none |
7811 |
|
7812 |
C============================================== |
7813 |
C define parameters |
7814 |
C============================================== |
7815 |
integer max_no_threads |
7816 |
parameter ( max_no_threads = 32 ) |
7817 |
integer npx |
7818 |
parameter ( npx = 1 ) |
7819 |
integer npy |
7820 |
parameter ( npy = 1 ) |
7821 |
integer nr |
7822 |
parameter ( nr = 15 ) |
7823 |
integer nsx |
7824 |
parameter ( nsx = 1 ) |
7825 |
integer nsy |
7826 |
parameter ( nsy = 1 ) |
7827 |
integer snx |
7828 |
parameter ( snx = 20 ) |
7829 |
integer nx |
7830 |
parameter ( nx = snx*nsx*npx ) |
7831 |
integer sny |
7832 |
parameter ( sny = 40 ) |
7833 |
integer ny |
7834 |
parameter ( ny = sny*nsy*npy ) |
7835 |
integer olx |
7836 |
parameter ( olx = 3 ) |
7837 |
integer oly |
7838 |
parameter ( oly = 3 ) |
7839 |
|
7840 |
C============================================== |
7841 |
C define common blocks |
7842 |
C============================================== |
7843 |
common /cadgsnm1/ gsnm1h |
7844 |
real*4 gsnm1h(1+snx+olx-(1-olx),1+sny+oly-(1-oly),nr,36) |
7845 |
|
7846 |
common /cadgtnm1/ gtnm1h |
7847 |
real*4 gtnm1h(1+snx+olx-(1-olx),1+sny+oly-(1-oly),nr,36) |
7848 |
|
7849 |
common /cadgtnm2/ gtnm1i |
7850 |
real*4 gtnm1i(1+snx+olx-(1-olx),1+sny+oly-(1-oly),540) |
7851 |
|
7852 |
common /cadgunm1/ gunm1h |
7853 |
real*4 gunm1h(1+snx+olx-(1-olx),1+sny+oly-(1-oly),nr,36) |
7854 |
|
7855 |
common /cadgvnm1/ gvnm1h |
7856 |
real*4 gvnm1h(1+snx+olx-(1-olx),1+sny+oly-(1-oly),nr,36) |
7857 |
|
7858 |
common /cadkappars/ kapparsh |
7859 |
real*4 kapparsh(1+snx+olx-(1-olx),1+sny+oly-(1-oly),540) |
7860 |
|
7861 |
common /cadkappart/ kapparth |
7862 |
real*4 kapparth(1+snx+olx-(1-olx),1+sny+oly-(1-oly),540) |
7863 |
|
7864 |
common /cadkapparu/ kapparsi |
7865 |
real*4 kapparsi(1+snx+olx-(1-olx),1+sny+oly-(1-oly),nr,36) |
7866 |
|
7867 |
common /cadkapparv/ kapparti |
7868 |
real*4 kapparti(1+snx+olx-(1-olx),1+sny+oly-(1-oly),nr,36) |
7869 |
|
7870 |
common /cadkppdiffkzs/ kppdiffkzsh |
7871 |
real*4 kppdiffkzsh(1+snx+olx-(1-olx),1+sny+oly-(1-oly),nr,36) |
7872 |
|
7873 |
common /cadkppdiffkzt/ kppdiffkzth |
7874 |
real*4 kppdiffkzth(1+snx+olx-(1-olx),1+sny+oly-(1-oly),nr,36) |
7875 |
|
7876 |
common /cadkppfrac/ kppfrach |
7877 |
real*4 kppfrach(1+snx+olx-(1-olx),1+sny+oly-(1-oly),36) |
7878 |
|
7879 |
common /cadkppghat/ kppghath |
7880 |
real*4 kppghath(1+snx+olx-(1-olx),1+sny+oly-(1-oly),nr,36) |
7881 |
|
7882 |
common /cadkppviscaz/ kppviscazh |
7883 |
real*4 kppviscazh(1+snx+olx-(1-olx),1+sny+oly-(1-oly),nr,36) |
7884 |
|
7885 |
common /cadkwx/ kwxh |
7886 |
real*4 kwxh(1+snx+olx-(1-olx),1+sny+oly-(1-oly),nr,36) |
7887 |
|
7888 |
common /cadkwy/ kwyh |
7889 |
real*4 kwyh(1+snx+olx-(1-olx),1+sny+oly-(1-oly),nr,36) |
7890 |
|
7891 |
common /cadkwz/ kwzh |
7892 |
real*4 kwzh(1+snx+olx-(1-olx),1+sny+oly-(1-oly),nr,36) |
7893 |
|
7894 |
common /cadrhokm2/ rhokm1h |
7895 |
real*4 rhokm1h(1+snx+olx-(1-olx),1+sny+oly-(1-oly),540) |
7896 |
|
7897 |
common /cadrhol/ rhokh |
7898 |
real*4 rhokh(1+snx+olx-(1-olx),1+sny+oly-(1-oly),540) |
7899 |
|
7900 |
common /cadsalw/ salth |
7901 |
real*4 salth(1+snx+olx-(1-olx),1+sny+oly-(1-oly),nr,36) |
7902 |
|
7903 |
common /cadsalx/ salti |
7904 |
real*4 salti(1+snx+olx-(1-olx),1+sny+oly-(1-oly),nr,36) |
7905 |
|
7906 |
common /cadsaly/ saltj |
7907 |
real*4 saltj(1+snx+olx-(1-olx),1+sny+oly-(1-oly),540) |
7908 |
|
7909 |
common /cadsalz/ saltk |
7910 |
real*4 saltk(1+snx+olx-(1-olx),1+sny+oly-(1-oly),540) |
7911 |
|
7912 |
common /cadsigmar/ sigmarh |
7913 |
real*4 sigmarh(1+snx+olx-(1-olx),1+sny+oly-(1-oly),nr,36) |
7914 |
|
7915 |
common /cadsigmax/ sigmaxh |
7916 |
real*4 sigmaxh(1+snx+olx-(1-olx),1+sny+oly-(1-oly),nr,36) |
7917 |
|
7918 |
common /cadsigmay/ sigmayh |
7919 |
real*4 sigmayh(1+snx+olx-(1-olx),1+sny+oly-(1-oly),nr,36) |
7920 |
|
7921 |
common /cadsurfacetendencys/ surfacetendencysh |
7922 |
real*4 surfacetendencysh(1+snx+olx-(1-olx),1+sny+oly-(1-oly),36) |
7923 |
|
7924 |
common /cadsurfacetendencyt/ surfacetendencyth |
7925 |
real*4 surfacetendencyth(1+snx+olx-(1-olx),1+sny+oly-(1-oly),36) |
7926 |
|
7927 |
common /cadsurfacetendencyu/ surfacetendencyuh |
7928 |
real*4 surfacetendencyuh(1+snx+olx-(1-olx),1+sny+oly-(1-oly),36) |
7929 |
|
7930 |
common /cadsurfacetendencyv/ surfacetendencyvh |
7931 |
real*4 surfacetendencyvh(1+snx+olx-(1-olx),1+sny+oly-(1-oly),36) |
7932 |
|
7933 |
common /cadthetd/ thetah |
7934 |
real*4 thetah(1+snx+olx-(1-olx),1+sny+oly-(1-oly),nr,36) |
7935 |
|
7936 |
common /cadthete/ thetai |
7937 |
real*4 thetai(1+snx+olx-(1-olx),1+sny+oly-(1-oly),nr,36) |
7938 |
|
7939 |
common /cadthetf/ thetaj |
7940 |
real*4 thetaj(1+snx+olx-(1-olx),1+sny+oly-(1-oly),540) |
7941 |
|
7942 |
common /cadthetg/ thetak |
7943 |
real*4 thetak(1+snx+olx-(1-olx),1+sny+oly-(1-oly),540) |
7944 |
|
7945 |
common /caduvel/ uvelh |
7946 |
real*4 uvelh(1+snx+olx-(1-olx),1+sny+oly-(1-oly),nr,36) |
7947 |
|
7948 |
common /caduveld/ uveldh |
7949 |
real*4 uveldh(1+snx+olx-(1-olx),1+sny+oly-(1-oly),nr,36) |
7950 |
|
7951 |
common /caduvem/ uveli |
7952 |
real*4 uveli(1+snx+olx-(1-olx),1+sny+oly-(1-oly),nr,36) |
7953 |
|
7954 |
common /cadvvel/ vvelh |
7955 |
real*4 vvelh(1+snx+olx-(1-olx),1+sny+oly-(1-oly),nr,36) |
7956 |
|
7957 |
common /cadvveld/ vveldh |
7958 |
real*4 vveldh(1+snx+olx-(1-olx),1+sny+oly-(1-oly),nr,36) |
7959 |
|
7960 |
common /cadvvem/ vveli |
7961 |
real*4 vveli(1+snx+olx-(1-olx),1+sny+oly-(1-oly),nr,36) |
7962 |
|
7963 |
common /cadwvel/ wvelh |
7964 |
real*4 wvelh(1+snx+olx-(1-olx),1+sny+oly-(1-oly),nr,36) |
7965 |
|
7966 |
common /dynvars_cd/ uveld, vveld, etanm1, unm1, vnm1, gucd, gvcd |
7967 |
double precision etanm1(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
7968 |
double precision gucd(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
7969 |
double precision gvcd(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
7970 |
double precision unm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
7971 |
double precision uveld(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
7972 |
double precision vnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
7973 |
double precision vveld(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
7974 |
|
7975 |
common /dynvars_r/ etan, uvel, vvel, wvel, theta, salt, gu, gv, |
7976 |
$gt, gs, gunm1, gvnm1, gtnm1, gsnm1 |
7977 |
double precision etan(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
7978 |
double precision gs(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
7979 |
double precision gsnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
7980 |
double precision gt(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
7981 |
double precision gtnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
7982 |
double precision gu(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
7983 |
double precision gunm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
7984 |
double precision gv(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
7985 |
double precision gvnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
7986 |
double precision salt(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
7987 |
double precision theta(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
7988 |
double precision uvel(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
7989 |
double precision vvel(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
7990 |
double precision wvel(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
7991 |
|
7992 |
common /eeparams_i/ errormessageunit, standardmessageunit, |
7993 |
$scrunit1, scrunit2, eedataunit, modeldataunit, numberofprocs, |
7994 |
$pidio, myprocid, mypx, mypy, myxgloballo, myygloballo, nthreads, |
7995 |
$mybxlo, mybxhi, mybylo, mybyhi, ntx, nty, ioerrorcount |
7996 |
integer eedataunit |
7997 |
integer errormessageunit |
7998 |
integer ioerrorcount(max_no_threads) |
7999 |
integer modeldataunit |
8000 |
integer mybxhi(max_no_threads) |
8001 |
integer mybxlo(max_no_threads) |
8002 |
integer mybyhi(max_no_threads) |
8003 |
integer mybylo(max_no_threads) |
8004 |
integer myprocid |
8005 |
integer mypx |
8006 |
integer mypy |
8007 |
integer myxgloballo |
8008 |
integer myygloballo |
8009 |
integer nthreads |
8010 |
integer ntx |
8011 |
integer nty |
8012 |
integer numberofprocs |
8013 |
integer pidio |
8014 |
integer scrunit1 |
8015 |
integer scrunit2 |
8016 |
integer standardmessageunit |
8017 |
|
8018 |
common /gm_wtensor/ kwx, kwy, kwz |
8019 |
double precision kwx(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
8020 |
double precision kwy(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
8021 |
double precision kwz(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
8022 |
|
8023 |
common /grid_r/ dxc, dxf, dxg, dxv, dyc, dyf, dyg, dyu, drc, drf, |
8024 |
$h, hfacc, hfacw, hfacs, depthink, recip_dxc, recip_dxf, recip_dxg, |
8025 |
$ recip_dxv, recip_dyc, recip_dyf, recip_dyg, recip_dyu, recip_drc, |
8026 |
$ recip_drf, recip_h, recip_hfacc, recip_hfacw, recip_hfacs, rkfac, |
8027 |
$ recip_rkfac, safac, xc, yc, ra, raw, ras, raz, rc, rf, yc0, xc0, |
8028 |
$xg, yg, maskw, masks, recip_ra, recip_raw, recip_ras, recip_raz, |
8029 |
$tanphiatu, tanphiatv |
8030 |
double precision depthink(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
8031 |
double precision drc(1:nr) |
8032 |
double precision drf(1:nr) |
8033 |
double precision dxc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
8034 |
double precision dxf(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
8035 |
double precision dxg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
8036 |
double precision dxv(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
8037 |
double precision dyc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
8038 |
double precision dyf(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
8039 |
double precision dyg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
8040 |
double precision dyu(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
8041 |
double precision h(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
8042 |
double precision hfacc(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) |
8043 |
double precision hfacs(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) |
8044 |
double precision hfacw(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) |
8045 |
double precision masks(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) |
8046 |
double precision maskw(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) |
8047 |
double precision ra(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
8048 |
double precision ras(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
8049 |
double precision raw(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
8050 |
double precision raz(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
8051 |
double precision rc(1:nr) |
8052 |
double precision recip_drc(1:nr) |
8053 |
double precision recip_drf(1:nr) |
8054 |
double precision recip_dxc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
8055 |
double precision recip_dxf(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
8056 |
double precision recip_dxg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
8057 |
double precision recip_dxv(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
8058 |
double precision recip_dyc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
8059 |
double precision recip_dyf(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
8060 |
double precision recip_dyg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
8061 |
double precision recip_dyu(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
8062 |
double precision recip_h(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
8063 |
double precision recip_hfacc(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx, |
8064 |
$nsy) |
8065 |
double precision recip_hfacs(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx, |
8066 |
$nsy) |
8067 |
double precision recip_hfacw(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx, |
8068 |
$nsy) |
8069 |
double precision recip_ra(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
8070 |
double precision recip_ras(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
8071 |
double precision recip_raw(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
8072 |
double precision recip_raz(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
8073 |
double precision recip_rkfac |
8074 |
double precision rf(1:nr+1) |
8075 |
double precision rkfac |
8076 |
double precision safac(1:nr) |
8077 |
double precision tanphiatu(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
8078 |
double precision tanphiatv(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
8079 |
double precision xc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
8080 |
double precision xc0 |
8081 |
double precision xg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
8082 |
double precision yc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
8083 |
double precision yc0 |
8084 |
double precision yg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
8085 |
|
8086 |
common /kpp/ kppviscaz, kppdiffkzt, kppdiffkzs, kppghat, kpphbl |
8087 |
double precision kppdiffkzs(1-olx:snx+olx,1-oly:sny+oly,nr,nsx, |
8088 |
$nsy) |
8089 |
double precision kppdiffkzt(1-olx:snx+olx,1-oly:sny+oly,nr,nsx, |
8090 |
$nsy) |
8091 |
double precision kppghat(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
8092 |
double precision kpphbl(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
8093 |
double precision kppviscaz(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
8094 |
|
8095 |
common /kpp_short/ kppfrac |
8096 |
double precision kppfrac(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
8097 |
|
8098 |
common /parm_eos_lin/ talpha, sbeta, eostype |
8099 |
character*(6) eostype |
8100 |
double precision sbeta |
8101 |
double precision talpha |
8102 |
|
8103 |
common /parm_l/ usingcartesiangrid, usingsphericalpolargrid, |
8104 |
$no_slip_sides, no_slip_bottom, staggertimestep, momviscosity, |
8105 |
$momadvection, momforcing, usecoriolis, mompressureforcing, |
8106 |
$tempdiffusion, tempadvection, tempforcing, saltdiffusion, |
8107 |
$saltadvection, saltforcing, implicitfreesurface, rigidlid, |
8108 |
$momstepping, tempstepping, saltstepping, metricterms, |
8109 |
$usingsphericalpolarmterms, useconstantf, usebetaplanef, |
8110 |
$usespheref, implicitdiffusion, implicitviscosity, |
8111 |
$dothetaclimrelax, dosaltclimrelax, periodicexternalforcing, |
8112 |
$usingpcoords, usingzcoords, nonhydrostatic, globalfiles, |
8113 |
$allowfreezing, groundatk1, usepickupbeforec35 |
8114 |
logical allowfreezing |
8115 |
logical dosaltclimrelax |
8116 |
logical dothetaclimrelax |
8117 |
logical globalfiles |
8118 |
logical groundatk1 |
8119 |
logical implicitdiffusion |
8120 |
logical implicitfreesurface |
8121 |
logical implicitviscosity |
8122 |
logical metricterms |
8123 |
logical momadvection |
8124 |
logical momforcing |
8125 |
logical mompressureforcing |
8126 |
logical momstepping |
8127 |
logical momviscosity |
8128 |
logical no_slip_bottom |
8129 |
logical no_slip_sides |
8130 |
logical nonhydrostatic |
8131 |
logical periodicexternalforcing |
8132 |
logical rigidlid |
8133 |
logical saltadvection |
8134 |
logical saltdiffusion |
8135 |
logical saltforcing |
8136 |
logical saltstepping |
8137 |
logical staggertimestep |
8138 |
logical tempadvection |
8139 |
logical tempdiffusion |
8140 |
logical tempforcing |
8141 |
logical tempstepping |
8142 |
logical usebetaplanef |
8143 |
logical useconstantf |
8144 |
logical usecoriolis |
8145 |
logical usepickupbeforec35 |
8146 |
logical usespheref |
8147 |
logical usingcartesiangrid |
8148 |
logical usingpcoords |
8149 |
logical usingsphericalpolargrid |
8150 |
logical usingsphericalpolarmterms |
8151 |
logical usingzcoords |
8152 |
|
8153 |
common /parm_packages/ usekpp, usegmredi, useobcs, useaim, useecco |
8154 |
logical useaim |
8155 |
logical useecco |
8156 |
logical usegmredi |
8157 |
logical usekpp |
8158 |
logical useobcs |
8159 |
|
8160 |
common /parm_r/ cg2dtargetresidual, cg2dpcoffdfac, |
8161 |
$cg3dtargetresidual, delp, delz, delr, delx, dely, deltat, |
8162 |
$deltatmom, deltattracer, deltatclock, abeps, starttime, phimin, |
8163 |
$thetamin, rsphere, recip_rsphere, f0, fcori, beta, viscah, viscaz, |
8164 |
$ visca4, viscar, diffkht, diffkzt, diffk4t, diffkrt, diffkhs, |
8165 |
$diffkzs, diffk4s, diffkrs, delt, taucd, rcd, freesurffac, |
8166 |
$implicsurfpress, implicdiv2dflow, hfacmin, hfacmindz, gravity, |
8167 |
$recip_gravity, gbaro, rhonil, recip_rhonil, recip_rhoconst, |
8168 |
$rhoconst, tref, sref, endtime, chkptfreq, pchkptfreq, dumpfreq, |
8169 |
$tavefreq, affacmom, vffacmom, pffacmom, cffacmom, fofacmom, |
8170 |
$mtfacmom, cospower, cadjfreq, omega, tauthetaclimrelax, |
8171 |
$lambdathetaclimrelax, tausaltclimrelax, lambdasaltclimrelax, |
8172 |
$externforcingcycle, externforcingperiod, viscap, diffkpt, diffkps, |
8173 |
$ hfacmindr, hfacmindp, theta_s, specvol_s, horivertratio, |
8174 |
$recip_horivertratio, latfftfiltlo, ivdc_kappa, ro_sealevel, |
8175 |
$zonal_filt_lat, bottomdraglinear, bottomdragquadratic |
8176 |
double precision abeps |
8177 |
double precision affacmom |
8178 |
double precision beta |
8179 |
double precision bottomdraglinear |
8180 |
double precision bottomdragquadratic |
8181 |
double precision cadjfreq |
8182 |
double precision cffacmom |
8183 |
double precision cg2dpcoffdfac |
8184 |
double precision cg2dtargetresidual |
8185 |
double precision cg3dtargetresidual |
8186 |
double precision chkptfreq |
8187 |
double precision cospower |
8188 |
double precision delp(nr) |
8189 |
double precision delr(nr) |
8190 |
double precision delt |
8191 |
double precision deltat |
8192 |
double precision deltatclock |
8193 |
double precision deltatmom |
8194 |
double precision deltattracer |
8195 |
double precision delx(nx) |
8196 |
double precision dely(ny) |
8197 |
double precision delz(nr) |
8198 |
double precision diffk4s |
8199 |
double precision diffk4t |
8200 |
double precision diffkhs |
8201 |
double precision diffkht |
8202 |
double precision diffkps |
8203 |
double precision diffkpt |
8204 |
double precision diffkrs |
8205 |
double precision diffkrt |
8206 |
double precision diffkzs |
8207 |
double precision diffkzt |
8208 |
double precision dumpfreq |
8209 |
double precision endtime |
8210 |
double precision externforcingcycle |
8211 |
double precision externforcingperiod |
8212 |
double precision f0 |
8213 |
double precision fcori(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
8214 |
double precision fofacmom |
8215 |
double precision freesurffac |
8216 |
double precision gbaro |
8217 |
double precision gravity |
8218 |
double precision hfacmin |
8219 |
double precision hfacmindp |
8220 |
double precision hfacmindr |
8221 |
double precision hfacmindz |
8222 |
double precision horivertratio |
8223 |
double precision implicdiv2dflow |
8224 |
double precision implicsurfpress |
8225 |
double precision ivdc_kappa |
8226 |
double precision lambdasaltclimrelax |
8227 |
double precision lambdathetaclimrelax |
8228 |
double precision latfftfiltlo |
8229 |
double precision mtfacmom |
8230 |
double precision omega |
8231 |
double precision pchkptfreq |
8232 |
double precision pffacmom |
8233 |
double precision phimin |
8234 |
double precision rcd |
8235 |
double precision recip_gravity |
8236 |
double precision recip_horivertratio |
8237 |
double precision recip_rhoconst |
8238 |
double precision recip_rhonil |
8239 |
double precision recip_rsphere |
8240 |
double precision rhoconst |
8241 |
double precision rhonil |
8242 |
double precision ro_sealevel |
8243 |
double precision rsphere |
8244 |
double precision specvol_s(nr) |
8245 |
double precision sref(nr) |
8246 |
double precision starttime |
8247 |
double precision taucd |
8248 |
double precision tausaltclimrelax |
8249 |
double precision tauthetaclimrelax |
8250 |
double precision tavefreq |
8251 |
double precision theta_s(nr) |
8252 |
double precision thetamin |
8253 |
double precision tref(nr) |
8254 |
double precision vffacmom |
8255 |
double precision visca4 |
8256 |
double precision viscah |
8257 |
double precision viscap |
8258 |
double precision viscar |
8259 |
double precision viscaz |
8260 |
double precision zonal_filt_lat |
8261 |
|
8262 |
common /tamc_keys_i/ ikey_dynamics, ikey_yearly, ikey_daily_1, |
8263 |
$ikey_daily_2, iloop_daily |
8264 |
integer ikey_daily_1 |
8265 |
integer ikey_daily_2 |
8266 |
integer ikey_dynamics |
8267 |
integer ikey_yearly |
8268 |
integer iloop_daily |
8269 |
|
8270 |
common /tamckeys/ key, ikey, idkey |
8271 |
integer idkey |
8272 |
integer ikey |
8273 |
integer key |
8274 |
|
8275 |
common /tendency_forcing/ surfacetendencyu, surfacetendencyv, |
8276 |
$surfacetendencyt, surfacetendencys, tempqsw |
8277 |
double precision surfacetendencys(1-olx:snx+olx,1-oly:sny+oly,nsx, |
8278 |
$nsy) |
8279 |
double precision surfacetendencyt(1-olx:snx+olx,1-oly:sny+oly,nsx, |
8280 |
$nsy) |
8281 |
double precision surfacetendencyu(1-olx:snx+olx,1-oly:sny+oly,nsx, |
8282 |
$nsy) |
8283 |
double precision surfacetendencyv(1-olx:snx+olx,1-oly:sny+oly,nsx, |
8284 |
$nsy) |
8285 |
double precision tempqsw(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
8286 |
|
8287 |
C============================================== |
8288 |
C define arguments |
8289 |
C============================================== |
8290 |
integer myiter |
8291 |
integer mythid |
8292 |
double precision mytime |
8293 |
|
8294 |
C============================================== |
8295 |
C define local variables |
8296 |
C============================================== |
8297 |
integer act1 |
8298 |
integer act2 |
8299 |
integer act3 |
8300 |
integer act4 |
8301 |
integer bi |
8302 |
integer bj |
8303 |
double precision convectcount(1-olx:snx+olx,1-oly:sny+oly,nr) |
8304 |
double precision fvers(1-olx:snx+olx,1-oly:sny+oly,2) |
8305 |
double precision fvert(1-olx:snx+olx,1-oly:sny+oly,2) |
8306 |
double precision fveru(1-olx:snx+olx,1-oly:sny+oly,2) |
8307 |
double precision fverv(1-olx:snx+olx,1-oly:sny+oly,2) |
8308 |
integer help_h |
8309 |
integer i |
8310 |
integer imax |
8311 |
integer imin |
8312 |
integer ip1 |
8313 |
integer ip2 |
8314 |
integer ip3 |
8315 |
integer j |
8316 |
integer jmax |
8317 |
integer jmin |
8318 |
integer k |
8319 |
double precision kappars(1-olx:snx+olx,1-oly:sny+oly,nr) |
8320 |
double precision kappart(1-olx:snx+olx,1-oly:sny+oly,nr) |
8321 |
double precision kapparu(1-olx:snx+olx,1-oly:sny+oly,nr) |
8322 |
double precision kapparv(1-olx:snx+olx,1-oly:sny+oly,nr) |
8323 |
integer kdown |
8324 |
integer kkey |
8325 |
integer km1 |
8326 |
integer kup |
8327 |
double precision maskc(1-olx:snx+olx,1-oly:sny+oly) |
8328 |
double precision maskup(1-olx:snx+olx,1-oly:sny+oly) |
8329 |
integer max1 |
8330 |
integer max2 |
8331 |
integer max3 |
8332 |
double precision phihyd(1-olx:snx+olx,1-oly:sny+oly,nr) |
8333 |
double precision phisurfx(1-olx:snx+olx,1-oly:sny+oly) |
8334 |
double precision phisurfy(1-olx:snx+olx,1-oly:sny+oly) |
8335 |
double precision rhok(1-olx:snx+olx,1-oly:sny+oly) |
8336 |
double precision rhokm1(1-olx:snx+olx,1-oly:sny+oly) |
8337 |
double precision rtrans(1-olx:snx+olx,1-oly:sny+oly) |
8338 |
double precision sigmar(1-olx:snx+olx,1-oly:sny+oly,nr) |
8339 |
double precision sigmax(1-olx:snx+olx,1-oly:sny+oly,nr) |
8340 |
double precision sigmay(1-olx:snx+olx,1-oly:sny+oly,nr) |
8341 |
double precision utrans(1-olx:snx+olx,1-oly:sny+oly) |
8342 |
double precision vtrans(1-olx:snx+olx,1-oly:sny+oly) |
8343 |
double precision xa(1-olx:snx+olx,1-oly:sny+oly) |
8344 |
double precision ya(1-olx:snx+olx,1-oly:sny+oly) |
8345 |
|
8346 |
C********************************************** |
8347 |
C executable statements of routine |
8348 |
C********************************************** |
8349 |
do j = 1-oly, sny+oly |
8350 |
do i = 1-olx, snx+olx |
8351 |
do k = 1, nr |
8352 |
phihyd(i,j,k) = 0.d0 |
8353 |
sigmax(i,j,k) = 0.d0 |
8354 |
sigmay(i,j,k) = 0.d0 |
8355 |
sigmar(i,j,k) = 0.d0 |
8356 |
end do |
8357 |
rhokm1(i,j) = 0.d0 |
8358 |
rhok(i,j) = 0.d0 |
8359 |
phisurfx(i,j) = 0.d0 |
8360 |
phisurfy(i,j) = 0.d0 |
8361 |
end do |
8362 |
end do |
8363 |
do bj = mybylo(mythid), mybyhi(mythid) |
8364 |
do bi = mybxlo(mythid), mybxhi(mythid) |
8365 |
act1 = bi-mybxlo(mythid) |
8366 |
max1 = mybxhi(mythid)-mybxlo(mythid)+1 |
8367 |
act2 = bj-mybylo(mythid) |
8368 |
max2 = mybyhi(mythid)-mybylo(mythid)+1 |
8369 |
act3 = mythid-1 |
8370 |
max3 = ntx*nty |
8371 |
act4 = ikey_dynamics-1 |
8372 |
ikey = act1+1+act2*max1+act3*max1*max2+act4*max1*max2*max3 |
8373 |
do j = 1-oly, sny+oly |
8374 |
do i = 1-olx, snx+olx |
8375 |
fvert(i,j,1) = 0.d0 |
8376 |
fvert(i,j,2) = 0.d0 |
8377 |
fvers(i,j,1) = 0.d0 |
8378 |
fvers(i,j,2) = 0.d0 |
8379 |
fveru(i,j,1) = 0.d0 |
8380 |
fveru(i,j,2) = 0.d0 |
8381 |
fverv(i,j,1) = 0.d0 |
8382 |
fverv(i,j,2) = 0.d0 |
8383 |
end do |
8384 |
end do |
8385 |
do k = 1, nr |
8386 |
do j = 1-oly, sny+oly |
8387 |
do i = 1-olx, snx+olx |
8388 |
kappart(i,j,k) = 0.d0 |
8389 |
kappars(i,j,k) = 0.d0 |
8390 |
end do |
8391 |
end do |
8392 |
end do |
8393 |
imin = 1-olx+1 |
8394 |
imax = snx+olx |
8395 |
jmin = 1-oly+1 |
8396 |
jmax = sny+oly |
8397 |
do ip3 = 1, nr |
8398 |
do ip2 = 1, 1+sny+oly-(1-oly) |
8399 |
do ip1 = 1, 1+snx+olx-(1-olx) |
8400 |
thetai(ip1,ip2,ip3,ikey) = theta(ip1-1+1-olx,ip2-1+1- |
8401 |
$oly,ip3,bi,bj) |
8402 |
end do |
8403 |
end do |
8404 |
end do |
8405 |
do ip3 = 1, nr |
8406 |
do ip2 = 1, 1+sny+oly-(1-oly) |
8407 |
do ip1 = 1, 1+snx+olx-(1-olx) |
8408 |
salti(ip1,ip2,ip3,ikey) = salt(ip1-1+1-olx,ip2-1+1-oly, |
8409 |
$ip3,bi,bj) |
8410 |
end do |
8411 |
end do |
8412 |
end do |
8413 |
do ip3 = 1, nr |
8414 |
do ip2 = 1, 1+sny+oly-(1-oly) |
8415 |
do ip1 = 1, 1+snx+olx-(1-olx) |
8416 |
uveli(ip1,ip2,ip3,ikey) = uvel(ip1-1+1-olx,ip2-1+1-oly, |
8417 |
$ip3,bi,bj) |
8418 |
end do |
8419 |
end do |
8420 |
end do |
8421 |
do ip3 = 1, nr |
8422 |
do ip2 = 1, 1+sny+oly-(1-oly) |
8423 |
do ip1 = 1, 1+snx+olx-(1-olx) |
8424 |
vveli(ip1,ip2,ip3,ikey) = vvel(ip1-1+1-olx,ip2-1+1-oly, |
8425 |
$ip3,bi,bj) |
8426 |
end do |
8427 |
end do |
8428 |
end do |
8429 |
do k = nr, 1, -1 |
8430 |
kkey = (ikey-1)*nr+k |
8431 |
do ip2 = 1, 1+sny+oly-(1-oly) |
8432 |
do ip1 = 1, 1+snx+olx-(1-olx) |
8433 |
rhokm1h(ip1,ip2,kkey) = rhokm1(ip1-1+1-olx,ip2-1+1-oly) |
8434 |
end do |
8435 |
end do |
8436 |
do ip2 = 1, 1+sny+oly-(1-oly) |
8437 |
do ip1 = 1, 1+snx+olx-(1-olx) |
8438 |
rhokh(ip1,ip2,kkey) = rhok(ip1-1+1-olx,ip2-1+1-oly) |
8439 |
end do |
8440 |
end do |
8441 |
call integrate_for_w( bi,bj,k,uvel,vvel,wvel,mythid ) |
8442 |
if (usegmredi .or. k .gt. 1 .and. ivdc_kappa .ne. 0.) then |
8443 |
do ip2 = 1, 1+sny+oly-(1-oly) |
8444 |
do ip1 = 1, 1+snx+olx-(1-olx) |
8445 |
thetak(ip1,ip2,kkey) = theta(ip1-1+1-olx,ip2-1+1-oly, |
8446 |
$k,bi,bj) |
8447 |
end do |
8448 |
end do |
8449 |
do ip2 = 1, 1+sny+oly-(1-oly) |
8450 |
do ip1 = 1, 1+snx+olx-(1-olx) |
8451 |
saltk(ip1,ip2,kkey) = salt(ip1-1+1-olx,ip2-1+1-oly,k, |
8452 |
$bi,bj) |
8453 |
end do |
8454 |
end do |
8455 |
call find_rho( bi,bj,imin,imax,jmin,jmax,k,k,eostype, |
8456 |
$theta,salt,rhok,mythid ) |
8457 |
if (k .gt. 1) then |
8458 |
do ip2 = 1, 1+sny+oly-(1-oly) |
8459 |
do ip1 = 1, 1+snx+olx-(1-olx) |
8460 |
thetaj(ip1,ip2,kkey) = theta(ip1-1+1-olx,ip2-1+1- |
8461 |
$oly,k-1,bi,bj) |
8462 |
end do |
8463 |
end do |
8464 |
do ip2 = 1, 1+sny+oly-(1-oly) |
8465 |
do ip1 = 1, 1+snx+olx-(1-olx) |
8466 |
saltj(ip1,ip2,kkey) = salt(ip1-1+1-olx,ip2-1+1-oly, |
8467 |
$k-1,bi,bj) |
8468 |
end do |
8469 |
end do |
8470 |
help_h = k-1 |
8471 |
call find_rho( bi,bj,imin,imax,jmin,jmax,help_h,k, |
8472 |
$eostype,theta,salt,rhokm1,mythid ) |
8473 |
endif |
8474 |
call grad_sigma( bi,bj,imin,imax,jmin,jmax,k,rhok,rhokm1, |
8475 |
$rhok,sigmax,sigmay,sigmar,mythid ) |
8476 |
endif |
8477 |
if (k .gt. 1 .and. ivdc_kappa .ne. 0.) then |
8478 |
call calc_ivdc( bi,bj,imin,imax,jmin,jmax,k,rhokm1,rhok, |
8479 |
$convectcount,kappart,kappars,mytime,myiter,mythid ) |
8480 |
endif |
8481 |
end do |
8482 |
do ip3 = 1, nr |
8483 |
do ip2 = 1, 1+sny+oly-(1-oly) |
8484 |
do ip1 = 1, 1+snx+olx-(1-olx) |
8485 |
wvelh(ip1,ip2,ip3,ikey) = wvel(ip1-1+1-olx,ip2-1+1-oly, |
8486 |
$ip3,bi,bj) |
8487 |
end do |
8488 |
end do |
8489 |
end do |
8490 |
call external_forcing_surf( bi,bj,imin,imax,jmin,jmax,mythid ) |
8491 |
do ip2 = 1, 1+sny+oly-(1-oly) |
8492 |
do ip1 = 1, 1+snx+olx-(1-olx) |
8493 |
surfacetendencyuh(ip1,ip2,ikey) = surfacetendencyu(ip1-1+ |
8494 |
$1-olx,ip2-1+1-oly,bi,bj) |
8495 |
end do |
8496 |
end do |
8497 |
do ip2 = 1, 1+sny+oly-(1-oly) |
8498 |
do ip1 = 1, 1+snx+olx-(1-olx) |
8499 |
surfacetendencyvh(ip1,ip2,ikey) = surfacetendencyv(ip1-1+ |
8500 |
$1-olx,ip2-1+1-oly,bi,bj) |
8501 |
end do |
8502 |
end do |
8503 |
do ip2 = 1, 1+sny+oly-(1-oly) |
8504 |
do ip1 = 1, 1+snx+olx-(1-olx) |
8505 |
surfacetendencysh(ip1,ip2,ikey) = surfacetendencys(ip1-1+ |
8506 |
$1-olx,ip2-1+1-oly,bi,bj) |
8507 |
end do |
8508 |
end do |
8509 |
do ip2 = 1, 1+sny+oly-(1-oly) |
8510 |
do ip1 = 1, 1+snx+olx-(1-olx) |
8511 |
surfacetendencyth(ip1,ip2,ikey) = surfacetendencyt(ip1-1+ |
8512 |
$1-olx,ip2-1+1-oly,bi,bj) |
8513 |
end do |
8514 |
end do |
8515 |
do ip3 = 1, nr |
8516 |
do ip2 = 1, 1+sny+oly-(1-oly) |
8517 |
do ip1 = 1, 1+snx+olx-(1-olx) |
8518 |
sigmaxh(ip1,ip2,ip3,ikey) = sigmax(ip1-1+1-olx,ip2-1+1- |
8519 |
$oly,ip3) |
8520 |
end do |
8521 |
end do |
8522 |
end do |
8523 |
do ip3 = 1, nr |
8524 |
do ip2 = 1, 1+sny+oly-(1-oly) |
8525 |
do ip1 = 1, 1+snx+olx-(1-olx) |
8526 |
sigmayh(ip1,ip2,ip3,ikey) = sigmay(ip1-1+1-olx,ip2-1+1- |
8527 |
$oly,ip3) |
8528 |
end do |
8529 |
end do |
8530 |
end do |
8531 |
do ip3 = 1, nr |
8532 |
do ip2 = 1, 1+sny+oly-(1-oly) |
8533 |
do ip1 = 1, 1+snx+olx-(1-olx) |
8534 |
sigmarh(ip1,ip2,ip3,ikey) = sigmar(ip1-1+1-olx,ip2-1+1- |
8535 |
$oly,ip3) |
8536 |
end do |
8537 |
end do |
8538 |
end do |
8539 |
if (usegmredi) then |
8540 |
do k = 1, nr |
8541 |
call gmredi_calc_tensor( bi,bj,imin,imax,jmin,jmax,k, |
8542 |
$sigmax,sigmay,sigmar,mythid ) |
8543 |
end do |
8544 |
else |
8545 |
do k = 1, nr |
8546 |
call gmredi_calc_tensor_dummy( bi,bj,imin,imax,jmin,jmax, |
8547 |
$k,sigmax,sigmay,sigmar,mythid ) |
8548 |
end do |
8549 |
endif |
8550 |
do ip3 = 1, nr |
8551 |
do ip2 = 1, 1+sny+oly-(1-oly) |
8552 |
do ip1 = 1, 1+snx+olx-(1-olx) |
8553 |
kwxh(ip1,ip2,ip3,ikey) = kwx(ip1-1+1-olx,ip2-1+1-oly, |
8554 |
$ip3,bi,bj) |
8555 |
end do |
8556 |
end do |
8557 |
end do |
8558 |
do ip3 = 1, nr |
8559 |
do ip2 = 1, 1+sny+oly-(1-oly) |
8560 |
do ip1 = 1, 1+snx+olx-(1-olx) |
8561 |
kwyh(ip1,ip2,ip3,ikey) = kwy(ip1-1+1-olx,ip2-1+1-oly, |
8562 |
$ip3,bi,bj) |
8563 |
end do |
8564 |
end do |
8565 |
end do |
8566 |
do ip3 = 1, nr |
8567 |
do ip2 = 1, 1+sny+oly-(1-oly) |
8568 |
do ip1 = 1, 1+snx+olx-(1-olx) |
8569 |
kwzh(ip1,ip2,ip3,ikey) = kwz(ip1-1+1-olx,ip2-1+1-oly, |
8570 |
$ip3,bi,bj) |
8571 |
end do |
8572 |
end do |
8573 |
end do |
8574 |
if (usekpp) then |
8575 |
call mdkpp_calc( bi,bj,mytime,mythid ) |
8576 |
else |
8577 |
call kpp_calc_dummy( bi,bj,mytime,mythid ) |
8578 |
endif |
8579 |
do ip3 = 1, nr |
8580 |
do ip2 = 1, 1+sny+oly-(1-oly) |
8581 |
do ip1 = 1, 1+snx+olx-(1-olx) |
8582 |
kppghath(ip1,ip2,ip3,ikey) = kppghat(ip1-1+1-olx,ip2-1+ |
8583 |
$1-oly,ip3,bi,bj) |
8584 |
end do |
8585 |
end do |
8586 |
end do |
8587 |
do ip3 = 1, nr |
8588 |
do ip2 = 1, 1+sny+oly-(1-oly) |
8589 |
do ip1 = 1, 1+snx+olx-(1-olx) |
8590 |
kppviscazh(ip1,ip2,ip3,ikey) = kppviscaz(ip1-1+1-olx, |
8591 |
$ip2-1+1-oly,ip3,bi,bj) |
8592 |
end do |
8593 |
end do |
8594 |
end do |
8595 |
do ip3 = 1, nr |
8596 |
do ip2 = 1, 1+sny+oly-(1-oly) |
8597 |
do ip1 = 1, 1+snx+olx-(1-olx) |
8598 |
kppdiffkzth(ip1,ip2,ip3,ikey) = kppdiffkzt(ip1-1+1-olx, |
8599 |
$ip2-1+1-oly,ip3,bi,bj) |
8600 |
end do |
8601 |
end do |
8602 |
end do |
8603 |
do ip3 = 1, nr |
8604 |
do ip2 = 1, 1+sny+oly-(1-oly) |
8605 |
do ip1 = 1, 1+snx+olx-(1-olx) |
8606 |
kppdiffkzsh(ip1,ip2,ip3,ikey) = kppdiffkzs(ip1-1+1-olx, |
8607 |
$ip2-1+1-oly,ip3,bi,bj) |
8608 |
end do |
8609 |
end do |
8610 |
end do |
8611 |
do ip2 = 1, 1+sny+oly-(1-oly) |
8612 |
do ip1 = 1, 1+snx+olx-(1-olx) |
8613 |
kppfrach(ip1,ip2,ikey) = kppfrac(ip1-1+1-olx,ip2-1+1-oly, |
8614 |
$bi,bj) |
8615 |
end do |
8616 |
end do |
8617 |
do ip3 = 1, nr |
8618 |
do ip2 = 1, 1+sny+oly-(1-oly) |
8619 |
do ip1 = 1, 1+snx+olx-(1-olx) |
8620 |
kapparti(ip1,ip2,ip3,ikey) = kappart(ip1-1+1-olx,ip2-1+ |
8621 |
$1-oly,ip3) |
8622 |
end do |
8623 |
end do |
8624 |
end do |
8625 |
do ip3 = 1, nr |
8626 |
do ip2 = 1, 1+sny+oly-(1-oly) |
8627 |
do ip1 = 1, 1+snx+olx-(1-olx) |
8628 |
kapparsi(ip1,ip2,ip3,ikey) = kappars(ip1-1+1-olx,ip2-1+ |
8629 |
$1-oly,ip3) |
8630 |
end do |
8631 |
end do |
8632 |
end do |
8633 |
do ip3 = 1, nr |
8634 |
do ip2 = 1, 1+sny+oly-(1-oly) |
8635 |
do ip1 = 1, 1+snx+olx-(1-olx) |
8636 |
thetah(ip1,ip2,ip3,ikey) = theta(ip1-1+1-olx,ip2-1+1- |
8637 |
$oly,ip3,bi,bj) |
8638 |
end do |
8639 |
end do |
8640 |
end do |
8641 |
do ip3 = 1, nr |
8642 |
do ip2 = 1, 1+sny+oly-(1-oly) |
8643 |
do ip1 = 1, 1+snx+olx-(1-olx) |
8644 |
salth(ip1,ip2,ip3,ikey) = salt(ip1-1+1-olx,ip2-1+1-oly, |
8645 |
$ip3,bi,bj) |
8646 |
end do |
8647 |
end do |
8648 |
end do |
8649 |
do ip3 = 1, nr |
8650 |
do ip2 = 1, 1+sny+oly-(1-oly) |
8651 |
do ip1 = 1, 1+snx+olx-(1-olx) |
8652 |
uvelh(ip1,ip2,ip3,ikey) = uvel(ip1-1+1-olx,ip2-1+1-oly, |
8653 |
$ip3,bi,bj) |
8654 |
end do |
8655 |
end do |
8656 |
end do |
8657 |
do ip3 = 1, nr |
8658 |
do ip2 = 1, 1+sny+oly-(1-oly) |
8659 |
do ip1 = 1, 1+snx+olx-(1-olx) |
8660 |
vvelh(ip1,ip2,ip3,ikey) = vvel(ip1-1+1-olx,ip2-1+1-oly, |
8661 |
$ip3,bi,bj) |
8662 |
end do |
8663 |
end do |
8664 |
end do |
8665 |
do k = nr, 1, -1 |
8666 |
kkey = (ikey-1)*nr+k |
8667 |
km1 = max(1,k-1) |
8668 |
kup = 1+mod(k+1,2) |
8669 |
kdown = 1+mod(k,2) |
8670 |
imin = 1-olx+2 |
8671 |
imax = snx+olx-1 |
8672 |
jmin = 1-oly+2 |
8673 |
jmax = sny+oly-1 |
8674 |
call calc_common_factors( bi,bj,imin,imax,jmin,jmax,k,km1, |
8675 |
$kup,kdown,xa,ya,utrans,vtrans,rtrans,maskc,maskup,mythid ) |
8676 |
do ip2 = 1, 1+sny+oly-(1-oly) |
8677 |
do ip1 = 1, 1+snx+olx-(1-olx) |
8678 |
kapparth(ip1,ip2,kkey) = kappart(ip1-1+1-olx,ip2-1+1- |
8679 |
$oly,k) |
8680 |
end do |
8681 |
end do |
8682 |
do ip2 = 1, 1+sny+oly-(1-oly) |
8683 |
do ip1 = 1, 1+snx+olx-(1-olx) |
8684 |
kapparsh(ip1,ip2,kkey) = kappars(ip1-1+1-olx,ip2-1+1- |
8685 |
$oly,k) |
8686 |
end do |
8687 |
end do |
8688 |
call calc_diffusivity( bi,bj,imin,imax,jmin,jmax,k,maskc, |
8689 |
$maskup,kappart,kappars,kapparu,kapparv,mythid ) |
8690 |
if (tempstepping) then |
8691 |
call calc_gt( bi,bj,imin,imax,jmin,jmax,k,km1,kup,kdown, |
8692 |
$xa,ya,utrans,vtrans,rtrans,maskup,maskc,kappart,fvert,mytime, |
8693 |
$mythid ) |
8694 |
call timestep_tracer( bi,bj,imin,imax,jmin,jmax,k,theta, |
8695 |
$gt,gtnm1,myiter,mythid ) |
8696 |
endif |
8697 |
if (saltstepping) then |
8698 |
call calc_gs( bi,bj,imin,imax,jmin,jmax,k,km1,kup,kdown, |
8699 |
$xa,ya,utrans,vtrans,rtrans,maskup,maskc,kappars,fvers,mytime, |
8700 |
$mythid ) |
8701 |
call timestep_tracer( bi,bj,imin,imax,jmin,jmax,k,salt,gs, |
8702 |
$gsnm1,myiter,mythid ) |
8703 |
endif |
8704 |
if (allowfreezing) then |
8705 |
do ip2 = 1, 1+sny+oly-(1-oly) |
8706 |
do ip1 = 1, 1+snx+olx-(1-olx) |
8707 |
gtnm1i(ip1,ip2,kkey) = gtnm1(ip1-1+1-olx,ip2-1+1-oly, |
8708 |
$k,bi,bj) |
8709 |
end do |
8710 |
end do |
8711 |
call freeze( bi,bj,imin,imax,jmin,jmax,k,mythid ) |
8712 |
endif |
8713 |
end do |
8714 |
if (implicitdiffusion) then |
8715 |
if (tempstepping) then |
8716 |
do ip3 = 1, nr |
8717 |
do ip2 = 1, 1+sny+oly-(1-oly) |
8718 |
do ip1 = 1, 1+snx+olx-(1-olx) |
8719 |
gtnm1h(ip1,ip2,ip3,ikey) = gtnm1(ip1-1+1-olx,ip2-1+ |
8720 |
$1-oly,ip3,bi,bj) |
8721 |
end do |
8722 |
end do |
8723 |
end do |
8724 |
call impldiff( bi,bj,imin,imax,jmin,jmax,deltattracer, |
8725 |
$kappart,recip_hfacc,gtnm1,mythid ) |
8726 |
endif |
8727 |
if (saltstepping) then |
8728 |
do ip3 = 1, nr |
8729 |
do ip2 = 1, 1+sny+oly-(1-oly) |
8730 |
do ip1 = 1, 1+snx+olx-(1-olx) |
8731 |
gsnm1h(ip1,ip2,ip3,ikey) = gsnm1(ip1-1+1-olx,ip2-1+ |
8732 |
$1-oly,ip3,bi,bj) |
8733 |
end do |
8734 |
end do |
8735 |
end do |
8736 |
call impldiff( bi,bj,imin,imax,jmin,jmax,deltattracer, |
8737 |
$kappars,recip_hfacc,gsnm1,mythid ) |
8738 |
endif |
8739 |
endif |
8740 |
imin = 1-olx+2 |
8741 |
imax = snx+olx-1 |
8742 |
jmin = 1-oly+2 |
8743 |
jmax = sny+oly-1 |
8744 |
if (implicsurfpress .ne. 1.) then |
8745 |
call calc_grad_phi_surf( bi,bj,imin,imax,jmin,jmax,etan, |
8746 |
$phisurfx,phisurfy,mythid ) |
8747 |
endif |
8748 |
do k = 1, nr |
8749 |
km1 = max(1,k-1) |
8750 |
kup = 1+mod(k+1,2) |
8751 |
kdown = 1+mod(k,2) |
8752 |
if (staggertimestep) then |
8753 |
call mdcalc_phi_hyd( bi,bj,imin,imax,jmin,jmax,k,gtnm1, |
8754 |
$gsnm1,phihyd,mythid ) |
8755 |
else |
8756 |
call mdcalc_phi_hyd( bi,bj,imin,imax,jmin,jmax,k,theta, |
8757 |
$salt,phihyd,mythid ) |
8758 |
endif |
8759 |
if (momstepping) then |
8760 |
call calc_mom_rhs( bi,bj,imin,imax,jmin,jmax,k,kup,kdown, |
8761 |
$phihyd,kapparu,kapparv,fveru,fverv,mytime,mythid ) |
8762 |
call timestep( bi,bj,imin,imax,jmin,jmax,k,phihyd, |
8763 |
$phisurfx,phisurfy,myiter,mythid ) |
8764 |
else |
8765 |
do j = 1-oly, sny+oly |
8766 |
do i = 1-olx, snx+olx |
8767 |
gucd(i,j,k,bi,bj) = 0. |
8768 |
gvcd(i,j,k,bi,bj) = 0. |
8769 |
end do |
8770 |
end do |
8771 |
endif |
8772 |
end do |
8773 |
if (implicitviscosity .and. momstepping) then |
8774 |
do ip3 = 1, nr |
8775 |
do ip2 = 1, 1+sny+oly-(1-oly) |
8776 |
do ip1 = 1, 1+snx+olx-(1-olx) |
8777 |
gunm1h(ip1,ip2,ip3,ikey) = gunm1(ip1-1+1-olx,ip2-1+1- |
8778 |
$oly,ip3,bi,bj) |
8779 |
end do |
8780 |
end do |
8781 |
end do |
8782 |
call impldiff( bi,bj,imin,imax,jmin,jmax,deltatmom,kapparu, |
8783 |
$recip_hfacw,gunm1,mythid ) |
8784 |
do ip3 = 1, nr |
8785 |
do ip2 = 1, 1+sny+oly-(1-oly) |
8786 |
do ip1 = 1, 1+snx+olx-(1-olx) |
8787 |
gvnm1h(ip1,ip2,ip3,ikey) = gvnm1(ip1-1+1-olx,ip2-1+1- |
8788 |
$oly,ip3,bi,bj) |
8789 |
end do |
8790 |
end do |
8791 |
end do |
8792 |
call impldiff( bi,bj,imin,imax,jmin,jmax,deltatmom,kapparv, |
8793 |
$recip_hfacs,gvnm1,mythid ) |
8794 |
do ip3 = 1, nr |
8795 |
do ip2 = 1, 1+sny+oly-(1-oly) |
8796 |
do ip1 = 1, 1+snx+olx-(1-olx) |
8797 |
vveldh(ip1,ip2,ip3,ikey) = vveld(ip1-1+1-olx,ip2-1+1- |
8798 |
$oly,ip3,bi,bj) |
8799 |
end do |
8800 |
end do |
8801 |
end do |
8802 |
call impldiff( bi,bj,imin,imax,jmin,jmax,deltatmom,kapparu, |
8803 |
$recip_hfacw,vveld,mythid ) |
8804 |
do ip3 = 1, nr |
8805 |
do ip2 = 1, 1+sny+oly-(1-oly) |
8806 |
do ip1 = 1, 1+snx+olx-(1-olx) |
8807 |
uveldh(ip1,ip2,ip3,ikey) = uveld(ip1-1+1-olx,ip2-1+1- |
8808 |
$oly,ip3,bi,bj) |
8809 |
end do |
8810 |
end do |
8811 |
end do |
8812 |
call impldiff( bi,bj,imin,imax,jmin,jmax,deltatmom,kapparv, |
8813 |
$recip_hfacs,uveld,mythid ) |
8814 |
endif |
8815 |
end do |
8816 |
end do |
8817 |
end |
8818 |
|
8819 |
|
8820 |
subroutine addynamics( mytime, mythid ) |
8821 |
C*************************************************************** |
8822 |
C*************************************************************** |
8823 |
C** This routine was generated by the ** |
8824 |
C** Tangent linear and Adjoint Model Compiler, TAMC 5.2.14 ** |
8825 |
C*************************************************************** |
8826 |
C*************************************************************** |
8827 |
C============================================== |
8828 |
C all entries are defined explicitly |
8829 |
C============================================== |
8830 |
implicit none |
8831 |
|
8832 |
C============================================== |
8833 |
C define parameters |
8834 |
C============================================== |
8835 |
integer max_no_threads |
8836 |
parameter ( max_no_threads = 32 ) |
8837 |
integer npx |
8838 |
parameter ( npx = 1 ) |
8839 |
integer npy |
8840 |
parameter ( npy = 1 ) |
8841 |
integer nr |
8842 |
parameter ( nr = 15 ) |
8843 |
integer nsx |
8844 |
parameter ( nsx = 1 ) |
8845 |
integer nsy |
8846 |
parameter ( nsy = 1 ) |
8847 |
integer snx |
8848 |
parameter ( snx = 20 ) |
8849 |
integer nx |
8850 |
parameter ( nx = snx*nsx*npx ) |
8851 |
integer sny |
8852 |
parameter ( sny = 40 ) |
8853 |
integer ny |
8854 |
parameter ( ny = sny*nsy*npy ) |
8855 |
integer olx |
8856 |
parameter ( olx = 3 ) |
8857 |
integer oly |
8858 |
parameter ( oly = 3 ) |
8859 |
|
8860 |
C============================================== |
8861 |
C define common blocks |
8862 |
C============================================== |
8863 |
common /addynvars_cd/ aduveld, advveld, adetanm1, adunm1, advnm1, |
8864 |
$adgucd, adgvcd |
8865 |
double precision adetanm1(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
8866 |
double precision adgucd(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
8867 |
double precision adgvcd(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
8868 |
double precision adunm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
8869 |
double precision aduveld(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
8870 |
double precision advnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
8871 |
double precision advveld(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
8872 |
|
8873 |
common /addynvars_r/ adetan, aduvel, advvel, adwvel, adtheta, |
8874 |
$adsalt, adgu, adgv, adgt, adgs, adgunm1, adgvnm1, adgtnm1, adgsnm1 |
8875 |
double precision adetan(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
8876 |
double precision adgs(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
8877 |
double precision adgsnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
8878 |
double precision adgt(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
8879 |
double precision adgtnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
8880 |
double precision adgu(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
8881 |
double precision adgunm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
8882 |
double precision adgv(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
8883 |
double precision adgvnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
8884 |
double precision adsalt(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
8885 |
double precision adtheta(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
8886 |
double precision aduvel(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
8887 |
double precision advvel(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
8888 |
double precision adwvel(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
8889 |
|
8890 |
common /cadgsnm1/ gsnm1h |
8891 |
real*4 gsnm1h(1+snx+olx-(1-olx),1+sny+oly-(1-oly),nr,36) |
8892 |
|
8893 |
common /cadgtnm1/ gtnm1h |
8894 |
real*4 gtnm1h(1+snx+olx-(1-olx),1+sny+oly-(1-oly),nr,36) |
8895 |
|
8896 |
common /cadgtnm2/ gtnm1i |
8897 |
real*4 gtnm1i(1+snx+olx-(1-olx),1+sny+oly-(1-oly),540) |
8898 |
|
8899 |
common /cadgunm1/ gunm1h |
8900 |
real*4 gunm1h(1+snx+olx-(1-olx),1+sny+oly-(1-oly),nr,36) |
8901 |
|
8902 |
common /cadgvnm1/ gvnm1h |
8903 |
real*4 gvnm1h(1+snx+olx-(1-olx),1+sny+oly-(1-oly),nr,36) |
8904 |
|
8905 |
common /cadkappars/ kapparsh |
8906 |
real*4 kapparsh(1+snx+olx-(1-olx),1+sny+oly-(1-oly),540) |
8907 |
|
8908 |
common /cadkappart/ kapparth |
8909 |
real*4 kapparth(1+snx+olx-(1-olx),1+sny+oly-(1-oly),540) |
8910 |
|
8911 |
common /cadkapparu/ kapparsi |
8912 |
real*4 kapparsi(1+snx+olx-(1-olx),1+sny+oly-(1-oly),nr,36) |
8913 |
|
8914 |
common /cadkapparv/ kapparti |
8915 |
real*4 kapparti(1+snx+olx-(1-olx),1+sny+oly-(1-oly),nr,36) |
8916 |
|
8917 |
common /cadkppdiffkzs/ kppdiffkzsh |
8918 |
real*4 kppdiffkzsh(1+snx+olx-(1-olx),1+sny+oly-(1-oly),nr,36) |
8919 |
|
8920 |
common /cadkppdiffkzt/ kppdiffkzth |
8921 |
real*4 kppdiffkzth(1+snx+olx-(1-olx),1+sny+oly-(1-oly),nr,36) |
8922 |
|
8923 |
common /cadkppfrac/ kppfrach |
8924 |
real*4 kppfrach(1+snx+olx-(1-olx),1+sny+oly-(1-oly),36) |
8925 |
|
8926 |
common /cadkppghat/ kppghath |
8927 |
real*4 kppghath(1+snx+olx-(1-olx),1+sny+oly-(1-oly),nr,36) |
8928 |
|
8929 |
common /cadkppviscaz/ kppviscazh |
8930 |
real*4 kppviscazh(1+snx+olx-(1-olx),1+sny+oly-(1-oly),nr,36) |
8931 |
|
8932 |
common /cadkwx/ kwxh |
8933 |
real*4 kwxh(1+snx+olx-(1-olx),1+sny+oly-(1-oly),nr,36) |
8934 |
|
8935 |
common /cadkwy/ kwyh |
8936 |
real*4 kwyh(1+snx+olx-(1-olx),1+sny+oly-(1-oly),nr,36) |
8937 |
|
8938 |
common /cadkwz/ kwzh |
8939 |
real*4 kwzh(1+snx+olx-(1-olx),1+sny+oly-(1-oly),nr,36) |
8940 |
|
8941 |
common /cadrhokm2/ rhokm1h |
8942 |
real*4 rhokm1h(1+snx+olx-(1-olx),1+sny+oly-(1-oly),540) |
8943 |
|
8944 |
common /cadrhol/ rhokh |
8945 |
real*4 rhokh(1+snx+olx-(1-olx),1+sny+oly-(1-oly),540) |
8946 |
|
8947 |
common /cadsalw/ salth |
8948 |
real*4 salth(1+snx+olx-(1-olx),1+sny+oly-(1-oly),nr,36) |
8949 |
|
8950 |
common /cadsalx/ salti |
8951 |
real*4 salti(1+snx+olx-(1-olx),1+sny+oly-(1-oly),nr,36) |
8952 |
|
8953 |
common /cadsaly/ saltj |
8954 |
real*4 saltj(1+snx+olx-(1-olx),1+sny+oly-(1-oly),540) |
8955 |
|
8956 |
common /cadsalz/ saltk |
8957 |
real*4 saltk(1+snx+olx-(1-olx),1+sny+oly-(1-oly),540) |
8958 |
|
8959 |
common /cadsigmar/ sigmarh |
8960 |
real*4 sigmarh(1+snx+olx-(1-olx),1+sny+oly-(1-oly),nr,36) |
8961 |
|
8962 |
common /cadsigmax/ sigmaxh |
8963 |
real*4 sigmaxh(1+snx+olx-(1-olx),1+sny+oly-(1-oly),nr,36) |
8964 |
|
8965 |
common /cadsigmay/ sigmayh |
8966 |
real*4 sigmayh(1+snx+olx-(1-olx),1+sny+oly-(1-oly),nr,36) |
8967 |
|
8968 |
common /cadsurfacetendencys/ surfacetendencysh |
8969 |
real*4 surfacetendencysh(1+snx+olx-(1-olx),1+sny+oly-(1-oly),36) |
8970 |
|
8971 |
common /cadsurfacetendencyt/ surfacetendencyth |
8972 |
real*4 surfacetendencyth(1+snx+olx-(1-olx),1+sny+oly-(1-oly),36) |
8973 |
|
8974 |
common /cadsurfacetendencyu/ surfacetendencyuh |
8975 |
real*4 surfacetendencyuh(1+snx+olx-(1-olx),1+sny+oly-(1-oly),36) |
8976 |
|
8977 |
common /cadsurfacetendencyv/ surfacetendencyvh |
8978 |
real*4 surfacetendencyvh(1+snx+olx-(1-olx),1+sny+oly-(1-oly),36) |
8979 |
|
8980 |
common /cadthetd/ thetah |
8981 |
real*4 thetah(1+snx+olx-(1-olx),1+sny+oly-(1-oly),nr,36) |
8982 |
|
8983 |
common /cadthete/ thetai |
8984 |
real*4 thetai(1+snx+olx-(1-olx),1+sny+oly-(1-oly),nr,36) |
8985 |
|
8986 |
common /cadthetf/ thetaj |
8987 |
real*4 thetaj(1+snx+olx-(1-olx),1+sny+oly-(1-oly),540) |
8988 |
|
8989 |
common /cadthetg/ thetak |
8990 |
real*4 thetak(1+snx+olx-(1-olx),1+sny+oly-(1-oly),540) |
8991 |
|
8992 |
common /caduvel/ uvelh |
8993 |
real*4 uvelh(1+snx+olx-(1-olx),1+sny+oly-(1-oly),nr,36) |
8994 |
|
8995 |
common /caduveld/ uveldh |
8996 |
real*4 uveldh(1+snx+olx-(1-olx),1+sny+oly-(1-oly),nr,36) |
8997 |
|
8998 |
common /caduvem/ uveli |
8999 |
real*4 uveli(1+snx+olx-(1-olx),1+sny+oly-(1-oly),nr,36) |
9000 |
|
9001 |
common /cadvvel/ vvelh |
9002 |
real*4 vvelh(1+snx+olx-(1-olx),1+sny+oly-(1-oly),nr,36) |
9003 |
|
9004 |
common /cadvveld/ vveldh |
9005 |
real*4 vveldh(1+snx+olx-(1-olx),1+sny+oly-(1-oly),nr,36) |
9006 |
|
9007 |
common /cadvvem/ vveli |
9008 |
real*4 vveli(1+snx+olx-(1-olx),1+sny+oly-(1-oly),nr,36) |
9009 |
|
9010 |
common /cadwvel/ wvelh |
9011 |
real*4 wvelh(1+snx+olx-(1-olx),1+sny+oly-(1-oly),nr,36) |
9012 |
|
9013 |
common /dynvars_cd/ uveld, vveld, etanm1, unm1, vnm1, gucd, gvcd |
9014 |
double precision etanm1(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
9015 |
double precision gucd(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
9016 |
double precision gvcd(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
9017 |
double precision unm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
9018 |
double precision uveld(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
9019 |
double precision vnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
9020 |
double precision vveld(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
9021 |
|
9022 |
common /dynvars_r/ etan, uvel, vvel, wvel, theta, salt, gu, gv, |
9023 |
$gt, gs, gunm1, gvnm1, gtnm1, gsnm1 |
9024 |
double precision etan(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
9025 |
double precision gs(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
9026 |
double precision gsnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
9027 |
double precision gt(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
9028 |
double precision gtnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
9029 |
double precision gu(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
9030 |
double precision gunm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
9031 |
double precision gv(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
9032 |
double precision gvnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
9033 |
double precision salt(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
9034 |
double precision theta(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
9035 |
double precision uvel(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
9036 |
double precision vvel(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
9037 |
double precision wvel(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
9038 |
|
9039 |
common /eeparams_i/ errormessageunit, standardmessageunit, |
9040 |
$scrunit1, scrunit2, eedataunit, modeldataunit, numberofprocs, |
9041 |
$pidio, myprocid, mypx, mypy, myxgloballo, myygloballo, nthreads, |
9042 |
$mybxlo, mybxhi, mybylo, mybyhi, ntx, nty, ioerrorcount |
9043 |
integer eedataunit |
9044 |
integer errormessageunit |
9045 |
integer ioerrorcount(max_no_threads) |
9046 |
integer modeldataunit |
9047 |
integer mybxhi(max_no_threads) |
9048 |
integer mybxlo(max_no_threads) |
9049 |
integer mybyhi(max_no_threads) |
9050 |
integer mybylo(max_no_threads) |
9051 |
integer myprocid |
9052 |
integer mypx |
9053 |
integer mypy |
9054 |
integer myxgloballo |
9055 |
integer myygloballo |
9056 |
integer nthreads |
9057 |
integer ntx |
9058 |
integer nty |
9059 |
integer numberofprocs |
9060 |
integer pidio |
9061 |
integer scrunit1 |
9062 |
integer scrunit2 |
9063 |
integer standardmessageunit |
9064 |
|
9065 |
common /gm_wtensor/ kwx, kwy, kwz |
9066 |
double precision kwx(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
9067 |
double precision kwy(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
9068 |
double precision kwz(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
9069 |
|
9070 |
common /grid_r/ dxc, dxf, dxg, dxv, dyc, dyf, dyg, dyu, drc, drf, |
9071 |
$h, hfacc, hfacw, hfacs, depthink, recip_dxc, recip_dxf, recip_dxg, |
9072 |
$ recip_dxv, recip_dyc, recip_dyf, recip_dyg, recip_dyu, recip_drc, |
9073 |
$ recip_drf, recip_h, recip_hfacc, recip_hfacw, recip_hfacs, rkfac, |
9074 |
$ recip_rkfac, safac, xc, yc, ra, raw, ras, raz, rc, rf, yc0, xc0, |
9075 |
$xg, yg, maskw, masks, recip_ra, recip_raw, recip_ras, recip_raz, |
9076 |
$tanphiatu, tanphiatv |
9077 |
double precision depthink(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
9078 |
double precision drc(1:nr) |
9079 |
double precision drf(1:nr) |
9080 |
double precision dxc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
9081 |
double precision dxf(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
9082 |
double precision dxg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
9083 |
double precision dxv(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
9084 |
double precision dyc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
9085 |
double precision dyf(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
9086 |
double precision dyg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
9087 |
double precision dyu(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
9088 |
double precision h(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
9089 |
double precision hfacc(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) |
9090 |
double precision hfacs(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) |
9091 |
double precision hfacw(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) |
9092 |
double precision masks(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) |
9093 |
double precision maskw(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) |
9094 |
double precision ra(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
9095 |
double precision ras(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
9096 |
double precision raw(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
9097 |
double precision raz(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
9098 |
double precision rc(1:nr) |
9099 |
double precision recip_drc(1:nr) |
9100 |
double precision recip_drf(1:nr) |
9101 |
double precision recip_dxc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
9102 |
double precision recip_dxf(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
9103 |
double precision recip_dxg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
9104 |
double precision recip_dxv(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
9105 |
double precision recip_dyc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
9106 |
double precision recip_dyf(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
9107 |
double precision recip_dyg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
9108 |
double precision recip_dyu(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
9109 |
double precision recip_h(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
9110 |
double precision recip_hfacc(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx, |
9111 |
$nsy) |
9112 |
double precision recip_hfacs(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx, |
9113 |
$nsy) |
9114 |
double precision recip_hfacw(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx, |
9115 |
$nsy) |
9116 |
double precision recip_ra(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
9117 |
double precision recip_ras(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
9118 |
double precision recip_raw(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
9119 |
double precision recip_raz(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
9120 |
double precision recip_rkfac |
9121 |
double precision rf(1:nr+1) |
9122 |
double precision rkfac |
9123 |
double precision safac(1:nr) |
9124 |
double precision tanphiatu(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
9125 |
double precision tanphiatv(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
9126 |
double precision xc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
9127 |
double precision xc0 |
9128 |
double precision xg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
9129 |
double precision yc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
9130 |
double precision yc0 |
9131 |
double precision yg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
9132 |
|
9133 |
common /kpp/ kppviscaz, kppdiffkzt, kppdiffkzs, kppghat, kpphbl |
9134 |
double precision kppdiffkzs(1-olx:snx+olx,1-oly:sny+oly,nr,nsx, |
9135 |
$nsy) |
9136 |
double precision kppdiffkzt(1-olx:snx+olx,1-oly:sny+oly,nr,nsx, |
9137 |
$nsy) |
9138 |
double precision kppghat(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
9139 |
double precision kpphbl(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
9140 |
double precision kppviscaz(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
9141 |
|
9142 |
common /kpp_short/ kppfrac |
9143 |
double precision kppfrac(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
9144 |
|
9145 |
common /parm_eos_lin/ talpha, sbeta, eostype |
9146 |
character*(6) eostype |
9147 |
double precision sbeta |
9148 |
double precision talpha |
9149 |
|
9150 |
common /parm_l/ usingcartesiangrid, usingsphericalpolargrid, |
9151 |
$no_slip_sides, no_slip_bottom, staggertimestep, momviscosity, |
9152 |
$momadvection, momforcing, usecoriolis, mompressureforcing, |
9153 |
$tempdiffusion, tempadvection, tempforcing, saltdiffusion, |
9154 |
$saltadvection, saltforcing, implicitfreesurface, rigidlid, |
9155 |
$momstepping, tempstepping, saltstepping, metricterms, |
9156 |
$usingsphericalpolarmterms, useconstantf, usebetaplanef, |
9157 |
$usespheref, implicitdiffusion, implicitviscosity, |
9158 |
$dothetaclimrelax, dosaltclimrelax, periodicexternalforcing, |
9159 |
$usingpcoords, usingzcoords, nonhydrostatic, globalfiles, |
9160 |
$allowfreezing, groundatk1, usepickupbeforec35 |
9161 |
logical allowfreezing |
9162 |
logical dosaltclimrelax |
9163 |
logical dothetaclimrelax |
9164 |
logical globalfiles |
9165 |
logical groundatk1 |
9166 |
logical implicitdiffusion |
9167 |
logical implicitfreesurface |
9168 |
logical implicitviscosity |
9169 |
logical metricterms |
9170 |
logical momadvection |
9171 |
logical momforcing |
9172 |
logical mompressureforcing |
9173 |
logical momstepping |
9174 |
logical momviscosity |
9175 |
logical no_slip_bottom |
9176 |
logical no_slip_sides |
9177 |
logical nonhydrostatic |
9178 |
logical periodicexternalforcing |
9179 |
logical rigidlid |
9180 |
logical saltadvection |
9181 |
logical saltdiffusion |
9182 |
logical saltforcing |
9183 |
logical saltstepping |
9184 |
logical staggertimestep |
9185 |
logical tempadvection |
9186 |
logical tempdiffusion |
9187 |
logical tempforcing |
9188 |
logical tempstepping |
9189 |
logical usebetaplanef |
9190 |
logical useconstantf |
9191 |
logical usecoriolis |
9192 |
logical usepickupbeforec35 |
9193 |
logical usespheref |
9194 |
logical usingcartesiangrid |
9195 |
logical usingpcoords |
9196 |
logical usingsphericalpolargrid |
9197 |
logical usingsphericalpolarmterms |
9198 |
logical usingzcoords |
9199 |
|
9200 |
common /parm_packages/ usekpp, usegmredi, useobcs, useaim, useecco |
9201 |
logical useaim |
9202 |
logical useecco |
9203 |
logical usegmredi |
9204 |
logical usekpp |
9205 |
logical useobcs |
9206 |
|
9207 |
common /parm_r/ cg2dtargetresidual, cg2dpcoffdfac, |
9208 |
$cg3dtargetresidual, delp, delz, delr, delx, dely, deltat, |
9209 |
$deltatmom, deltattracer, deltatclock, abeps, starttime, phimin, |
9210 |
$thetamin, rsphere, recip_rsphere, f0, fcori, beta, viscah, viscaz, |
9211 |
$ visca4, viscar, diffkht, diffkzt, diffk4t, diffkrt, diffkhs, |
9212 |
$diffkzs, diffk4s, diffkrs, delt, taucd, rcd, freesurffac, |
9213 |
$implicsurfpress, implicdiv2dflow, hfacmin, hfacmindz, gravity, |
9214 |
$recip_gravity, gbaro, rhonil, recip_rhonil, recip_rhoconst, |
9215 |
$rhoconst, tref, sref, endtime, chkptfreq, pchkptfreq, dumpfreq, |
9216 |
$tavefreq, affacmom, vffacmom, pffacmom, cffacmom, fofacmom, |
9217 |
$mtfacmom, cospower, cadjfreq, omega, tauthetaclimrelax, |
9218 |
$lambdathetaclimrelax, tausaltclimrelax, lambdasaltclimrelax, |
9219 |
$externforcingcycle, externforcingperiod, viscap, diffkpt, diffkps, |
9220 |
$ hfacmindr, hfacmindp, theta_s, specvol_s, horivertratio, |
9221 |
$recip_horivertratio, latfftfiltlo, ivdc_kappa, ro_sealevel, |
9222 |
$zonal_filt_lat, bottomdraglinear, bottomdragquadratic |
9223 |
double precision abeps |
9224 |
double precision affacmom |
9225 |
double precision beta |
9226 |
double precision bottomdraglinear |
9227 |
double precision bottomdragquadratic |
9228 |
double precision cadjfreq |
9229 |
double precision cffacmom |
9230 |
double precision cg2dpcoffdfac |
9231 |
double precision cg2dtargetresidual |
9232 |
double precision cg3dtargetresidual |
9233 |
double precision chkptfreq |
9234 |
double precision cospower |
9235 |
double precision delp(nr) |
9236 |
double precision delr(nr) |
9237 |
double precision delt |
9238 |
double precision deltat |
9239 |
double precision deltatclock |
9240 |
double precision deltatmom |
9241 |
double precision deltattracer |
9242 |
double precision delx(nx) |
9243 |
double precision dely(ny) |
9244 |
double precision delz(nr) |
9245 |
double precision diffk4s |
9246 |
double precision diffk4t |
9247 |
double precision diffkhs |
9248 |
double precision diffkht |
9249 |
double precision diffkps |
9250 |
double precision diffkpt |
9251 |
double precision diffkrs |
9252 |
double precision diffkrt |
9253 |
double precision diffkzs |
9254 |
double precision diffkzt |
9255 |
double precision dumpfreq |
9256 |
double precision endtime |
9257 |
double precision externforcingcycle |
9258 |
double precision externforcingperiod |
9259 |
double precision f0 |
9260 |
double precision fcori(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
9261 |
double precision fofacmom |
9262 |
double precision freesurffac |
9263 |
double precision gbaro |
9264 |
double precision gravity |
9265 |
double precision hfacmin |
9266 |
double precision hfacmindp |
9267 |
double precision hfacmindr |
9268 |
double precision hfacmindz |
9269 |
double precision horivertratio |
9270 |
double precision implicdiv2dflow |
9271 |
double precision implicsurfpress |
9272 |
double precision ivdc_kappa |
9273 |
double precision lambdasaltclimrelax |
9274 |
double precision lambdathetaclimrelax |
9275 |
double precision latfftfiltlo |
9276 |
double precision mtfacmom |
9277 |
double precision omega |
9278 |
double precision pchkptfreq |
9279 |
double precision pffacmom |
9280 |
double precision phimin |
9281 |
double precision rcd |
9282 |
double precision recip_gravity |
9283 |
double precision recip_horivertratio |
9284 |
double precision recip_rhoconst |
9285 |
double precision recip_rhonil |
9286 |
double precision recip_rsphere |
9287 |
double precision rhoconst |
9288 |
double precision rhonil |
9289 |
double precision ro_sealevel |
9290 |
double precision rsphere |
9291 |
double precision specvol_s(nr) |
9292 |
double precision sref(nr) |
9293 |
double precision starttime |
9294 |
double precision taucd |
9295 |
double precision tausaltclimrelax |
9296 |
double precision tauthetaclimrelax |
9297 |
double precision tavefreq |
9298 |
double precision theta_s(nr) |
9299 |
double precision thetamin |
9300 |
double precision tref(nr) |
9301 |
double precision vffacmom |
9302 |
double precision visca4 |
9303 |
double precision viscah |
9304 |
double precision viscap |
9305 |
double precision viscar |
9306 |
double precision viscaz |
9307 |
double precision zonal_filt_lat |
9308 |
|
9309 |
common /tamc_keys_i/ ikey_dynamics, ikey_yearly, ikey_daily_1, |
9310 |
$ikey_daily_2, iloop_daily |
9311 |
integer ikey_daily_1 |
9312 |
integer ikey_daily_2 |
9313 |
integer ikey_dynamics |
9314 |
integer ikey_yearly |
9315 |
integer iloop_daily |
9316 |
|
9317 |
common /tamckeys/ key, ikey, idkey |
9318 |
integer idkey |
9319 |
integer ikey |
9320 |
integer key |
9321 |
|
9322 |
common /tendency_forcing/ surfacetendencyu, surfacetendencyv, |
9323 |
$surfacetendencyt, surfacetendencys, tempqsw |
9324 |
double precision surfacetendencys(1-olx:snx+olx,1-oly:sny+oly,nsx, |
9325 |
$nsy) |
9326 |
double precision surfacetendencyt(1-olx:snx+olx,1-oly:sny+oly,nsx, |
9327 |
$nsy) |
9328 |
double precision surfacetendencyu(1-olx:snx+olx,1-oly:sny+oly,nsx, |
9329 |
$nsy) |
9330 |
double precision surfacetendencyv(1-olx:snx+olx,1-oly:sny+oly,nsx, |
9331 |
$nsy) |
9332 |
double precision tempqsw(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
9333 |
|
9334 |
C============================================== |
9335 |
C define arguments |
9336 |
C============================================== |
9337 |
integer mythid |
9338 |
double precision mytime |
9339 |
|
9340 |
C============================================== |
9341 |
C define local variables |
9342 |
C============================================== |
9343 |
integer act1 |
9344 |
integer act2 |
9345 |
integer act3 |
9346 |
integer act4 |
9347 |
double precision adfvers(1-olx:snx+olx,1-oly:sny+oly,2) |
9348 |
double precision adfvert(1-olx:snx+olx,1-oly:sny+oly,2) |
9349 |
double precision adfveru(1-olx:snx+olx,1-oly:sny+oly,2) |
9350 |
double precision adfverv(1-olx:snx+olx,1-oly:sny+oly,2) |
9351 |
double precision adkappars(1-olx:snx+olx,1-oly:sny+oly,nr) |
9352 |
double precision adkappart(1-olx:snx+olx,1-oly:sny+oly,nr) |
9353 |
double precision adkapparu(1-olx:snx+olx,1-oly:sny+oly,nr) |
9354 |
double precision adkapparv(1-olx:snx+olx,1-oly:sny+oly,nr) |
9355 |
double precision adphihyd(1-olx:snx+olx,1-oly:sny+oly,nr) |
9356 |
double precision adphisurfx(1-olx:snx+olx,1-oly:sny+oly) |
9357 |
double precision adphisurfy(1-olx:snx+olx,1-oly:sny+oly) |
9358 |
double precision adrhok(1-olx:snx+olx,1-oly:sny+oly) |
9359 |
double precision adrhokm1(1-olx:snx+olx,1-oly:sny+oly) |
9360 |
double precision adrtrans(1-olx:snx+olx,1-oly:sny+oly) |
9361 |
double precision adsigmar(1-olx:snx+olx,1-oly:sny+oly,nr) |
9362 |
double precision adsigmax(1-olx:snx+olx,1-oly:sny+oly,nr) |
9363 |
double precision adsigmay(1-olx:snx+olx,1-oly:sny+oly,nr) |
9364 |
double precision adutrans(1-olx:snx+olx,1-oly:sny+oly) |
9365 |
double precision advtrans(1-olx:snx+olx,1-oly:sny+oly) |
9366 |
integer bi |
9367 |
integer bj |
9368 |
integer help_h |
9369 |
integer i |
9370 |
integer imax |
9371 |
integer imin |
9372 |
integer ip1 |
9373 |
integer ip2 |
9374 |
integer ip3 |
9375 |
integer j |
9376 |
integer jmax |
9377 |
integer jmin |
9378 |
integer k |
9379 |
double precision kappars(1-olx:snx+olx,1-oly:sny+oly,nr) |
9380 |
double precision kappart(1-olx:snx+olx,1-oly:sny+oly,nr) |
9381 |
double precision kapparu(1-olx:snx+olx,1-oly:sny+oly,nr) |
9382 |
double precision kapparv(1-olx:snx+olx,1-oly:sny+oly,nr) |
9383 |
integer kdown |
9384 |
integer kkey |
9385 |
integer km1 |
9386 |
integer kup |
9387 |
double precision maskc(1-olx:snx+olx,1-oly:sny+oly) |
9388 |
double precision maskup(1-olx:snx+olx,1-oly:sny+oly) |
9389 |
integer max1 |
9390 |
integer max2 |
9391 |
integer max3 |
9392 |
double precision rhok(1-olx:snx+olx,1-oly:sny+oly) |
9393 |
double precision rhokm1(1-olx:snx+olx,1-oly:sny+oly) |
9394 |
double precision rtrans(1-olx:snx+olx,1-oly:sny+oly) |
9395 |
double precision sigmar(1-olx:snx+olx,1-oly:sny+oly,nr) |
9396 |
double precision sigmax(1-olx:snx+olx,1-oly:sny+oly,nr) |
9397 |
double precision sigmay(1-olx:snx+olx,1-oly:sny+oly,nr) |
9398 |
double precision utrans(1-olx:snx+olx,1-oly:sny+oly) |
9399 |
double precision vtrans(1-olx:snx+olx,1-oly:sny+oly) |
9400 |
double precision xa(1-olx:snx+olx,1-oly:sny+oly) |
9401 |
double precision ya(1-olx:snx+olx,1-oly:sny+oly) |
9402 |
|
9403 |
C---------------------------------------------- |
9404 |
C RESET LOCAL ADJOINT VARIABLES |
9405 |
C---------------------------------------------- |
9406 |
do ip3 = 1, 2 |
9407 |
do ip2 = 1-oly, sny+oly |
9408 |
do ip1 = 1-olx, snx+olx |
9409 |
adfvers(ip1,ip2,ip3) = 0.d0 |
9410 |
end do |
9411 |
end do |
9412 |
end do |
9413 |
do ip3 = 1, 2 |
9414 |
do ip2 = 1-oly, sny+oly |
9415 |
do ip1 = 1-olx, snx+olx |
9416 |
adfvert(ip1,ip2,ip3) = 0.d0 |
9417 |
end do |
9418 |
end do |
9419 |
end do |
9420 |
do ip3 = 1, 2 |
9421 |
do ip2 = 1-oly, sny+oly |
9422 |
do ip1 = 1-olx, snx+olx |
9423 |
adfveru(ip1,ip2,ip3) = 0.d0 |
9424 |
end do |
9425 |
end do |
9426 |
end do |
9427 |
do ip3 = 1, 2 |
9428 |
do ip2 = 1-oly, sny+oly |
9429 |
do ip1 = 1-olx, snx+olx |
9430 |
adfverv(ip1,ip2,ip3) = 0.d0 |
9431 |
end do |
9432 |
end do |
9433 |
end do |
9434 |
do ip3 = 1, nr |
9435 |
do ip2 = 1-oly, sny+oly |
9436 |
do ip1 = 1-olx, snx+olx |
9437 |
adkappars(ip1,ip2,ip3) = 0.d0 |
9438 |
end do |
9439 |
end do |
9440 |
end do |
9441 |
do ip3 = 1, nr |
9442 |
do ip2 = 1-oly, sny+oly |
9443 |
do ip1 = 1-olx, snx+olx |
9444 |
adkappart(ip1,ip2,ip3) = 0.d0 |
9445 |
end do |
9446 |
end do |
9447 |
end do |
9448 |
do ip3 = 1, nr |
9449 |
do ip2 = 1-oly, sny+oly |
9450 |
do ip1 = 1-olx, snx+olx |
9451 |
adkapparu(ip1,ip2,ip3) = 0.d0 |
9452 |
end do |
9453 |
end do |
9454 |
end do |
9455 |
do ip3 = 1, nr |
9456 |
do ip2 = 1-oly, sny+oly |
9457 |
do ip1 = 1-olx, snx+olx |
9458 |
adkapparv(ip1,ip2,ip3) = 0.d0 |
9459 |
end do |
9460 |
end do |
9461 |
end do |
9462 |
do ip3 = 1, nr |
9463 |
do ip2 = 1-oly, sny+oly |
9464 |
do ip1 = 1-olx, snx+olx |
9465 |
adphihyd(ip1,ip2,ip3) = 0.d0 |
9466 |
end do |
9467 |
end do |
9468 |
end do |
9469 |
do ip2 = 1-oly, sny+oly |
9470 |
do ip1 = 1-olx, snx+olx |
9471 |
adphisurfx(ip1,ip2) = 0.d0 |
9472 |
end do |
9473 |
end do |
9474 |
do ip2 = 1-oly, sny+oly |
9475 |
do ip1 = 1-olx, snx+olx |
9476 |
adphisurfy(ip1,ip2) = 0.d0 |
9477 |
end do |
9478 |
end do |
9479 |
do ip2 = 1-oly, sny+oly |
9480 |
do ip1 = 1-olx, snx+olx |
9481 |
adrhok(ip1,ip2) = 0.d0 |
9482 |
end do |
9483 |
end do |
9484 |
do ip2 = 1-oly, sny+oly |
9485 |
do ip1 = 1-olx, snx+olx |
9486 |
adrhokm1(ip1,ip2) = 0.d0 |
9487 |
end do |
9488 |
end do |
9489 |
do ip2 = 1-oly, sny+oly |
9490 |
do ip1 = 1-olx, snx+olx |
9491 |
adrtrans(ip1,ip2) = 0.d0 |
9492 |
end do |
9493 |
end do |
9494 |
do ip3 = 1, nr |
9495 |
do ip2 = 1-oly, sny+oly |
9496 |
do ip1 = 1-olx, snx+olx |
9497 |
adsigmar(ip1,ip2,ip3) = 0.d0 |
9498 |
end do |
9499 |
end do |
9500 |
end do |
9501 |
do ip3 = 1, nr |
9502 |
do ip2 = 1-oly, sny+oly |
9503 |
do ip1 = 1-olx, snx+olx |
9504 |
adsigmax(ip1,ip2,ip3) = 0.d0 |
9505 |
end do |
9506 |
end do |
9507 |
end do |
9508 |
do ip3 = 1, nr |
9509 |
do ip2 = 1-oly, sny+oly |
9510 |
do ip1 = 1-olx, snx+olx |
9511 |
adsigmay(ip1,ip2,ip3) = 0.d0 |
9512 |
end do |
9513 |
end do |
9514 |
end do |
9515 |
do ip2 = 1-oly, sny+oly |
9516 |
do ip1 = 1-olx, snx+olx |
9517 |
adutrans(ip1,ip2) = 0.d0 |
9518 |
end do |
9519 |
end do |
9520 |
do ip2 = 1-oly, sny+oly |
9521 |
do ip1 = 1-olx, snx+olx |
9522 |
advtrans(ip1,ip2) = 0.d0 |
9523 |
end do |
9524 |
end do |
9525 |
|
9526 |
C---------------------------------------------- |
9527 |
C ROUTINE BODY |
9528 |
C---------------------------------------------- |
9529 |
do bj = mybylo(mythid), mybyhi(mythid) |
9530 |
do bi = mybxlo(mythid), mybxhi(mythid) |
9531 |
do ip3 = 1, 2 |
9532 |
do ip2 = 1-oly, sny+oly |
9533 |
do ip1 = 1-olx, snx+olx |
9534 |
adfvers(ip1,ip2,ip3) = 0.d0 |
9535 |
end do |
9536 |
end do |
9537 |
end do |
9538 |
do ip3 = 1, 2 |
9539 |
do ip2 = 1-oly, sny+oly |
9540 |
do ip1 = 1-olx, snx+olx |
9541 |
adfvert(ip1,ip2,ip3) = 0.d0 |
9542 |
end do |
9543 |
end do |
9544 |
end do |
9545 |
do ip3 = 1, nr |
9546 |
do ip2 = 1-oly, sny+oly |
9547 |
do ip1 = 1-olx, snx+olx |
9548 |
adkappars(ip1,ip2,ip3) = 0.d0 |
9549 |
end do |
9550 |
end do |
9551 |
end do |
9552 |
do ip3 = 1, nr |
9553 |
do ip2 = 1-oly, sny+oly |
9554 |
do ip1 = 1-olx, snx+olx |
9555 |
adkappart(ip1,ip2,ip3) = 0.d0 |
9556 |
end do |
9557 |
end do |
9558 |
end do |
9559 |
do ip3 = 1, nr |
9560 |
do ip2 = 1-oly, sny+oly |
9561 |
do ip1 = 1-olx, snx+olx |
9562 |
adkapparu(ip1,ip2,ip3) = 0.d0 |
9563 |
end do |
9564 |
end do |
9565 |
end do |
9566 |
do ip3 = 1, nr |
9567 |
do ip2 = 1-oly, sny+oly |
9568 |
do ip1 = 1-olx, snx+olx |
9569 |
adkapparv(ip1,ip2,ip3) = 0.d0 |
9570 |
end do |
9571 |
end do |
9572 |
end do |
9573 |
do ip3 = 1, nr |
9574 |
do ip2 = 1-oly, sny+oly |
9575 |
do ip1 = 1-olx, snx+olx |
9576 |
adphihyd(ip1,ip2,ip3) = 0.d0 |
9577 |
end do |
9578 |
end do |
9579 |
end do |
9580 |
do ip2 = 1-oly, sny+oly |
9581 |
do ip1 = 1-olx, snx+olx |
9582 |
adrtrans(ip1,ip2) = 0.d0 |
9583 |
end do |
9584 |
end do |
9585 |
do ip2 = 1-oly, sny+oly |
9586 |
do ip1 = 1-olx, snx+olx |
9587 |
adutrans(ip1,ip2) = 0.d0 |
9588 |
end do |
9589 |
end do |
9590 |
do ip2 = 1-oly, sny+oly |
9591 |
do ip1 = 1-olx, snx+olx |
9592 |
advtrans(ip1,ip2) = 0.d0 |
9593 |
end do |
9594 |
end do |
9595 |
act1 = bi-mybxlo(mythid) |
9596 |
max1 = mybxhi(mythid)-mybxlo(mythid)+1 |
9597 |
act2 = bj-mybylo(mythid) |
9598 |
max2 = mybyhi(mythid)-mybylo(mythid)+1 |
9599 |
act3 = mythid-1 |
9600 |
max3 = ntx*nty |
9601 |
act4 = ikey_dynamics-1 |
9602 |
ikey = act1+1+act2*max1+act3*max1*max2+act4*max1*max2*max3 |
9603 |
imin = 1-olx+1 |
9604 |
imax = snx+olx |
9605 |
jmin = 1-oly+1 |
9606 |
jmax = sny+oly |
9607 |
do ip3 = 1, nr |
9608 |
do ip2 = 1, 1+sny+oly-(1-oly) |
9609 |
do ip1 = 1, 1+snx+olx-(1-olx) |
9610 |
theta(ip1-1+1-olx,ip2-1+1-oly,ip3,bi,bj) = thetai(ip1, |
9611 |
$ip2,ip3,ikey) |
9612 |
end do |
9613 |
end do |
9614 |
end do |
9615 |
do ip3 = 1, nr |
9616 |
do ip2 = 1, 1+sny+oly-(1-oly) |
9617 |
do ip1 = 1, 1+snx+olx-(1-olx) |
9618 |
salt(ip1-1+1-olx,ip2-1+1-oly,ip3,bi,bj) = salti(ip1,ip2, |
9619 |
$ip3,ikey) |
9620 |
end do |
9621 |
end do |
9622 |
end do |
9623 |
do ip3 = 1, nr |
9624 |
do ip2 = 1, 1+sny+oly-(1-oly) |
9625 |
do ip1 = 1, 1+snx+olx-(1-olx) |
9626 |
wvel(ip1-1+1-olx,ip2-1+1-oly,ip3,bi,bj) = wvelh(ip1,ip2, |
9627 |
$ip3,ikey) |
9628 |
end do |
9629 |
end do |
9630 |
end do |
9631 |
do ip2 = 1, 1+sny+oly-(1-oly) |
9632 |
do ip1 = 1, 1+snx+olx-(1-olx) |
9633 |
surfacetendencyu(ip1-1+1-olx,ip2-1+1-oly,bi,bj) = |
9634 |
$surfacetendencyuh(ip1,ip2,ikey) |
9635 |
end do |
9636 |
end do |
9637 |
do ip2 = 1, 1+sny+oly-(1-oly) |
9638 |
do ip1 = 1, 1+snx+olx-(1-olx) |
9639 |
surfacetendencyv(ip1-1+1-olx,ip2-1+1-oly,bi,bj) = |
9640 |
$surfacetendencyvh(ip1,ip2,ikey) |
9641 |
end do |
9642 |
end do |
9643 |
do ip2 = 1, 1+sny+oly-(1-oly) |
9644 |
do ip1 = 1, 1+snx+olx-(1-olx) |
9645 |
surfacetendencys(ip1-1+1-olx,ip2-1+1-oly,bi,bj) = |
9646 |
$surfacetendencysh(ip1,ip2,ikey) |
9647 |
end do |
9648 |
end do |
9649 |
do ip2 = 1, 1+sny+oly-(1-oly) |
9650 |
do ip1 = 1, 1+snx+olx-(1-olx) |
9651 |
surfacetendencyt(ip1-1+1-olx,ip2-1+1-oly,bi,bj) = |
9652 |
$surfacetendencyth(ip1,ip2,ikey) |
9653 |
end do |
9654 |
end do |
9655 |
do ip3 = 1, nr |
9656 |
do ip2 = 1, 1+sny+oly-(1-oly) |
9657 |
do ip1 = 1, 1+snx+olx-(1-olx) |
9658 |
sigmax(ip1-1+1-olx,ip2-1+1-oly,ip3) = sigmaxh(ip1,ip2, |
9659 |
$ip3,ikey) |
9660 |
end do |
9661 |
end do |
9662 |
end do |
9663 |
do ip3 = 1, nr |
9664 |
do ip2 = 1, 1+sny+oly-(1-oly) |
9665 |
do ip1 = 1, 1+snx+olx-(1-olx) |
9666 |
sigmay(ip1-1+1-olx,ip2-1+1-oly,ip3) = sigmayh(ip1,ip2, |
9667 |
$ip3,ikey) |
9668 |
end do |
9669 |
end do |
9670 |
end do |
9671 |
do ip3 = 1, nr |
9672 |
do ip2 = 1, 1+sny+oly-(1-oly) |
9673 |
do ip1 = 1, 1+snx+olx-(1-olx) |
9674 |
sigmar(ip1-1+1-olx,ip2-1+1-oly,ip3) = sigmarh(ip1,ip2, |
9675 |
$ip3,ikey) |
9676 |
end do |
9677 |
end do |
9678 |
end do |
9679 |
do ip3 = 1, nr |
9680 |
do ip2 = 1, 1+sny+oly-(1-oly) |
9681 |
do ip1 = 1, 1+snx+olx-(1-olx) |
9682 |
kwx(ip1-1+1-olx,ip2-1+1-oly,ip3,bi,bj) = kwxh(ip1,ip2, |
9683 |
$ip3,ikey) |
9684 |
end do |
9685 |
end do |
9686 |
end do |
9687 |
do ip3 = 1, nr |
9688 |
do ip2 = 1, 1+sny+oly-(1-oly) |
9689 |
do ip1 = 1, 1+snx+olx-(1-olx) |
9690 |
kwy(ip1-1+1-olx,ip2-1+1-oly,ip3,bi,bj) = kwyh(ip1,ip2, |
9691 |
$ip3,ikey) |
9692 |
end do |
9693 |
end do |
9694 |
end do |
9695 |
do ip3 = 1, nr |
9696 |
do ip2 = 1, 1+sny+oly-(1-oly) |
9697 |
do ip1 = 1, 1+snx+olx-(1-olx) |
9698 |
kwz(ip1-1+1-olx,ip2-1+1-oly,ip3,bi,bj) = kwzh(ip1,ip2, |
9699 |
$ip3,ikey) |
9700 |
end do |
9701 |
end do |
9702 |
end do |
9703 |
do ip3 = 1, nr |
9704 |
do ip2 = 1, 1+sny+oly-(1-oly) |
9705 |
do ip1 = 1, 1+snx+olx-(1-olx) |
9706 |
kppghat(ip1-1+1-olx,ip2-1+1-oly,ip3,bi,bj) = |
9707 |
$kppghath(ip1,ip2,ip3,ikey) |
9708 |
end do |
9709 |
end do |
9710 |
end do |
9711 |
do ip3 = 1, nr |
9712 |
do ip2 = 1, 1+sny+oly-(1-oly) |
9713 |
do ip1 = 1, 1+snx+olx-(1-olx) |
9714 |
kppviscaz(ip1-1+1-olx,ip2-1+1-oly,ip3,bi,bj) = |
9715 |
$kppviscazh(ip1,ip2,ip3,ikey) |
9716 |
end do |
9717 |
end do |
9718 |
end do |
9719 |
do ip3 = 1, nr |
9720 |
do ip2 = 1, 1+sny+oly-(1-oly) |
9721 |
do ip1 = 1, 1+snx+olx-(1-olx) |
9722 |
kppdiffkzt(ip1-1+1-olx,ip2-1+1-oly,ip3,bi,bj) = |
9723 |
$kppdiffkzth(ip1,ip2,ip3,ikey) |
9724 |
end do |
9725 |
end do |
9726 |
end do |
9727 |
do ip3 = 1, nr |
9728 |
do ip2 = 1, 1+sny+oly-(1-oly) |
9729 |
do ip1 = 1, 1+snx+olx-(1-olx) |
9730 |
kppdiffkzs(ip1-1+1-olx,ip2-1+1-oly,ip3,bi,bj) = |
9731 |
$kppdiffkzsh(ip1,ip2,ip3,ikey) |
9732 |
end do |
9733 |
end do |
9734 |
end do |
9735 |
do ip2 = 1, 1+sny+oly-(1-oly) |
9736 |
do ip1 = 1, 1+snx+olx-(1-olx) |
9737 |
kppfrac(ip1-1+1-olx,ip2-1+1-oly,bi,bj) = kppfrach(ip1,ip2, |
9738 |
$ikey) |
9739 |
end do |
9740 |
end do |
9741 |
do ip3 = 1, nr |
9742 |
do ip2 = 1, 1+sny+oly-(1-oly) |
9743 |
do ip1 = 1, 1+snx+olx-(1-olx) |
9744 |
kappart(ip1-1+1-olx,ip2-1+1-oly,ip3) = kapparti(ip1,ip2, |
9745 |
$ip3,ikey) |
9746 |
end do |
9747 |
end do |
9748 |
end do |
9749 |
do ip3 = 1, nr |
9750 |
do ip2 = 1, 1+sny+oly-(1-oly) |
9751 |
do ip1 = 1, 1+snx+olx-(1-olx) |
9752 |
kappars(ip1-1+1-olx,ip2-1+1-oly,ip3) = kapparsi(ip1,ip2, |
9753 |
$ip3,ikey) |
9754 |
end do |
9755 |
end do |
9756 |
end do |
9757 |
do ip3 = 1, nr |
9758 |
do ip2 = 1, 1+sny+oly-(1-oly) |
9759 |
do ip1 = 1, 1+snx+olx-(1-olx) |
9760 |
theta(ip1-1+1-olx,ip2-1+1-oly,ip3,bi,bj) = thetah(ip1, |
9761 |
$ip2,ip3,ikey) |
9762 |
end do |
9763 |
end do |
9764 |
end do |
9765 |
do ip3 = 1, nr |
9766 |
do ip2 = 1, 1+sny+oly-(1-oly) |
9767 |
do ip1 = 1, 1+snx+olx-(1-olx) |
9768 |
salt(ip1-1+1-olx,ip2-1+1-oly,ip3,bi,bj) = salth(ip1,ip2, |
9769 |
$ip3,ikey) |
9770 |
end do |
9771 |
end do |
9772 |
end do |
9773 |
do ip3 = 1, nr |
9774 |
do ip2 = 1, 1+sny+oly-(1-oly) |
9775 |
do ip1 = 1, 1+snx+olx-(1-olx) |
9776 |
uvel(ip1-1+1-olx,ip2-1+1-oly,ip3,bi,bj) = uvelh(ip1,ip2, |
9777 |
$ip3,ikey) |
9778 |
end do |
9779 |
end do |
9780 |
end do |
9781 |
do ip3 = 1, nr |
9782 |
do ip2 = 1, 1+sny+oly-(1-oly) |
9783 |
do ip1 = 1, 1+snx+olx-(1-olx) |
9784 |
vvel(ip1-1+1-olx,ip2-1+1-oly,ip3,bi,bj) = vvelh(ip1,ip2, |
9785 |
$ip3,ikey) |
9786 |
end do |
9787 |
end do |
9788 |
end do |
9789 |
do k = nr, 1, -1 |
9790 |
imin = 1-olx+2 |
9791 |
imax = snx+olx-1 |
9792 |
jmin = 1-oly+2 |
9793 |
jmax = sny+oly-1 |
9794 |
call calc_common_factors( bi,bj,imin,imax,jmin,jmax,k,km1, |
9795 |
$kup,kdown,xa,ya,utrans,vtrans,rtrans,maskc,maskup,mythid ) |
9796 |
call calc_diffusivity( bi,bj,imin,imax,jmin,jmax,k,maskc, |
9797 |
$maskup,kappart,kappars,kapparu,kapparv,mythid ) |
9798 |
end do |
9799 |
imin = 1-olx+2 |
9800 |
imax = snx+olx-1 |
9801 |
jmin = 1-oly+2 |
9802 |
jmax = sny+oly-1 |
9803 |
if (implicitviscosity .and. momstepping) then |
9804 |
do ip3 = 1, nr |
9805 |
do ip2 = 1, 1+sny+oly-(1-oly) |
9806 |
do ip1 = 1, 1+snx+olx-(1-olx) |
9807 |
gunm1(ip1-1+1-olx,ip2-1+1-oly,ip3,bi,bj) = gunm1h(ip1, |
9808 |
$ip2,ip3,ikey) |
9809 |
end do |
9810 |
end do |
9811 |
end do |
9812 |
do ip3 = 1, nr |
9813 |
do ip2 = 1, 1+sny+oly-(1-oly) |
9814 |
do ip1 = 1, 1+snx+olx-(1-olx) |
9815 |
gvnm1(ip1-1+1-olx,ip2-1+1-oly,ip3,bi,bj) = gvnm1h(ip1, |
9816 |
$ip2,ip3,ikey) |
9817 |
end do |
9818 |
end do |
9819 |
end do |
9820 |
do ip3 = 1, nr |
9821 |
do ip2 = 1, 1+sny+oly-(1-oly) |
9822 |
do ip1 = 1, 1+snx+olx-(1-olx) |
9823 |
vveld(ip1-1+1-olx,ip2-1+1-oly,ip3,bi,bj) = vveldh(ip1, |
9824 |
$ip2,ip3,ikey) |
9825 |
end do |
9826 |
end do |
9827 |
end do |
9828 |
do ip3 = 1, nr |
9829 |
do ip2 = 1, 1+sny+oly-(1-oly) |
9830 |
do ip1 = 1, 1+snx+olx-(1-olx) |
9831 |
uveld(ip1-1+1-olx,ip2-1+1-oly,ip3,bi,bj) = uveldh(ip1, |
9832 |
$ip2,ip3,ikey) |
9833 |
end do |
9834 |
end do |
9835 |
end do |
9836 |
call adimpldiff( bi,bj,imin,imax,jmin,jmax,deltatmom, |
9837 |
$kapparv,recip_hfacs,uveld,adkapparv,aduveld ) |
9838 |
call adimpldiff( bi,bj,imin,imax,jmin,jmax,deltatmom, |
9839 |
$kapparu,recip_hfacw,vveld,adkapparu,advveld ) |
9840 |
call adimpldiff( bi,bj,imin,imax,jmin,jmax,deltatmom, |
9841 |
$kapparv,recip_hfacs,gvnm1,adkapparv,adgvnm1 ) |
9842 |
call adimpldiff( bi,bj,imin,imax,jmin,jmax,deltatmom, |
9843 |
$kapparu,recip_hfacw,gunm1,adkapparu,adgunm1 ) |
9844 |
endif |
9845 |
do k = nr, 1, -1 |
9846 |
kup = 1+mod(k+1,2) |
9847 |
kdown = 1+mod(k,2) |
9848 |
if (momstepping) then |
9849 |
call adtimestep( bi,bj,imin,imax,jmin,jmax,k,adphihyd, |
9850 |
$adphisurfx,adphisurfy ) |
9851 |
call adcalc_mom_rhs( bi,bj,imin,imax,jmin,jmax,k,kup, |
9852 |
$kdown,kapparu,kapparv,adphihyd,adkapparu,adkapparv,adfveru, |
9853 |
$adfverv ) |
9854 |
endif |
9855 |
if (staggertimestep) then |
9856 |
call adcalc_phi_hyd( bi,bj,imin,imax,jmin,jmax,k,mythid, |
9857 |
$adgtnm1,adgsnm1,adphihyd ) |
9858 |
else |
9859 |
call adcalc_phi_hyd( bi,bj,imin,imax,jmin,jmax,k,mythid, |
9860 |
$adtheta,adsalt,adphihyd ) |
9861 |
endif |
9862 |
end do |
9863 |
if (implicsurfpress .ne. 1.) then |
9864 |
call adcalc_grad_phi_surf( bi,bj,imin,imax,jmin,jmax,adetan, |
9865 |
$adphisurfx,adphisurfy ) |
9866 |
endif |
9867 |
ikey = act1+1+act2*max1+act3*max1*max2+act4*max1*max2*max3 |
9868 |
do k = nr, 1, -1 |
9869 |
imin = 1-olx+2 |
9870 |
imax = snx+olx-1 |
9871 |
jmin = 1-oly+2 |
9872 |
jmax = sny+oly-1 |
9873 |
end do |
9874 |
if (implicitdiffusion) then |
9875 |
if (saltstepping) then |
9876 |
do ip3 = 1, nr |
9877 |
do ip2 = 1, 1+sny+oly-(1-oly) |
9878 |
do ip1 = 1, 1+snx+olx-(1-olx) |
9879 |
gsnm1(ip1-1+1-olx,ip2-1+1-oly,ip3,bi,bj) = |
9880 |
$gsnm1h(ip1,ip2,ip3,ikey) |
9881 |
end do |
9882 |
end do |
9883 |
end do |
9884 |
call adimpldiff( bi,bj,imin,imax,jmin,jmax,deltattracer, |
9885 |
$kappars,recip_hfacc,gsnm1,adkappars,adgsnm1 ) |
9886 |
endif |
9887 |
if (tempstepping) then |
9888 |
do ip3 = 1, nr |
9889 |
do ip2 = 1, 1+sny+oly-(1-oly) |
9890 |
do ip1 = 1, 1+snx+olx-(1-olx) |
9891 |
gtnm1(ip1-1+1-olx,ip2-1+1-oly,ip3,bi,bj) = |
9892 |
$gtnm1h(ip1,ip2,ip3,ikey) |
9893 |
end do |
9894 |
end do |
9895 |
end do |
9896 |
call adimpldiff( bi,bj,imin,imax,jmin,jmax,deltattracer, |
9897 |
$kappart,recip_hfacc,gtnm1,adkappart,adgtnm1 ) |
9898 |
endif |
9899 |
endif |
9900 |
do k = 1, nr |
9901 |
kkey = (ikey-1)*nr+k |
9902 |
km1 = max(1,k-1) |
9903 |
kup = 1+mod(k+1,2) |
9904 |
kdown = 1+mod(k,2) |
9905 |
imin = 1-olx+2 |
9906 |
imax = snx+olx-1 |
9907 |
jmin = 1-oly+2 |
9908 |
jmax = sny+oly-1 |
9909 |
call calc_common_factors( bi,bj,imin,imax,jmin,jmax,k,km1, |
9910 |
$kup,kdown,xa,ya,utrans,vtrans,rtrans,maskc,maskup,mythid ) |
9911 |
do ip2 = 1, 1+sny+oly-(1-oly) |
9912 |
do ip1 = 1, 1+snx+olx-(1-olx) |
9913 |
kappart(ip1-1+1-olx,ip2-1+1-oly,k) = kapparth(ip1,ip2, |
9914 |
$kkey) |
9915 |
end do |
9916 |
end do |
9917 |
do ip2 = 1, 1+sny+oly-(1-oly) |
9918 |
do ip1 = 1, 1+snx+olx-(1-olx) |
9919 |
kappars(ip1-1+1-olx,ip2-1+1-oly,k) = kapparsh(ip1,ip2, |
9920 |
$kkey) |
9921 |
end do |
9922 |
end do |
9923 |
call calc_diffusivity( bi,bj,imin,imax,jmin,jmax,k,maskc, |
9924 |
$maskup,kappart,kappars,kapparu,kapparv,mythid ) |
9925 |
if (allowfreezing) then |
9926 |
do ip2 = 1, 1+sny+oly-(1-oly) |
9927 |
do ip1 = 1, 1+snx+olx-(1-olx) |
9928 |
gtnm1(ip1-1+1-olx,ip2-1+1-oly,k,bi,bj) = gtnm1i(ip1, |
9929 |
$ip2,kkey) |
9930 |
end do |
9931 |
end do |
9932 |
call adfreeze( bi,bj,imin,imax,jmin,jmax,k ) |
9933 |
endif |
9934 |
if (saltstepping) then |
9935 |
call adtimestep_tracer( bi,bj,imin,imax,jmin,jmax,k, |
9936 |
$adsalt,adgs,adgsnm1 ) |
9937 |
call adcalc_gs( bi,bj,imin,imax,jmin,jmax,k,km1,kup,kdown, |
9938 |
$xa,ya,utrans,vtrans,rtrans,maskup,maskc,kappars,adutrans,advtrans, |
9939 |
$adrtrans,adkappars,adfvers ) |
9940 |
endif |
9941 |
if (tempstepping) then |
9942 |
call adtimestep_tracer( bi,bj,imin,imax,jmin,jmax,k, |
9943 |
$adtheta,adgt,adgtnm1 ) |
9944 |
call adcalc_gt( bi,bj,imin,imax,jmin,jmax,k,km1,kup,kdown, |
9945 |
$xa,ya,utrans,vtrans,rtrans,maskup,maskc,kappart,adutrans,advtrans, |
9946 |
$adrtrans,adkappart,adfvert ) |
9947 |
endif |
9948 |
call adcalc_diffusivity( bi,bj,imin,imax,jmin,jmax,k,maskc, |
9949 |
$maskup,adkappart,adkappars,adkapparu,adkapparv ) |
9950 |
call adcalc_common_factors( bi,bj,imin,imax,jmin,jmax,k, |
9951 |
$adutrans,advtrans,adrtrans ) |
9952 |
end do |
9953 |
ikey = act1+1+act2*max1+act3*max1*max2+act4*max1*max2*max3 |
9954 |
do ip3 = 1, nr |
9955 |
do ip2 = 1, 1+sny+oly-(1-oly) |
9956 |
do ip1 = 1, 1+snx+olx-(1-olx) |
9957 |
theta(ip1-1+1-olx,ip2-1+1-oly,ip3,bi,bj) = thetai(ip1, |
9958 |
$ip2,ip3,ikey) |
9959 |
end do |
9960 |
end do |
9961 |
end do |
9962 |
do ip3 = 1, nr |
9963 |
do ip2 = 1, 1+sny+oly-(1-oly) |
9964 |
do ip1 = 1, 1+snx+olx-(1-olx) |
9965 |
salt(ip1-1+1-olx,ip2-1+1-oly,ip3,bi,bj) = salti(ip1,ip2, |
9966 |
$ip3,ikey) |
9967 |
end do |
9968 |
end do |
9969 |
end do |
9970 |
do ip3 = 1, nr |
9971 |
do ip2 = 1, 1+sny+oly-(1-oly) |
9972 |
do ip1 = 1, 1+snx+olx-(1-olx) |
9973 |
uvel(ip1-1+1-olx,ip2-1+1-oly,ip3,bi,bj) = uveli(ip1,ip2, |
9974 |
$ip3,ikey) |
9975 |
end do |
9976 |
end do |
9977 |
end do |
9978 |
do ip3 = 1, nr |
9979 |
do ip2 = 1, 1+sny+oly-(1-oly) |
9980 |
do ip1 = 1, 1+snx+olx-(1-olx) |
9981 |
vvel(ip1-1+1-olx,ip2-1+1-oly,ip3,bi,bj) = vveli(ip1,ip2, |
9982 |
$ip3,ikey) |
9983 |
end do |
9984 |
end do |
9985 |
end do |
9986 |
if (usekpp) then |
9987 |
call adkpp_calc( bi,bj,mytime ) |
9988 |
else |
9989 |
call adkpp_calc_dummy( bi,bj ) |
9990 |
endif |
9991 |
if (usegmredi) then |
9992 |
do k = nr, 1, -1 |
9993 |
call adgmredi_calc_tensor( bi,bj,k,sigmax,sigmay,sigmar, |
9994 |
$adsigmax,adsigmay,adsigmar ) |
9995 |
end do |
9996 |
else |
9997 |
do k = nr, 1, -1 |
9998 |
call adgmredi_calc_tensor_dummy( bi,bj,k ) |
9999 |
end do |
10000 |
endif |
10001 |
imin = 1-olx+1 |
10002 |
imax = snx+olx |
10003 |
jmin = 1-oly+1 |
10004 |
jmax = sny+oly |
10005 |
call adexternal_forcing_surf( bi,bj,imin,imax,jmin,jmax ) |
10006 |
do k = 1, nr |
10007 |
kkey = (ikey-1)*nr+k |
10008 |
do ip2 = 1, 1+sny+oly-(1-oly) |
10009 |
do ip1 = 1, 1+snx+olx-(1-olx) |
10010 |
rhokm1(ip1-1+1-olx,ip2-1+1-oly) = rhokm1h(ip1,ip2,kkey) |
10011 |
end do |
10012 |
end do |
10013 |
do ip2 = 1, 1+sny+oly-(1-oly) |
10014 |
do ip1 = 1, 1+snx+olx-(1-olx) |
10015 |
rhok(ip1-1+1-olx,ip2-1+1-oly) = rhokh(ip1,ip2,kkey) |
10016 |
end do |
10017 |
end do |
10018 |
if (usegmredi .or. k .gt. 1 .and. ivdc_kappa .ne. 0.) then |
10019 |
call find_rho( bi,bj,imin,imax,jmin,jmax,k,k,eostype, |
10020 |
$theta,salt,rhok,mythid ) |
10021 |
if (k .gt. 1) then |
10022 |
help_h = k-1 |
10023 |
call find_rho( bi,bj,imin,imax,jmin,jmax,help_h,k, |
10024 |
$eostype,theta,salt,rhokm1,mythid ) |
10025 |
endif |
10026 |
endif |
10027 |
if (k .gt. 1 .and. ivdc_kappa .ne. 0.) then |
10028 |
call adcalc_ivdc( bi,bj,imin,imax,jmin,jmax,k,rhokm1,rhok, |
10029 |
$adrhokm1,adrhok,adkappart,adkappars ) |
10030 |
endif |
10031 |
if (usegmredi .or. k .gt. 1 .and. ivdc_kappa .ne. 0.) then |
10032 |
call adgrad_sigma( bi,bj,k,adrhok,adrhokm1,adrhok, |
10033 |
$adsigmax,adsigmay,adsigmar ) |
10034 |
if (k .gt. 1) then |
10035 |
do ip2 = 1, 1+sny+oly-(1-oly) |
10036 |
do ip1 = 1, 1+snx+olx-(1-olx) |
10037 |
theta(ip1-1+1-olx,ip2-1+1-oly,k-1,bi,bj) = |
10038 |
$thetaj(ip1,ip2,kkey) |
10039 |
end do |
10040 |
end do |
10041 |
do ip2 = 1, 1+sny+oly-(1-oly) |
10042 |
do ip1 = 1, 1+snx+olx-(1-olx) |
10043 |
salt(ip1-1+1-olx,ip2-1+1-oly,k-1,bi,bj) = saltj(ip1, |
10044 |
$ip2,kkey) |
10045 |
end do |
10046 |
end do |
10047 |
call adfind_rho( bi,bj,imin,imax,jmin,jmax,help_h,k, |
10048 |
$eostype,theta,salt,adtheta,adsalt,adrhokm1 ) |
10049 |
endif |
10050 |
do ip2 = 1, 1+sny+oly-(1-oly) |
10051 |
do ip1 = 1, 1+snx+olx-(1-olx) |
10052 |
theta(ip1-1+1-olx,ip2-1+1-oly,k,bi,bj) = thetak(ip1, |
10053 |
$ip2,kkey) |
10054 |
end do |
10055 |
end do |
10056 |
do ip2 = 1, 1+sny+oly-(1-oly) |
10057 |
do ip1 = 1, 1+snx+olx-(1-olx) |
10058 |
salt(ip1-1+1-olx,ip2-1+1-oly,k,bi,bj) = saltk(ip1,ip2, |
10059 |
$kkey) |
10060 |
end do |
10061 |
end do |
10062 |
call adfind_rho( bi,bj,imin,imax,jmin,jmax,k,k,eostype, |
10063 |
$theta,salt,adtheta,adsalt,adrhok ) |
10064 |
endif |
10065 |
call adintegrate_for_w( bi,bj,k,aduvel,advvel,adwvel ) |
10066 |
end do |
10067 |
do k = 1, nr |
10068 |
do j = 1-oly, sny+oly |
10069 |
do i = 1-olx, snx+olx |
10070 |
adkappars(i,j,k) = 0.d0 |
10071 |
adkappart(i,j,k) = 0.d0 |
10072 |
end do |
10073 |
end do |
10074 |
end do |
10075 |
do j = 1-oly, sny+oly |
10076 |
do i = 1-olx, snx+olx |
10077 |
adfvers(i,j,2) = 0.d0 |
10078 |
adfvers(i,j,1) = 0.d0 |
10079 |
adfvert(i,j,2) = 0.d0 |
10080 |
adfvert(i,j,1) = 0.d0 |
10081 |
end do |
10082 |
end do |
10083 |
end do |
10084 |
end do |
10085 |
|
10086 |
end |
10087 |
|
10088 |
|
10089 |
subroutine adenhance( dkm1, hbl, kbl, diffus, casea, ghat, blmc, |
10090 |
$addkm1, adhbl, addiffus, adcasea, adghat, adblmc ) |
10091 |
C*************************************************************** |
10092 |
C*************************************************************** |
10093 |
C** This routine was generated by the ** |
10094 |
C** Tangent linear and Adjoint Model Compiler, TAMC 5.2.14 ** |
10095 |
C*************************************************************** |
10096 |
C*************************************************************** |
10097 |
C============================================== |
10098 |
C all entries are defined explicitly |
10099 |
C============================================== |
10100 |
implicit none |
10101 |
|
10102 |
C============================================== |
10103 |
C define parameters |
10104 |
C============================================== |
10105 |
integer olx |
10106 |
parameter ( olx = 3 ) |
10107 |
integer oly |
10108 |
parameter ( oly = 3 ) |
10109 |
integer snx |
10110 |
parameter ( snx = 20 ) |
10111 |
integer sny |
10112 |
parameter ( sny = 40 ) |
10113 |
integer imt |
10114 |
parameter ( imt = (snx+2*olx)*(sny+2*oly) ) |
10115 |
integer mdiff |
10116 |
parameter ( mdiff = 3 ) |
10117 |
integer nr |
10118 |
parameter ( nr = 15 ) |
10119 |
integer nrp1 |
10120 |
parameter ( nrp1 = nr+1 ) |
10121 |
integer nsx |
10122 |
parameter ( nsx = 1 ) |
10123 |
integer nsy |
10124 |
parameter ( nsy = 1 ) |
10125 |
|
10126 |
C============================================== |
10127 |
C define common blocks |
10128 |
C============================================== |
10129 |
common /kpp_r1/ pmask, zgrid, hwide |
10130 |
double precision hwide(0:nr+1) |
10131 |
double precision pmask(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
10132 |
double precision zgrid(0:nr+1) |
10133 |
|
10134 |
C============================================== |
10135 |
C define arguments |
10136 |
C============================================== |
10137 |
double precision adblmc(imt,nr,mdiff) |
10138 |
double precision adcasea(imt) |
10139 |
double precision addiffus(imt,0:nrp1,mdiff) |
10140 |
double precision addkm1(imt,mdiff) |
10141 |
double precision adghat(imt,nr) |
10142 |
double precision adhbl(imt) |
10143 |
double precision blmc(imt,nr,mdiff) |
10144 |
double precision casea(imt) |
10145 |
double precision diffus(imt,0:nrp1,mdiff) |
10146 |
double precision dkm1(imt,mdiff) |
10147 |
double precision ghat(imt,nr) |
10148 |
double precision hbl(imt) |
10149 |
integer kbl(imt) |
10150 |
|
10151 |
C============================================== |
10152 |
C define local variables |
10153 |
C============================================== |
10154 |
double precision addelta |
10155 |
double precision addkmp5 |
10156 |
double precision addstar |
10157 |
double precision delta |
10158 |
double precision dkmp5 |
10159 |
double precision dstar |
10160 |
integer i |
10161 |
integer ki |
10162 |
integer md |
10163 |
|
10164 |
C---------------------------------------------- |
10165 |
C RESET LOCAL ADJOINT VARIABLES |
10166 |
C---------------------------------------------- |
10167 |
addelta = 0.d0 |
10168 |
addkmp5 = 0.d0 |
10169 |
addstar = 0.d0 |
10170 |
|
10171 |
C---------------------------------------------- |
10172 |
C ROUTINE BODY |
10173 |
C---------------------------------------------- |
10174 |
do i = 1, imt |
10175 |
addelta = 0.d0 |
10176 |
addkmp5 = 0.d0 |
10177 |
addstar = 0.d0 |
10178 |
ki = kbl(i)-1 |
10179 |
if (ki .ge. 1 .and. ki .lt. nr) then |
10180 |
delta = (hbl(i)+zgrid(ki))/(zgrid(ki)-zgrid(ki+1)) |
10181 |
adcasea(i) = adcasea(i)-adghat(i,ki)*ghat(i,ki) |
10182 |
adghat(i,ki) = adghat(i,ki)*(1.-casea(i)) |
10183 |
do md = 1, mdiff |
10184 |
addkmp5 = 0.d0 |
10185 |
addstar = 0.d0 |
10186 |
dkmp5 = casea(i)*diffus(i,ki,md)+(1.-casea(i))*blmc(i,ki,md) |
10187 |
dstar = (1.-delta)**2*dkm1(i,md)+delta**2*dkmp5 |
10188 |
addelta = addelta+adblmc(i,ki,md)*((-diffus(i,ki,md))+dstar) |
10189 |
addiffus(i,ki,md) = addiffus(i,ki,md)+adblmc(i,ki,md)*(1.- |
10190 |
$delta) |
10191 |
addstar = addstar+adblmc(i,ki,md)*delta |
10192 |
adblmc(i,ki,md) = 0.d0 |
10193 |
addelta = addelta+addstar*((-2)*(1.-delta)*dkm1(i,md)+2* |
10194 |
$delta*dkmp5) |
10195 |
addkm1(i,md) = addkm1(i,md)+addstar*(1.-delta)**2 |
10196 |
addkmp5 = addkmp5+addstar*delta**2 |
10197 |
addstar = 0.d0 |
10198 |
adblmc(i,ki,md) = adblmc(i,ki,md)+addkmp5*(1.-casea(i)) |
10199 |
adcasea(i) = adcasea(i)+addkmp5*(diffus(i,ki,md)-blmc(i,ki, |
10200 |
$md)) |
10201 |
addiffus(i,ki,md) = addiffus(i,ki,md)+addkmp5*casea(i) |
10202 |
addkmp5 = 0.d0 |
10203 |
end do |
10204 |
adhbl(i) = adhbl(i)+addelta/(zgrid(ki)-zgrid(ki+1)) |
10205 |
addelta = 0.d0 |
10206 |
endif |
10207 |
end do |
10208 |
|
10209 |
end |
10210 |
|
10211 |
|
10212 |
subroutine adexternal_forcing_s( imin, imax, jmin, jmax, bi, bj, |
10213 |
$klev, maskc ) |
10214 |
C*************************************************************** |
10215 |
C*************************************************************** |
10216 |
C** This routine was generated by the ** |
10217 |
C** Tangent linear and Adjoint Model Compiler, TAMC 5.2.14 ** |
10218 |
C*************************************************************** |
10219 |
C*************************************************************** |
10220 |
C============================================== |
10221 |
C all entries are defined explicitly |
10222 |
C============================================== |
10223 |
implicit none |
10224 |
|
10225 |
C============================================== |
10226 |
C define parameters |
10227 |
C============================================== |
10228 |
integer nr |
10229 |
parameter ( nr = 15 ) |
10230 |
integer nsx |
10231 |
parameter ( nsx = 1 ) |
10232 |
integer nsy |
10233 |
parameter ( nsy = 1 ) |
10234 |
integer olx |
10235 |
parameter ( olx = 3 ) |
10236 |
integer oly |
10237 |
parameter ( oly = 3 ) |
10238 |
integer snx |
10239 |
parameter ( snx = 20 ) |
10240 |
integer sny |
10241 |
parameter ( sny = 40 ) |
10242 |
|
10243 |
C============================================== |
10244 |
C define common blocks |
10245 |
C============================================== |
10246 |
common /addynvars_r/ adetan, aduvel, advvel, adwvel, adtheta, |
10247 |
$adsalt, adgu, adgv, adgt, adgs, adgunm1, adgvnm1, adgtnm1, adgsnm1 |
10248 |
double precision adetan(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
10249 |
double precision adgs(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
10250 |
double precision adgsnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
10251 |
double precision adgt(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
10252 |
double precision adgtnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
10253 |
double precision adgu(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
10254 |
double precision adgunm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
10255 |
double precision adgv(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
10256 |
double precision adgvnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
10257 |
double precision adsalt(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
10258 |
double precision adtheta(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
10259 |
double precision aduvel(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
10260 |
double precision advvel(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
10261 |
double precision adwvel(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
10262 |
|
10263 |
common /adtendency_forcing/ adsurfacetendencyu, |
10264 |
$adsurfacetendencyv, adsurfacetendencyt, adsurfacetendencys |
10265 |
double precision adsurfacetendencys(1-olx:snx+olx,1-oly:sny+oly, |
10266 |
$nsx,nsy) |
10267 |
double precision adsurfacetendencyt(1-olx:snx+olx,1-oly:sny+oly, |
10268 |
$nsx,nsy) |
10269 |
double precision adsurfacetendencyu(1-olx:snx+olx,1-oly:sny+oly, |
10270 |
$nsx,nsy) |
10271 |
double precision adsurfacetendencyv(1-olx:snx+olx,1-oly:sny+oly, |
10272 |
$nsx,nsy) |
10273 |
|
10274 |
C============================================== |
10275 |
C define arguments |
10276 |
C============================================== |
10277 |
integer bi |
10278 |
integer bj |
10279 |
integer imax |
10280 |
integer imin |
10281 |
integer jmax |
10282 |
integer jmin |
10283 |
integer klev |
10284 |
double precision maskc(1-olx:snx+olx,1-oly:sny+oly) |
10285 |
|
10286 |
C============================================== |
10287 |
C define local variables |
10288 |
C============================================== |
10289 |
integer i |
10290 |
integer j |
10291 |
|
10292 |
C---------------------------------------------- |
10293 |
C ROUTINE BODY |
10294 |
C---------------------------------------------- |
10295 |
if (klev .eq. 1) then |
10296 |
do j = jmin, jmax |
10297 |
do i = imin, imax |
10298 |
adsurfacetendencys(i,j,bi,bj) = adsurfacetendencys(i,j,bi, |
10299 |
$bj)+adgs(i,j,klev,bi,bj)*maskc(i,j) |
10300 |
end do |
10301 |
end do |
10302 |
endif |
10303 |
|
10304 |
end |
10305 |
|
10306 |
|
10307 |
subroutine adexternal_forcing_surf( bi, bj, imin, imax, jmin, |
10308 |
$jmax ) |
10309 |
C*************************************************************** |
10310 |
C*************************************************************** |
10311 |
C** This routine was generated by the ** |
10312 |
C** Tangent linear and Adjoint Model Compiler, TAMC 5.2.14 ** |
10313 |
C*************************************************************** |
10314 |
C*************************************************************** |
10315 |
C============================================== |
10316 |
C all entries are defined explicitly |
10317 |
C============================================== |
10318 |
implicit none |
10319 |
|
10320 |
C============================================== |
10321 |
C define parameters |
10322 |
C============================================== |
10323 |
integer npx |
10324 |
parameter ( npx = 1 ) |
10325 |
integer npy |
10326 |
parameter ( npy = 1 ) |
10327 |
integer nr |
10328 |
parameter ( nr = 15 ) |
10329 |
integer nsx |
10330 |
parameter ( nsx = 1 ) |
10331 |
integer nsy |
10332 |
parameter ( nsy = 1 ) |
10333 |
integer snx |
10334 |
parameter ( snx = 20 ) |
10335 |
integer nx |
10336 |
parameter ( nx = snx*nsx*npx ) |
10337 |
integer sny |
10338 |
parameter ( sny = 40 ) |
10339 |
integer ny |
10340 |
parameter ( ny = sny*nsy*npy ) |
10341 |
integer olx |
10342 |
parameter ( olx = 3 ) |
10343 |
integer oly |
10344 |
parameter ( oly = 3 ) |
10345 |
|
10346 |
C============================================== |
10347 |
C define common blocks |
10348 |
C============================================== |
10349 |
common /addynvars_r/ adetan, aduvel, advvel, adwvel, adtheta, |
10350 |
$adsalt, adgu, adgv, adgt, adgs, adgunm1, adgvnm1, adgtnm1, adgsnm1 |
10351 |
double precision adetan(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
10352 |
double precision adgs(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
10353 |
double precision adgsnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
10354 |
double precision adgt(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
10355 |
double precision adgtnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
10356 |
double precision adgu(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
10357 |
double precision adgunm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
10358 |
double precision adgv(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
10359 |
double precision adgvnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
10360 |
double precision adsalt(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
10361 |
double precision adtheta(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
10362 |
double precision aduvel(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
10363 |
double precision advvel(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
10364 |
double precision adwvel(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
10365 |
|
10366 |
common /adffields/ adfu, adfv, adqnet, adempmr |
10367 |
double precision adempmr(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
10368 |
double precision adfu(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
10369 |
double precision adfv(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
10370 |
double precision adqnet(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
10371 |
|
10372 |
common /adtendency_forcing/ adsurfacetendencyu, |
10373 |
$adsurfacetendencyv, adsurfacetendencyt, adsurfacetendencys |
10374 |
double precision adsurfacetendencys(1-olx:snx+olx,1-oly:sny+oly, |
10375 |
$nsx,nsy) |
10376 |
double precision adsurfacetendencyt(1-olx:snx+olx,1-oly:sny+oly, |
10377 |
$nsx,nsy) |
10378 |
double precision adsurfacetendencyu(1-olx:snx+olx,1-oly:sny+oly, |
10379 |
$nsx,nsy) |
10380 |
double precision adsurfacetendencyv(1-olx:snx+olx,1-oly:sny+oly, |
10381 |
$nsx,nsy) |
10382 |
|
10383 |
common /grid_r/ dxc, dxf, dxg, dxv, dyc, dyf, dyg, dyu, drc, drf, |
10384 |
$h, hfacc, hfacw, hfacs, depthink, recip_dxc, recip_dxf, recip_dxg, |
10385 |
$ recip_dxv, recip_dyc, recip_dyf, recip_dyg, recip_dyu, recip_drc, |
10386 |
$ recip_drf, recip_h, recip_hfacc, recip_hfacw, recip_hfacs, rkfac, |
10387 |
$ recip_rkfac, safac, xc, yc, ra, raw, ras, raz, rc, rf, yc0, xc0, |
10388 |
$xg, yg, maskw, masks, recip_ra, recip_raw, recip_ras, recip_raz, |
10389 |
$tanphiatu, tanphiatv |
10390 |
double precision depthink(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
10391 |
double precision drc(1:nr) |
10392 |
double precision drf(1:nr) |
10393 |
double precision dxc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
10394 |
double precision dxf(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
10395 |
double precision dxg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
10396 |
double precision dxv(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
10397 |
double precision dyc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
10398 |
double precision dyf(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
10399 |
double precision dyg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
10400 |
double precision dyu(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
10401 |
double precision h(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
10402 |
double precision hfacc(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) |
10403 |
double precision hfacs(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) |
10404 |
double precision hfacw(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) |
10405 |
double precision masks(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) |
10406 |
double precision maskw(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) |
10407 |
double precision ra(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
10408 |
double precision ras(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
10409 |
double precision raw(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
10410 |
double precision raz(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
10411 |
double precision rc(1:nr) |
10412 |
double precision recip_drc(1:nr) |
10413 |
double precision recip_drf(1:nr) |
10414 |
double precision recip_dxc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
10415 |
double precision recip_dxf(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
10416 |
double precision recip_dxg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
10417 |
double precision recip_dxv(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
10418 |
double precision recip_dyc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
10419 |
double precision recip_dyf(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
10420 |
double precision recip_dyg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
10421 |
double precision recip_dyu(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
10422 |
double precision recip_h(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
10423 |
double precision recip_hfacc(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx, |
10424 |
$nsy) |
10425 |
double precision recip_hfacs(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx, |
10426 |
$nsy) |
10427 |
double precision recip_hfacw(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx, |
10428 |
$nsy) |
10429 |
double precision recip_ra(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
10430 |
double precision recip_ras(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
10431 |
double precision recip_raw(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
10432 |
double precision recip_raz(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
10433 |
double precision recip_rkfac |
10434 |
double precision rf(1:nr+1) |
10435 |
double precision rkfac |
10436 |
double precision safac(1:nr) |
10437 |
double precision tanphiatu(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
10438 |
double precision tanphiatv(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
10439 |
double precision xc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
10440 |
double precision xc0 |
10441 |
double precision xg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
10442 |
double precision yc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
10443 |
double precision yc0 |
10444 |
double precision yg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
10445 |
|
10446 |
common /parm_a/ heatcapacity_cp, recip_cp, lamba_theta |
10447 |
double precision heatcapacity_cp |
10448 |
double precision lamba_theta |
10449 |
double precision recip_cp |
10450 |
|
10451 |
common /parm_r/ cg2dtargetresidual, cg2dpcoffdfac, |
10452 |
$cg3dtargetresidual, delp, delz, delr, delx, dely, deltat, |
10453 |
$deltatmom, deltattracer, deltatclock, abeps, starttime, phimin, |
10454 |
$thetamin, rsphere, recip_rsphere, f0, fcori, beta, viscah, viscaz, |
10455 |
$ visca4, viscar, diffkht, diffkzt, diffk4t, diffkrt, diffkhs, |
10456 |
$diffkzs, diffk4s, diffkrs, delt, taucd, rcd, freesurffac, |
10457 |
$implicsurfpress, implicdiv2dflow, hfacmin, hfacmindz, gravity, |
10458 |
$recip_gravity, gbaro, rhonil, recip_rhonil, recip_rhoconst, |
10459 |
$rhoconst, tref, sref, endtime, chkptfreq, pchkptfreq, dumpfreq, |
10460 |
$tavefreq, affacmom, vffacmom, pffacmom, cffacmom, fofacmom, |
10461 |
$mtfacmom, cospower, cadjfreq, omega, tauthetaclimrelax, |
10462 |
$lambdathetaclimrelax, tausaltclimrelax, lambdasaltclimrelax, |
10463 |
$externforcingcycle, externforcingperiod, viscap, diffkpt, diffkps, |
10464 |
$ hfacmindr, hfacmindp, theta_s, specvol_s, horivertratio, |
10465 |
$recip_horivertratio, latfftfiltlo, ivdc_kappa, ro_sealevel, |
10466 |
$zonal_filt_lat, bottomdraglinear, bottomdragquadratic |
10467 |
double precision abeps |
10468 |
double precision affacmom |
10469 |
double precision beta |
10470 |
double precision bottomdraglinear |
10471 |
double precision bottomdragquadratic |
10472 |
double precision cadjfreq |
10473 |
double precision cffacmom |
10474 |
double precision cg2dpcoffdfac |
10475 |
double precision cg2dtargetresidual |
10476 |
double precision cg3dtargetresidual |
10477 |
double precision chkptfreq |
10478 |
double precision cospower |
10479 |
double precision delp(nr) |
10480 |
double precision delr(nr) |
10481 |
double precision delt |
10482 |
double precision deltat |
10483 |
double precision deltatclock |
10484 |
double precision deltatmom |
10485 |
double precision deltattracer |
10486 |
double precision delx(nx) |
10487 |
double precision dely(ny) |
10488 |
double precision delz(nr) |
10489 |
double precision diffk4s |
10490 |
double precision diffk4t |
10491 |
double precision diffkhs |
10492 |
double precision diffkht |
10493 |
double precision diffkps |
10494 |
double precision diffkpt |
10495 |
double precision diffkrs |
10496 |
double precision diffkrt |
10497 |
double precision diffkzs |
10498 |
double precision diffkzt |
10499 |
double precision dumpfreq |
10500 |
double precision endtime |
10501 |
double precision externforcingcycle |
10502 |
double precision externforcingperiod |
10503 |
double precision f0 |
10504 |
double precision fcori(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
10505 |
double precision fofacmom |
10506 |
double precision freesurffac |
10507 |
double precision gbaro |
10508 |
double precision gravity |
10509 |
double precision hfacmin |
10510 |
double precision hfacmindp |
10511 |
double precision hfacmindr |
10512 |
double precision hfacmindz |
10513 |
double precision horivertratio |
10514 |
double precision implicdiv2dflow |
10515 |
double precision implicsurfpress |
10516 |
double precision ivdc_kappa |
10517 |
double precision lambdasaltclimrelax |
10518 |
double precision lambdathetaclimrelax |
10519 |
double precision latfftfiltlo |
10520 |
double precision mtfacmom |
10521 |
double precision omega |
10522 |
double precision pchkptfreq |
10523 |
double precision pffacmom |
10524 |
double precision phimin |
10525 |
double precision rcd |
10526 |
double precision recip_gravity |
10527 |
double precision recip_horivertratio |
10528 |
double precision recip_rhoconst |
10529 |
double precision recip_rhonil |
10530 |
double precision recip_rsphere |
10531 |
double precision rhoconst |
10532 |
double precision rhonil |
10533 |
double precision ro_sealevel |
10534 |
double precision rsphere |
10535 |
double precision specvol_s(nr) |
10536 |
double precision sref(nr) |
10537 |
double precision starttime |
10538 |
double precision taucd |
10539 |
double precision tausaltclimrelax |
10540 |
double precision tauthetaclimrelax |
10541 |
double precision tavefreq |
10542 |
double precision theta_s(nr) |
10543 |
double precision thetamin |
10544 |
double precision tref(nr) |
10545 |
double precision vffacmom |
10546 |
double precision visca4 |
10547 |
double precision viscah |
10548 |
double precision viscap |
10549 |
double precision viscar |
10550 |
double precision viscaz |
10551 |
double precision zonal_filt_lat |
10552 |
|
10553 |
C============================================== |
10554 |
C define arguments |
10555 |
C============================================== |
10556 |
integer bi |
10557 |
integer bj |
10558 |
integer imax |
10559 |
integer imin |
10560 |
integer jmax |
10561 |
integer jmin |
10562 |
|
10563 |
C============================================== |
10564 |
C define local variables |
10565 |
C============================================== |
10566 |
integer i |
10567 |
integer j |
10568 |
|
10569 |
C---------------------------------------------- |
10570 |
C ROUTINE BODY |
10571 |
C---------------------------------------------- |
10572 |
do j = jmin, jmax |
10573 |
do i = imin, imax |
10574 |
adempmr(i,j,bi,bj) = adempmr(i,j,bi,bj)+35.* |
10575 |
$adsurfacetendencys(i,j,bi,bj)*recip_drf(1) |
10576 |
adsalt(i,j,1,bi,bj) = adsalt(i,j,1,bi,bj)- |
10577 |
$adsurfacetendencys(i,j,bi,bj)*lambdasaltclimrelax |
10578 |
adsurfacetendencys(i,j,bi,bj) = 0.d0 |
10579 |
adqnet(i,j,bi,bj) = adqnet(i,j,bi,bj)-adsurfacetendencyt(i,j, |
10580 |
$bi,bj)*recip_cp*recip_rhonil*recip_drf(1) |
10581 |
adtheta(i,j,1,bi,bj) = adtheta(i,j,1,bi,bj)- |
10582 |
$adsurfacetendencyt(i,j,bi,bj)*lambdathetaclimrelax |
10583 |
adsurfacetendencyt(i,j,bi,bj) = 0.d0 |
10584 |
adfv(i,j,bi,bj) = adfv(i,j,bi,bj)+adsurfacetendencyv(i,j,bi, |
10585 |
$bj)*horivertratio*recip_rhonil*recip_drf(1) |
10586 |
adsurfacetendencyv(i,j,bi,bj) = 0.d0 |
10587 |
adfu(i,j,bi,bj) = adfu(i,j,bi,bj)+adsurfacetendencyu(i,j,bi, |
10588 |
$bj)*horivertratio*recip_rhonil*recip_drf(1) |
10589 |
adsurfacetendencyu(i,j,bi,bj) = 0.d0 |
10590 |
end do |
10591 |
end do |
10592 |
|
10593 |
end |
10594 |
|
10595 |
|
10596 |
subroutine adexternal_forcing_t( imin, imax, jmin, jmax, bi, bj, |
10597 |
$klev, maskc ) |
10598 |
C*************************************************************** |
10599 |
C*************************************************************** |
10600 |
C** This routine was generated by the ** |
10601 |
C** Tangent linear and Adjoint Model Compiler, TAMC 5.2.14 ** |
10602 |
C*************************************************************** |
10603 |
C*************************************************************** |
10604 |
C============================================== |
10605 |
C all entries are defined explicitly |
10606 |
C============================================== |
10607 |
implicit none |
10608 |
|
10609 |
C============================================== |
10610 |
C define parameters |
10611 |
C============================================== |
10612 |
integer nr |
10613 |
parameter ( nr = 15 ) |
10614 |
integer nsx |
10615 |
parameter ( nsx = 1 ) |
10616 |
integer nsy |
10617 |
parameter ( nsy = 1 ) |
10618 |
integer olx |
10619 |
parameter ( olx = 3 ) |
10620 |
integer oly |
10621 |
parameter ( oly = 3 ) |
10622 |
integer snx |
10623 |
parameter ( snx = 20 ) |
10624 |
integer sny |
10625 |
parameter ( sny = 40 ) |
10626 |
|
10627 |
C============================================== |
10628 |
C define common blocks |
10629 |
C============================================== |
10630 |
common /addynvars_r/ adetan, aduvel, advvel, adwvel, adtheta, |
10631 |
$adsalt, adgu, adgv, adgt, adgs, adgunm1, adgvnm1, adgtnm1, adgsnm1 |
10632 |
double precision adetan(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
10633 |
double precision adgs(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
10634 |
double precision adgsnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
10635 |
double precision adgt(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
10636 |
double precision adgtnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
10637 |
double precision adgu(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
10638 |
double precision adgunm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
10639 |
double precision adgv(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
10640 |
double precision adgvnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
10641 |
double precision adsalt(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
10642 |
double precision adtheta(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
10643 |
double precision aduvel(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
10644 |
double precision advvel(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
10645 |
double precision adwvel(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
10646 |
|
10647 |
common /adtendency_forcing/ adsurfacetendencyu, |
10648 |
$adsurfacetendencyv, adsurfacetendencyt, adsurfacetendencys |
10649 |
double precision adsurfacetendencys(1-olx:snx+olx,1-oly:sny+oly, |
10650 |
$nsx,nsy) |
10651 |
double precision adsurfacetendencyt(1-olx:snx+olx,1-oly:sny+oly, |
10652 |
$nsx,nsy) |
10653 |
double precision adsurfacetendencyu(1-olx:snx+olx,1-oly:sny+oly, |
10654 |
$nsx,nsy) |
10655 |
double precision adsurfacetendencyv(1-olx:snx+olx,1-oly:sny+oly, |
10656 |
$nsx,nsy) |
10657 |
|
10658 |
C============================================== |
10659 |
C define arguments |
10660 |
C============================================== |
10661 |
integer bi |
10662 |
integer bj |
10663 |
integer imax |
10664 |
integer imin |
10665 |
integer jmax |
10666 |
integer jmin |
10667 |
integer klev |
10668 |
double precision maskc(1-olx:snx+olx,1-oly:sny+oly) |
10669 |
|
10670 |
C============================================== |
10671 |
C define local variables |
10672 |
C============================================== |
10673 |
integer i |
10674 |
integer j |
10675 |
|
10676 |
C---------------------------------------------- |
10677 |
C ROUTINE BODY |
10678 |
C---------------------------------------------- |
10679 |
if (klev .eq. 1) then |
10680 |
do j = jmin, jmax |
10681 |
do i = imin, imax |
10682 |
adsurfacetendencyt(i,j,bi,bj) = adsurfacetendencyt(i,j,bi, |
10683 |
$bj)+adgt(i,j,klev,bi,bj)*maskc(i,j) |
10684 |
end do |
10685 |
end do |
10686 |
endif |
10687 |
|
10688 |
end |
10689 |
|
10690 |
|
10691 |
subroutine adexternal_forcing_u( imin, imax, jmin, jmax, bi, bj, |
10692 |
$klev ) |
10693 |
C*************************************************************** |
10694 |
C*************************************************************** |
10695 |
C** This routine was generated by the ** |
10696 |
C** Tangent linear and Adjoint Model Compiler, TAMC 5.2.14 ** |
10697 |
C*************************************************************** |
10698 |
C*************************************************************** |
10699 |
C============================================== |
10700 |
C all entries are defined explicitly |
10701 |
C============================================== |
10702 |
implicit none |
10703 |
|
10704 |
C============================================== |
10705 |
C define parameters |
10706 |
C============================================== |
10707 |
integer npx |
10708 |
parameter ( npx = 1 ) |
10709 |
integer npy |
10710 |
parameter ( npy = 1 ) |
10711 |
integer nr |
10712 |
parameter ( nr = 15 ) |
10713 |
integer nsx |
10714 |
parameter ( nsx = 1 ) |
10715 |
integer nsy |
10716 |
parameter ( nsy = 1 ) |
10717 |
integer snx |
10718 |
parameter ( snx = 20 ) |
10719 |
integer nx |
10720 |
parameter ( nx = snx*nsx*npx ) |
10721 |
integer sny |
10722 |
parameter ( sny = 40 ) |
10723 |
integer ny |
10724 |
parameter ( ny = sny*nsy*npy ) |
10725 |
integer olx |
10726 |
parameter ( olx = 3 ) |
10727 |
integer oly |
10728 |
parameter ( oly = 3 ) |
10729 |
|
10730 |
C============================================== |
10731 |
C define common blocks |
10732 |
C============================================== |
10733 |
common /addynvars_r/ adetan, aduvel, advvel, adwvel, adtheta, |
10734 |
$adsalt, adgu, adgv, adgt, adgs, adgunm1, adgvnm1, adgtnm1, adgsnm1 |
10735 |
double precision adetan(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
10736 |
double precision adgs(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
10737 |
double precision adgsnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
10738 |
double precision adgt(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
10739 |
double precision adgtnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
10740 |
double precision adgu(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
10741 |
double precision adgunm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
10742 |
double precision adgv(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
10743 |
double precision adgvnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
10744 |
double precision adsalt(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
10745 |
double precision adtheta(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
10746 |
double precision aduvel(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
10747 |
double precision advvel(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
10748 |
double precision adwvel(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
10749 |
|
10750 |
common /adtendency_forcing/ adsurfacetendencyu, |
10751 |
$adsurfacetendencyv, adsurfacetendencyt, adsurfacetendencys |
10752 |
double precision adsurfacetendencys(1-olx:snx+olx,1-oly:sny+oly, |
10753 |
$nsx,nsy) |
10754 |
double precision adsurfacetendencyt(1-olx:snx+olx,1-oly:sny+oly, |
10755 |
$nsx,nsy) |
10756 |
double precision adsurfacetendencyu(1-olx:snx+olx,1-oly:sny+oly, |
10757 |
$nsx,nsy) |
10758 |
double precision adsurfacetendencyv(1-olx:snx+olx,1-oly:sny+oly, |
10759 |
$nsx,nsy) |
10760 |
|
10761 |
common /grid_r/ dxc, dxf, dxg, dxv, dyc, dyf, dyg, dyu, drc, drf, |
10762 |
$h, hfacc, hfacw, hfacs, depthink, recip_dxc, recip_dxf, recip_dxg, |
10763 |
$ recip_dxv, recip_dyc, recip_dyf, recip_dyg, recip_dyu, recip_drc, |
10764 |
$ recip_drf, recip_h, recip_hfacc, recip_hfacw, recip_hfacs, rkfac, |
10765 |
$ recip_rkfac, safac, xc, yc, ra, raw, ras, raz, rc, rf, yc0, xc0, |
10766 |
$xg, yg, maskw, masks, recip_ra, recip_raw, recip_ras, recip_raz, |
10767 |
$tanphiatu, tanphiatv |
10768 |
double precision depthink(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
10769 |
double precision drc(1:nr) |
10770 |
double precision drf(1:nr) |
10771 |
double precision dxc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
10772 |
double precision dxf(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
10773 |
double precision dxg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
10774 |
double precision dxv(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
10775 |
double precision dyc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
10776 |
double precision dyf(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
10777 |
double precision dyg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
10778 |
double precision dyu(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
10779 |
double precision h(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
10780 |
double precision hfacc(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) |
10781 |
double precision hfacs(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) |
10782 |
double precision hfacw(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) |
10783 |
double precision masks(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) |
10784 |
double precision maskw(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) |
10785 |
double precision ra(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
10786 |
double precision ras(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
10787 |
double precision raw(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
10788 |
double precision raz(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
10789 |
double precision rc(1:nr) |
10790 |
double precision recip_drc(1:nr) |
10791 |
double precision recip_drf(1:nr) |
10792 |
double precision recip_dxc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
10793 |
double precision recip_dxf(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
10794 |
double precision recip_dxg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
10795 |
double precision recip_dxv(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
10796 |
double precision recip_dyc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
10797 |
double precision recip_dyf(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
10798 |
double precision recip_dyg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
10799 |
double precision recip_dyu(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
10800 |
double precision recip_h(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
10801 |
double precision recip_hfacc(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx, |
10802 |
$nsy) |
10803 |
double precision recip_hfacs(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx, |
10804 |
$nsy) |
10805 |
double precision recip_hfacw(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx, |
10806 |
$nsy) |
10807 |
double precision recip_ra(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
10808 |
double precision recip_ras(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
10809 |
double precision recip_raw(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
10810 |
double precision recip_raz(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
10811 |
double precision recip_rkfac |
10812 |
double precision rf(1:nr+1) |
10813 |
double precision rkfac |
10814 |
double precision safac(1:nr) |
10815 |
double precision tanphiatu(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
10816 |
double precision tanphiatv(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
10817 |
double precision xc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
10818 |
double precision xc0 |
10819 |
double precision xg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
10820 |
double precision yc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
10821 |
double precision yc0 |
10822 |
double precision yg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
10823 |
|
10824 |
common /parm_r/ cg2dtargetresidual, cg2dpcoffdfac, |
10825 |
$cg3dtargetresidual, delp, delz, delr, delx, dely, deltat, |
10826 |
$deltatmom, deltattracer, deltatclock, abeps, starttime, phimin, |
10827 |
$thetamin, rsphere, recip_rsphere, f0, fcori, beta, viscah, viscaz, |
10828 |
$ visca4, viscar, diffkht, diffkzt, diffk4t, diffkrt, diffkhs, |
10829 |
$diffkzs, diffk4s, diffkrs, delt, taucd, rcd, freesurffac, |
10830 |
$implicsurfpress, implicdiv2dflow, hfacmin, hfacmindz, gravity, |
10831 |
$recip_gravity, gbaro, rhonil, recip_rhonil, recip_rhoconst, |
10832 |
$rhoconst, tref, sref, endtime, chkptfreq, pchkptfreq, dumpfreq, |
10833 |
$tavefreq, affacmom, vffacmom, pffacmom, cffacmom, fofacmom, |
10834 |
$mtfacmom, cospower, cadjfreq, omega, tauthetaclimrelax, |
10835 |
$lambdathetaclimrelax, tausaltclimrelax, lambdasaltclimrelax, |
10836 |
$externforcingcycle, externforcingperiod, viscap, diffkpt, diffkps, |
10837 |
$ hfacmindr, hfacmindp, theta_s, specvol_s, horivertratio, |
10838 |
$recip_horivertratio, latfftfiltlo, ivdc_kappa, ro_sealevel, |
10839 |
$zonal_filt_lat, bottomdraglinear, bottomdragquadratic |
10840 |
double precision abeps |
10841 |
double precision affacmom |
10842 |
double precision beta |
10843 |
double precision bottomdraglinear |
10844 |
double precision bottomdragquadratic |
10845 |
double precision cadjfreq |
10846 |
double precision cffacmom |
10847 |
double precision cg2dpcoffdfac |
10848 |
double precision cg2dtargetresidual |
10849 |
double precision cg3dtargetresidual |
10850 |
double precision chkptfreq |
10851 |
double precision cospower |
10852 |
double precision delp(nr) |
10853 |
double precision delr(nr) |
10854 |
double precision delt |
10855 |
double precision deltat |
10856 |
double precision deltatclock |
10857 |
double precision deltatmom |
10858 |
double precision deltattracer |
10859 |
double precision delx(nx) |
10860 |
double precision dely(ny) |
10861 |
double precision delz(nr) |
10862 |
double precision diffk4s |
10863 |
double precision diffk4t |
10864 |
double precision diffkhs |
10865 |
double precision diffkht |
10866 |
double precision diffkps |
10867 |
double precision diffkpt |
10868 |
double precision diffkrs |
10869 |
double precision diffkrt |
10870 |
double precision diffkzs |
10871 |
double precision diffkzt |
10872 |
double precision dumpfreq |
10873 |
double precision endtime |
10874 |
double precision externforcingcycle |
10875 |
double precision externforcingperiod |
10876 |
double precision f0 |
10877 |
double precision fcori(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
10878 |
double precision fofacmom |
10879 |
double precision freesurffac |
10880 |
double precision gbaro |
10881 |
double precision gravity |
10882 |
double precision hfacmin |
10883 |
double precision hfacmindp |
10884 |
double precision hfacmindr |
10885 |
double precision hfacmindz |
10886 |
double precision horivertratio |
10887 |
double precision implicdiv2dflow |
10888 |
double precision implicsurfpress |
10889 |
double precision ivdc_kappa |
10890 |
double precision lambdasaltclimrelax |
10891 |
double precision lambdathetaclimrelax |
10892 |
double precision latfftfiltlo |
10893 |
double precision mtfacmom |
10894 |
double precision omega |
10895 |
double precision pchkptfreq |
10896 |
double precision pffacmom |
10897 |
double precision phimin |
10898 |
double precision rcd |
10899 |
double precision recip_gravity |
10900 |
double precision recip_horivertratio |
10901 |
double precision recip_rhoconst |
10902 |
double precision recip_rhonil |
10903 |
double precision recip_rsphere |
10904 |
double precision rhoconst |
10905 |
double precision rhonil |
10906 |
double precision ro_sealevel |
10907 |
double precision rsphere |
10908 |
double precision specvol_s(nr) |
10909 |
double precision sref(nr) |
10910 |
double precision starttime |
10911 |
double precision taucd |
10912 |
double precision tausaltclimrelax |
10913 |
double precision tauthetaclimrelax |
10914 |
double precision tavefreq |
10915 |
double precision theta_s(nr) |
10916 |
double precision thetamin |
10917 |
double precision tref(nr) |
10918 |
double precision vffacmom |
10919 |
double precision visca4 |
10920 |
double precision viscah |
10921 |
double precision viscap |
10922 |
double precision viscar |
10923 |
double precision viscaz |
10924 |
double precision zonal_filt_lat |
10925 |
|
10926 |
C============================================== |
10927 |
C define arguments |
10928 |
C============================================== |
10929 |
integer bi |
10930 |
integer bj |
10931 |
integer imax |
10932 |
integer imin |
10933 |
integer jmax |
10934 |
integer jmin |
10935 |
integer klev |
10936 |
|
10937 |
C============================================== |
10938 |
C define local variables |
10939 |
C============================================== |
10940 |
integer i |
10941 |
integer j |
10942 |
|
10943 |
C---------------------------------------------- |
10944 |
C ROUTINE BODY |
10945 |
C---------------------------------------------- |
10946 |
if (klev .eq. 1) then |
10947 |
do j = jmin, jmax |
10948 |
do i = imin, imax |
10949 |
adsurfacetendencyu(i,j,bi,bj) = adsurfacetendencyu(i,j,bi, |
10950 |
$bj)+adgu(i,j,klev,bi,bj)*fofacmom*maskw(i,j,klev,bi,bj) |
10951 |
end do |
10952 |
end do |
10953 |
endif |
10954 |
|
10955 |
end |
10956 |
|
10957 |
|
10958 |
subroutine adexternal_forcing_v( imin, imax, jmin, jmax, bi, bj, |
10959 |
$klev ) |
10960 |
C*************************************************************** |
10961 |
C*************************************************************** |
10962 |
C** This routine was generated by the ** |
10963 |
C** Tangent linear and Adjoint Model Compiler, TAMC 5.2.14 ** |
10964 |
C*************************************************************** |
10965 |
C*************************************************************** |
10966 |
C============================================== |
10967 |
C all entries are defined explicitly |
10968 |
C============================================== |
10969 |
implicit none |
10970 |
|
10971 |
C============================================== |
10972 |
C define parameters |
10973 |
C============================================== |
10974 |
integer npx |
10975 |
parameter ( npx = 1 ) |
10976 |
integer npy |
10977 |
parameter ( npy = 1 ) |
10978 |
integer nr |
10979 |
parameter ( nr = 15 ) |
10980 |
integer nsx |
10981 |
parameter ( nsx = 1 ) |
10982 |
integer nsy |
10983 |
parameter ( nsy = 1 ) |
10984 |
integer snx |
10985 |
parameter ( snx = 20 ) |
10986 |
integer nx |
10987 |
parameter ( nx = snx*nsx*npx ) |
10988 |
integer sny |
10989 |
parameter ( sny = 40 ) |
10990 |
integer ny |
10991 |
parameter ( ny = sny*nsy*npy ) |
10992 |
integer olx |
10993 |
parameter ( olx = 3 ) |
10994 |
integer oly |
10995 |
parameter ( oly = 3 ) |
10996 |
|
10997 |
C============================================== |
10998 |
C define common blocks |
10999 |
C============================================== |
11000 |
common /addynvars_r/ adetan, aduvel, advvel, adwvel, adtheta, |
11001 |
$adsalt, adgu, adgv, adgt, adgs, adgunm1, adgvnm1, adgtnm1, adgsnm1 |
11002 |
double precision adetan(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
11003 |
double precision adgs(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
11004 |
double precision adgsnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
11005 |
double precision adgt(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
11006 |
double precision adgtnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
11007 |
double precision adgu(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
11008 |
double precision adgunm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
11009 |
double precision adgv(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
11010 |
double precision adgvnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
11011 |
double precision adsalt(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
11012 |
double precision adtheta(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
11013 |
double precision aduvel(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
11014 |
double precision advvel(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
11015 |
double precision adwvel(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
11016 |
|
11017 |
common /adtendency_forcing/ adsurfacetendencyu, |
11018 |
$adsurfacetendencyv, adsurfacetendencyt, adsurfacetendencys |
11019 |
double precision adsurfacetendencys(1-olx:snx+olx,1-oly:sny+oly, |
11020 |
$nsx,nsy) |
11021 |
double precision adsurfacetendencyt(1-olx:snx+olx,1-oly:sny+oly, |
11022 |
$nsx,nsy) |
11023 |
double precision adsurfacetendencyu(1-olx:snx+olx,1-oly:sny+oly, |
11024 |
$nsx,nsy) |
11025 |
double precision adsurfacetendencyv(1-olx:snx+olx,1-oly:sny+oly, |
11026 |
$nsx,nsy) |
11027 |
|
11028 |
common /grid_r/ dxc, dxf, dxg, dxv, dyc, dyf, dyg, dyu, drc, drf, |
11029 |
$h, hfacc, hfacw, hfacs, depthink, recip_dxc, recip_dxf, recip_dxg, |
11030 |
$ recip_dxv, recip_dyc, recip_dyf, recip_dyg, recip_dyu, recip_drc, |
11031 |
$ recip_drf, recip_h, recip_hfacc, recip_hfacw, recip_hfacs, rkfac, |
11032 |
$ recip_rkfac, safac, xc, yc, ra, raw, ras, raz, rc, rf, yc0, xc0, |
11033 |
$xg, yg, maskw, masks, recip_ra, recip_raw, recip_ras, recip_raz, |
11034 |
$tanphiatu, tanphiatv |
11035 |
double precision depthink(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
11036 |
double precision drc(1:nr) |
11037 |
double precision drf(1:nr) |
11038 |
double precision dxc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
11039 |
double precision dxf(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
11040 |
double precision dxg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
11041 |
double precision dxv(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
11042 |
double precision dyc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
11043 |
double precision dyf(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
11044 |
double precision dyg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
11045 |
double precision dyu(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
11046 |
double precision h(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
11047 |
double precision hfacc(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) |
11048 |
double precision hfacs(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) |
11049 |
double precision hfacw(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) |
11050 |
double precision masks(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) |
11051 |
double precision maskw(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) |
11052 |
double precision ra(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
11053 |
double precision ras(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
11054 |
double precision raw(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
11055 |
double precision raz(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
11056 |
double precision rc(1:nr) |
11057 |
double precision recip_drc(1:nr) |
11058 |
double precision recip_drf(1:nr) |
11059 |
double precision recip_dxc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
11060 |
double precision recip_dxf(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
11061 |
double precision recip_dxg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
11062 |
double precision recip_dxv(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
11063 |
double precision recip_dyc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
11064 |
double precision recip_dyf(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
11065 |
double precision recip_dyg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
11066 |
double precision recip_dyu(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
11067 |
double precision recip_h(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
11068 |
double precision recip_hfacc(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx, |
11069 |
$nsy) |
11070 |
double precision recip_hfacs(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx, |
11071 |
$nsy) |
11072 |
double precision recip_hfacw(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx, |
11073 |
$nsy) |
11074 |
double precision recip_ra(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
11075 |
double precision recip_ras(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
11076 |
double precision recip_raw(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
11077 |
double precision recip_raz(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
11078 |
double precision recip_rkfac |
11079 |
double precision rf(1:nr+1) |
11080 |
double precision rkfac |
11081 |
double precision safac(1:nr) |
11082 |
double precision tanphiatu(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
11083 |
double precision tanphiatv(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
11084 |
double precision xc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
11085 |
double precision xc0 |
11086 |
double precision xg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
11087 |
double precision yc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
11088 |
double precision yc0 |
11089 |
double precision yg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
11090 |
|
11091 |
common /parm_r/ cg2dtargetresidual, cg2dpcoffdfac, |
11092 |
$cg3dtargetresidual, delp, delz, delr, delx, dely, deltat, |
11093 |
$deltatmom, deltattracer, deltatclock, abeps, starttime, phimin, |
11094 |
$thetamin, rsphere, recip_rsphere, f0, fcori, beta, viscah, viscaz, |
11095 |
$ visca4, viscar, diffkht, diffkzt, diffk4t, diffkrt, diffkhs, |
11096 |
$diffkzs, diffk4s, diffkrs, delt, taucd, rcd, freesurffac, |
11097 |
$implicsurfpress, implicdiv2dflow, hfacmin, hfacmindz, gravity, |
11098 |
$recip_gravity, gbaro, rhonil, recip_rhonil, recip_rhoconst, |
11099 |
$rhoconst, tref, sref, endtime, chkptfreq, pchkptfreq, dumpfreq, |
11100 |
$tavefreq, affacmom, vffacmom, pffacmom, cffacmom, fofacmom, |
11101 |
$mtfacmom, cospower, cadjfreq, omega, tauthetaclimrelax, |
11102 |
$lambdathetaclimrelax, tausaltclimrelax, lambdasaltclimrelax, |
11103 |
$externforcingcycle, externforcingperiod, viscap, diffkpt, diffkps, |
11104 |
$ hfacmindr, hfacmindp, theta_s, specvol_s, horivertratio, |
11105 |
$recip_horivertratio, latfftfiltlo, ivdc_kappa, ro_sealevel, |
11106 |
$zonal_filt_lat, bottomdraglinear, bottomdragquadratic |
11107 |
double precision abeps |
11108 |
double precision affacmom |
11109 |
double precision beta |
11110 |
double precision bottomdraglinear |
11111 |
double precision bottomdragquadratic |
11112 |
double precision cadjfreq |
11113 |
double precision cffacmom |
11114 |
double precision cg2dpcoffdfac |
11115 |
double precision cg2dtargetresidual |
11116 |
double precision cg3dtargetresidual |
11117 |
double precision chkptfreq |
11118 |
double precision cospower |
11119 |
double precision delp(nr) |
11120 |
double precision delr(nr) |
11121 |
double precision delt |
11122 |
double precision deltat |
11123 |
double precision deltatclock |
11124 |
double precision deltatmom |
11125 |
double precision deltattracer |
11126 |
double precision delx(nx) |
11127 |
double precision dely(ny) |
11128 |
double precision delz(nr) |
11129 |
double precision diffk4s |
11130 |
double precision diffk4t |
11131 |
double precision diffkhs |
11132 |
double precision diffkht |
11133 |
double precision diffkps |
11134 |
double precision diffkpt |
11135 |
double precision diffkrs |
11136 |
double precision diffkrt |
11137 |
double precision diffkzs |
11138 |
double precision diffkzt |
11139 |
double precision dumpfreq |
11140 |
double precision endtime |
11141 |
double precision externforcingcycle |
11142 |
double precision externforcingperiod |
11143 |
double precision f0 |
11144 |
double precision fcori(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
11145 |
double precision fofacmom |
11146 |
double precision freesurffac |
11147 |
double precision gbaro |
11148 |
double precision gravity |
11149 |
double precision hfacmin |
11150 |
double precision hfacmindp |
11151 |
double precision hfacmindr |
11152 |
double precision hfacmindz |
11153 |
double precision horivertratio |
11154 |
double precision implicdiv2dflow |
11155 |
double precision implicsurfpress |
11156 |
double precision ivdc_kappa |
11157 |
double precision lambdasaltclimrelax |
11158 |
double precision lambdathetaclimrelax |
11159 |
double precision latfftfiltlo |
11160 |
double precision mtfacmom |
11161 |
double precision omega |
11162 |
double precision pchkptfreq |
11163 |
double precision pffacmom |
11164 |
double precision phimin |
11165 |
double precision rcd |
11166 |
double precision recip_gravity |
11167 |
double precision recip_horivertratio |
11168 |
double precision recip_rhoconst |
11169 |
double precision recip_rhonil |
11170 |
double precision recip_rsphere |
11171 |
double precision rhoconst |
11172 |
double precision rhonil |
11173 |
double precision ro_sealevel |
11174 |
double precision rsphere |
11175 |
double precision specvol_s(nr) |
11176 |
double precision sref(nr) |
11177 |
double precision starttime |
11178 |
double precision taucd |
11179 |
double precision tausaltclimrelax |
11180 |
double precision tauthetaclimrelax |
11181 |
double precision tavefreq |
11182 |
double precision theta_s(nr) |
11183 |
double precision thetamin |
11184 |
double precision tref(nr) |
11185 |
double precision vffacmom |
11186 |
double precision visca4 |
11187 |
double precision viscah |
11188 |
double precision viscap |
11189 |
double precision viscar |
11190 |
double precision viscaz |
11191 |
double precision zonal_filt_lat |
11192 |
|
11193 |
C============================================== |
11194 |
C define arguments |
11195 |
C============================================== |
11196 |
integer bi |
11197 |
integer bj |
11198 |
integer imax |
11199 |
integer imin |
11200 |
integer jmax |
11201 |
integer jmin |
11202 |
integer klev |
11203 |
|
11204 |
C============================================== |
11205 |
C define local variables |
11206 |
C============================================== |
11207 |
integer i |
11208 |
integer j |
11209 |
|
11210 |
C---------------------------------------------- |
11211 |
C ROUTINE BODY |
11212 |
C---------------------------------------------- |
11213 |
if (klev .eq. 1) then |
11214 |
do j = jmin, jmax |
11215 |
do i = imin, imax |
11216 |
adsurfacetendencyv(i,j,bi,bj) = adsurfacetendencyv(i,j,bi, |
11217 |
$bj)+adgv(i,j,klev,bi,bj)*fofacmom*masks(i,j,klev,bi,bj) |
11218 |
end do |
11219 |
end do |
11220 |
endif |
11221 |
|
11222 |
end |
11223 |
|
11224 |
|
11225 |
subroutine adfind_alpha( bi, bj, imin, imax, jmin, jmax, k, kref, |
11226 |
$eqn, adalphaloc ) |
11227 |
C*************************************************************** |
11228 |
C*************************************************************** |
11229 |
C** This routine was generated by the ** |
11230 |
C** Tangent linear and Adjoint Model Compiler, TAMC 5.2.14 ** |
11231 |
C*************************************************************** |
11232 |
C*************************************************************** |
11233 |
C============================================== |
11234 |
C all entries are defined explicitly |
11235 |
C============================================== |
11236 |
implicit none |
11237 |
|
11238 |
C============================================== |
11239 |
C define parameters |
11240 |
C============================================== |
11241 |
integer nr |
11242 |
parameter ( nr = 15 ) |
11243 |
integer nsx |
11244 |
parameter ( nsx = 1 ) |
11245 |
integer nsy |
11246 |
parameter ( nsy = 1 ) |
11247 |
integer olx |
11248 |
parameter ( olx = 3 ) |
11249 |
integer oly |
11250 |
parameter ( oly = 3 ) |
11251 |
integer snx |
11252 |
parameter ( snx = 20 ) |
11253 |
integer sny |
11254 |
parameter ( sny = 40 ) |
11255 |
|
11256 |
C============================================== |
11257 |
C define common blocks |
11258 |
C============================================== |
11259 |
common /addynvars_r/ adetan, aduvel, advvel, adwvel, adtheta, |
11260 |
$adsalt, adgu, adgv, adgt, adgs, adgunm1, adgvnm1, adgtnm1, adgsnm1 |
11261 |
double precision adetan(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
11262 |
double precision adgs(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
11263 |
double precision adgsnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
11264 |
double precision adgt(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
11265 |
double precision adgtnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
11266 |
double precision adgu(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
11267 |
double precision adgunm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
11268 |
double precision adgv(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
11269 |
double precision adgvnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
11270 |
double precision adsalt(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
11271 |
double precision adtheta(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
11272 |
double precision aduvel(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
11273 |
double precision advvel(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
11274 |
double precision adwvel(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
11275 |
|
11276 |
common /dynvars_r/ etan, uvel, vvel, wvel, theta, salt, gu, gv, |
11277 |
$gt, gs, gunm1, gvnm1, gtnm1, gsnm1 |
11278 |
double precision etan(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
11279 |
double precision gs(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
11280 |
double precision gsnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
11281 |
double precision gt(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
11282 |
double precision gtnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
11283 |
double precision gu(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
11284 |
double precision gunm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
11285 |
double precision gv(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
11286 |
double precision gvnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
11287 |
double precision salt(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
11288 |
double precision theta(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
11289 |
double precision uvel(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
11290 |
double precision vvel(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
11291 |
double precision wvel(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
11292 |
|
11293 |
common /parm_eos_nl/ eosc, eossig0, eosreft, eosrefs |
11294 |
double precision eosc(9,nr+1) |
11295 |
double precision eosrefs(nr+1) |
11296 |
double precision eosreft(nr+1) |
11297 |
double precision eossig0(nr+1) |
11298 |
|
11299 |
C============================================== |
11300 |
C define arguments |
11301 |
C============================================== |
11302 |
double precision adalphaloc(1-olx:snx+olx,1-oly:sny+oly) |
11303 |
integer bi |
11304 |
integer bj |
11305 |
character*(*) eqn |
11306 |
integer imax |
11307 |
integer imin |
11308 |
integer jmax |
11309 |
integer jmin |
11310 |
integer k |
11311 |
integer kref |
11312 |
|
11313 |
C============================================== |
11314 |
C define local variables |
11315 |
C============================================== |
11316 |
double precision adsp |
11317 |
double precision adtp |
11318 |
integer i |
11319 |
integer j |
11320 |
double precision refsalt |
11321 |
double precision reftemp |
11322 |
double precision sp |
11323 |
double precision tp |
11324 |
|
11325 |
C---------------------------------------------- |
11326 |
C RESET LOCAL ADJOINT VARIABLES |
11327 |
C---------------------------------------------- |
11328 |
adsp = 0.d0 |
11329 |
adtp = 0.d0 |
11330 |
|
11331 |
C---------------------------------------------- |
11332 |
C ROUTINE BODY |
11333 |
C---------------------------------------------- |
11334 |
if (eqn .eq. 'LINEAR') then |
11335 |
do j = jmin, jmax |
11336 |
do i = imin, imax |
11337 |
adalphaloc(i,j) = 0.d0 |
11338 |
end do |
11339 |
end do |
11340 |
else if (eqn .eq. 'POLY3') then |
11341 |
reftemp = eosreft(kref) |
11342 |
refsalt = eosrefs(kref) |
11343 |
do j = jmin, jmax |
11344 |
adsp = 0.d0 |
11345 |
adtp = 0.d0 |
11346 |
do i = imin, imax |
11347 |
adsp = 0.d0 |
11348 |
adtp = 0.d0 |
11349 |
tp = theta(i,j,k,bi,bj)-reftemp |
11350 |
sp = salt(i,j,k,bi,bj)-refsalt |
11351 |
adsp = adsp+adalphaloc(i,j)*(2.*eosc(7,kref)*tp+eosc(8,kref) |
11352 |
$*sp+eosc(4,kref)+eosc(8,kref)*sp) |
11353 |
adtp = adtp+adalphaloc(i,j)*(3.*eosc(6,kref)*tp+2.*(eosc(7, |
11354 |
$kref)*sp+eosc(3,kref))+3.*eosc(6,kref)*tp) |
11355 |
adalphaloc(i,j) = 0.d0 |
11356 |
adsalt(i,j,k,bi,bj) = adsalt(i,j,k,bi,bj)+adsp |
11357 |
adsp = 0.d0 |
11358 |
adtheta(i,j,k,bi,bj) = adtheta(i,j,k,bi,bj)+adtp |
11359 |
adtp = 0.d0 |
11360 |
end do |
11361 |
end do |
11362 |
endif |
11363 |
|
11364 |
end |
11365 |
|
11366 |
|
11367 |
subroutine adfind_beta( bi, bj, imin, imax, jmin, jmax, k, kref, |
11368 |
$eqn, adbetaloc ) |
11369 |
C*************************************************************** |
11370 |
C*************************************************************** |
11371 |
C** This routine was generated by the ** |
11372 |
C** Tangent linear and Adjoint Model Compiler, TAMC 5.2.14 ** |
11373 |
C*************************************************************** |
11374 |
C*************************************************************** |
11375 |
C============================================== |
11376 |
C all entries are defined explicitly |
11377 |
C============================================== |
11378 |
implicit none |
11379 |
|
11380 |
C============================================== |
11381 |
C define parameters |
11382 |
C============================================== |
11383 |
integer nr |
11384 |
parameter ( nr = 15 ) |
11385 |
integer nsx |
11386 |
parameter ( nsx = 1 ) |
11387 |
integer nsy |
11388 |
parameter ( nsy = 1 ) |
11389 |
integer olx |
11390 |
parameter ( olx = 3 ) |
11391 |
integer oly |
11392 |
parameter ( oly = 3 ) |
11393 |
integer snx |
11394 |
parameter ( snx = 20 ) |
11395 |
integer sny |
11396 |
parameter ( sny = 40 ) |
11397 |
|
11398 |
C============================================== |
11399 |
C define common blocks |
11400 |
C============================================== |
11401 |
common /addynvars_r/ adetan, aduvel, advvel, adwvel, adtheta, |
11402 |
$adsalt, adgu, adgv, adgt, adgs, adgunm1, adgvnm1, adgtnm1, adgsnm1 |
11403 |
double precision adetan(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
11404 |
double precision adgs(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
11405 |
double precision adgsnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
11406 |
double precision adgt(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
11407 |
double precision adgtnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
11408 |
double precision adgu(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
11409 |
double precision adgunm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
11410 |
double precision adgv(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
11411 |
double precision adgvnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
11412 |
double precision adsalt(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
11413 |
double precision adtheta(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
11414 |
double precision aduvel(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
11415 |
double precision advvel(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
11416 |
double precision adwvel(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
11417 |
|
11418 |
common /dynvars_r/ etan, uvel, vvel, wvel, theta, salt, gu, gv, |
11419 |
$gt, gs, gunm1, gvnm1, gtnm1, gsnm1 |
11420 |
double precision etan(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
11421 |
double precision gs(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
11422 |
double precision gsnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
11423 |
double precision gt(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
11424 |
double precision gtnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
11425 |
double precision gu(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
11426 |
double precision gunm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
11427 |
double precision gv(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
11428 |
double precision gvnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
11429 |
double precision salt(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
11430 |
double precision theta(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
11431 |
double precision uvel(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
11432 |
double precision vvel(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
11433 |
double precision wvel(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
11434 |
|
11435 |
common /parm_eos_nl/ eosc, eossig0, eosreft, eosrefs |
11436 |
double precision eosc(9,nr+1) |
11437 |
double precision eosrefs(nr+1) |
11438 |
double precision eosreft(nr+1) |
11439 |
double precision eossig0(nr+1) |
11440 |
|
11441 |
C============================================== |
11442 |
C define arguments |
11443 |
C============================================== |
11444 |
double precision adbetaloc(1-olx:snx+olx,1-oly:sny+oly) |
11445 |
integer bi |
11446 |
integer bj |
11447 |
character*(*) eqn |
11448 |
integer imax |
11449 |
integer imin |
11450 |
integer jmax |
11451 |
integer jmin |
11452 |
integer k |
11453 |
integer kref |
11454 |
|
11455 |
C============================================== |
11456 |
C define local variables |
11457 |
C============================================== |
11458 |
double precision adsp |
11459 |
double precision adtp |
11460 |
integer i |
11461 |
integer j |
11462 |
double precision refsalt |
11463 |
double precision reftemp |
11464 |
double precision sp |
11465 |
double precision tp |
11466 |
|
11467 |
C---------------------------------------------- |
11468 |
C RESET LOCAL ADJOINT VARIABLES |
11469 |
C---------------------------------------------- |
11470 |
adsp = 0.d0 |
11471 |
adtp = 0.d0 |
11472 |
|
11473 |
C---------------------------------------------- |
11474 |
C ROUTINE BODY |
11475 |
C---------------------------------------------- |
11476 |
if (eqn .eq. 'LINEAR') then |
11477 |
do j = jmin, jmax |
11478 |
do i = imin, imax |
11479 |
adbetaloc(i,j) = 0.d0 |
11480 |
end do |
11481 |
end do |
11482 |
else if (eqn .eq. 'POLY3') then |
11483 |
reftemp = eosreft(kref) |
11484 |
refsalt = eosrefs(kref) |
11485 |
do j = jmin, jmax |
11486 |
adsp = 0.d0 |
11487 |
adtp = 0.d0 |
11488 |
do i = imin, imax |
11489 |
adsp = 0.d0 |
11490 |
adtp = 0.d0 |
11491 |
tp = theta(i,j,k,bi,bj)-reftemp |
11492 |
sp = salt(i,j,k,bi,bj)-refsalt |
11493 |
adsp = adsp+adbetaloc(i,j)*(3.*eosc(9,kref)*sp+2.*eosc(5, |
11494 |
$kref)+3.*eosc(9,kref)*sp+2.*eosc(8,kref)*tp) |
11495 |
adtp = adtp+adbetaloc(i,j)*(eosc(7,kref)*tp+2.*eosc(8,kref)* |
11496 |
$sp+eosc(4,kref)+eosc(7,kref)*tp) |
11497 |
adbetaloc(i,j) = 0.d0 |
11498 |
adsalt(i,j,k,bi,bj) = adsalt(i,j,k,bi,bj)+adsp |
11499 |
adsp = 0.d0 |
11500 |
adtheta(i,j,k,bi,bj) = adtheta(i,j,k,bi,bj)+adtp |
11501 |
adtp = 0.d0 |
11502 |
end do |
11503 |
end do |
11504 |
endif |
11505 |
|
11506 |
end |
11507 |
|
11508 |
|
11509 |
subroutine adfind_rho( bi, bj, imin, imax, jmin, jmax, k, kref, |
11510 |
$eqn, tfld, sfld, adtfld, adsfld, adrholoc ) |
11511 |
C*************************************************************** |
11512 |
C*************************************************************** |
11513 |
C** This routine was generated by the ** |
11514 |
C** Tangent linear and Adjoint Model Compiler, TAMC 5.2.14 ** |
11515 |
C*************************************************************** |
11516 |
C*************************************************************** |
11517 |
C============================================== |
11518 |
C all entries are defined explicitly |
11519 |
C============================================== |
11520 |
implicit none |
11521 |
|
11522 |
C============================================== |
11523 |
C define parameters |
11524 |
C============================================== |
11525 |
integer npx |
11526 |
parameter ( npx = 1 ) |
11527 |
integer npy |
11528 |
parameter ( npy = 1 ) |
11529 |
integer nr |
11530 |
parameter ( nr = 15 ) |
11531 |
integer nsx |
11532 |
parameter ( nsx = 1 ) |
11533 |
integer nsy |
11534 |
parameter ( nsy = 1 ) |
11535 |
integer snx |
11536 |
parameter ( snx = 20 ) |
11537 |
integer nx |
11538 |
parameter ( nx = snx*nsx*npx ) |
11539 |
integer sny |
11540 |
parameter ( sny = 40 ) |
11541 |
integer ny |
11542 |
parameter ( ny = sny*nsy*npy ) |
11543 |
integer olx |
11544 |
parameter ( olx = 3 ) |
11545 |
integer oly |
11546 |
parameter ( oly = 3 ) |
11547 |
|
11548 |
C============================================== |
11549 |
C define common blocks |
11550 |
C============================================== |
11551 |
common /parm_eos_lin/ talpha, sbeta, eostype |
11552 |
character*(6) eostype |
11553 |
double precision sbeta |
11554 |
double precision talpha |
11555 |
|
11556 |
common /parm_eos_nl/ eosc, eossig0, eosreft, eosrefs |
11557 |
double precision eosc(9,nr+1) |
11558 |
double precision eosrefs(nr+1) |
11559 |
double precision eosreft(nr+1) |
11560 |
double precision eossig0(nr+1) |
11561 |
|
11562 |
common /parm_r/ cg2dtargetresidual, cg2dpcoffdfac, |
11563 |
$cg3dtargetresidual, delp, delz, delr, delx, dely, deltat, |
11564 |
$deltatmom, deltattracer, deltatclock, abeps, starttime, phimin, |
11565 |
$thetamin, rsphere, recip_rsphere, f0, fcori, beta, viscah, viscaz, |
11566 |
$ visca4, viscar, diffkht, diffkzt, diffk4t, diffkrt, diffkhs, |
11567 |
$diffkzs, diffk4s, diffkrs, delt, taucd, rcd, freesurffac, |
11568 |
$implicsurfpress, implicdiv2dflow, hfacmin, hfacmindz, gravity, |
11569 |
$recip_gravity, gbaro, rhonil, recip_rhonil, recip_rhoconst, |
11570 |
$rhoconst, tref, sref, endtime, chkptfreq, pchkptfreq, dumpfreq, |
11571 |
$tavefreq, affacmom, vffacmom, pffacmom, cffacmom, fofacmom, |
11572 |
$mtfacmom, cospower, cadjfreq, omega, tauthetaclimrelax, |
11573 |
$lambdathetaclimrelax, tausaltclimrelax, lambdasaltclimrelax, |
11574 |
$externforcingcycle, externforcingperiod, viscap, diffkpt, diffkps, |
11575 |
$ hfacmindr, hfacmindp, theta_s, specvol_s, horivertratio, |
11576 |
$recip_horivertratio, latfftfiltlo, ivdc_kappa, ro_sealevel, |
11577 |
$zonal_filt_lat, bottomdraglinear, bottomdragquadratic |
11578 |
double precision abeps |
11579 |
double precision affacmom |
11580 |
double precision beta |
11581 |
double precision bottomdraglinear |
11582 |
double precision bottomdragquadratic |
11583 |
double precision cadjfreq |
11584 |
double precision cffacmom |
11585 |
double precision cg2dpcoffdfac |
11586 |
double precision cg2dtargetresidual |
11587 |
double precision cg3dtargetresidual |
11588 |
double precision chkptfreq |
11589 |
double precision cospower |
11590 |
double precision delp(nr) |
11591 |
double precision delr(nr) |
11592 |
double precision delt |
11593 |
double precision deltat |
11594 |
double precision deltatclock |
11595 |
double precision deltatmom |
11596 |
double precision deltattracer |
11597 |
double precision delx(nx) |
11598 |
double precision dely(ny) |
11599 |
double precision delz(nr) |
11600 |
double precision diffk4s |
11601 |
double precision diffk4t |
11602 |
double precision diffkhs |
11603 |
double precision diffkht |
11604 |
double precision diffkps |
11605 |
double precision diffkpt |
11606 |
double precision diffkrs |
11607 |
double precision diffkrt |
11608 |
double precision diffkzs |
11609 |
double precision diffkzt |
11610 |
double precision dumpfreq |
11611 |
double precision endtime |
11612 |
double precision externforcingcycle |
11613 |
double precision externforcingperiod |
11614 |
double precision f0 |
11615 |
double precision fcori(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
11616 |
double precision fofacmom |
11617 |
double precision freesurffac |
11618 |
double precision gbaro |
11619 |
double precision gravity |
11620 |
double precision hfacmin |
11621 |
double precision hfacmindp |
11622 |
double precision hfacmindr |
11623 |
double precision hfacmindz |
11624 |
double precision horivertratio |
11625 |
double precision implicdiv2dflow |
11626 |
double precision implicsurfpress |
11627 |
double precision ivdc_kappa |
11628 |
double precision lambdasaltclimrelax |
11629 |
double precision lambdathetaclimrelax |
11630 |
double precision latfftfiltlo |
11631 |
double precision mtfacmom |
11632 |
double precision omega |
11633 |
double precision pchkptfreq |
11634 |
double precision pffacmom |
11635 |
double precision phimin |
11636 |
double precision rcd |
11637 |
double precision recip_gravity |
11638 |
double precision recip_horivertratio |
11639 |
double precision recip_rhoconst |
11640 |
double precision recip_rhonil |
11641 |
double precision recip_rsphere |
11642 |
double precision rhoconst |
11643 |
double precision rhonil |
11644 |
double precision ro_sealevel |
11645 |
double precision rsphere |
11646 |
double precision specvol_s(nr) |
11647 |
double precision sref(nr) |
11648 |
double precision starttime |
11649 |
double precision taucd |
11650 |
double precision tausaltclimrelax |
11651 |
double precision tauthetaclimrelax |
11652 |
double precision tavefreq |
11653 |
double precision theta_s(nr) |
11654 |
double precision thetamin |
11655 |
double precision tref(nr) |
11656 |
double precision vffacmom |
11657 |
double precision visca4 |
11658 |
double precision viscah |
11659 |
double precision viscap |
11660 |
double precision viscar |
11661 |
double precision viscaz |
11662 |
double precision zonal_filt_lat |
11663 |
|
11664 |
C============================================== |
11665 |
C define arguments |
11666 |
C============================================== |
11667 |
double precision adrholoc(1-olx:snx+olx,1-oly:sny+oly) |
11668 |
double precision adsfld(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
11669 |
double precision adtfld(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
11670 |
integer bi |
11671 |
integer bj |
11672 |
character*(*) eqn |
11673 |
integer imax |
11674 |
integer imin |
11675 |
integer jmax |
11676 |
integer jmin |
11677 |
integer k |
11678 |
integer kref |
11679 |
double precision sfld(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
11680 |
double precision tfld(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
11681 |
|
11682 |
C============================================== |
11683 |
C define local variables |
11684 |
C============================================== |
11685 |
double precision addeltasig |
11686 |
double precision adsp |
11687 |
double precision adtp |
11688 |
integer i |
11689 |
integer j |
11690 |
double precision refsalt |
11691 |
double precision reftemp |
11692 |
double precision sp |
11693 |
double precision tp |
11694 |
|
11695 |
C---------------------------------------------- |
11696 |
C RESET LOCAL ADJOINT VARIABLES |
11697 |
C---------------------------------------------- |
11698 |
addeltasig = 0.d0 |
11699 |
adsp = 0.d0 |
11700 |
adtp = 0.d0 |
11701 |
|
11702 |
C---------------------------------------------- |
11703 |
C ROUTINE BODY |
11704 |
C---------------------------------------------- |
11705 |
if (eqn .eq. 'LINEAR') then |
11706 |
do j = jmin, jmax |
11707 |
do i = imin, imax |
11708 |
adsfld(i,j,k,bi,bj) = adsfld(i,j,k,bi,bj)+adrholoc(i,j)* |
11709 |
$rhonil*sbeta |
11710 |
adtfld(i,j,k,bi,bj) = adtfld(i,j,k,bi,bj)-adrholoc(i,j)* |
11711 |
$rhonil*talpha |
11712 |
adrholoc(i,j) = 0.d0 |
11713 |
end do |
11714 |
end do |
11715 |
else if (eqn .eq. 'POLY3') then |
11716 |
reftemp = eosreft(kref) |
11717 |
refsalt = eosrefs(kref) |
11718 |
do j = jmin, jmax |
11719 |
addeltasig = 0.d0 |
11720 |
adsp = 0.d0 |
11721 |
adtp = 0.d0 |
11722 |
do i = imin, imax |
11723 |
addeltasig = 0.d0 |
11724 |
adsp = 0.d0 |
11725 |
adtp = 0.d0 |
11726 |
tp = tfld(i,j,k,bi,bj)-reftemp |
11727 |
sp = sfld(i,j,k,bi,bj)-refsalt |
11728 |
addeltasig = addeltasig+adrholoc(i,j) |
11729 |
adrholoc(i,j) = 0.d0 |
11730 |
adsp = adsp+addeltasig*((eosc(9,kref)*sp+eosc(5,kref))*sp+ |
11731 |
$eosc(2,kref)+(eosc(9,kref)*sp+eosc(5,kref)+eosc(9,kref)*sp)*sp+ |
11732 |
$(eosc(7,kref)*tp+eosc(8,kref)*sp+eosc(4,kref)+eosc(8,kref)*sp)*tp) |
11733 |
adtp = adtp+addeltasig*((eosc(6,kref)*tp+eosc(7,kref)*sp+ |
11734 |
$eosc(3,kref))*tp+(eosc(8,kref)*sp+eosc(4,kref))*sp+eosc(1,kref)+ |
11735 |
$(eosc(6,kref)*tp+eosc(7,kref)*sp+eosc(3,kref)+eosc(6,kref)*tp)*tp) |
11736 |
addeltasig = 0.d0 |
11737 |
adsfld(i,j,k,bi,bj) = adsfld(i,j,k,bi,bj)+adsp |
11738 |
adsp = 0.d0 |
11739 |
adtfld(i,j,k,bi,bj) = adtfld(i,j,k,bi,bj)+adtp |
11740 |
adtp = 0.d0 |
11741 |
end do |
11742 |
end do |
11743 |
endif |
11744 |
do j = 1-oly, sny+oly |
11745 |
do i = 1-olx, snx+olx |
11746 |
adrholoc(i,j) = 0.d0 |
11747 |
end do |
11748 |
end do |
11749 |
|
11750 |
end |
11751 |
|
11752 |
|
11753 |
subroutine adfreeze( bi, bj, imin, imax, jmin, jmax, k ) |
11754 |
C*************************************************************** |
11755 |
C*************************************************************** |
11756 |
C** This routine was generated by the ** |
11757 |
C** Tangent linear and Adjoint Model Compiler, TAMC 5.2.14 ** |
11758 |
C*************************************************************** |
11759 |
C*************************************************************** |
11760 |
C============================================== |
11761 |
C all entries are defined explicitly |
11762 |
C============================================== |
11763 |
implicit none |
11764 |
|
11765 |
C============================================== |
11766 |
C define parameters |
11767 |
C============================================== |
11768 |
integer nr |
11769 |
parameter ( nr = 15 ) |
11770 |
integer nsx |
11771 |
parameter ( nsx = 1 ) |
11772 |
integer nsy |
11773 |
parameter ( nsy = 1 ) |
11774 |
integer olx |
11775 |
parameter ( olx = 3 ) |
11776 |
integer oly |
11777 |
parameter ( oly = 3 ) |
11778 |
integer snx |
11779 |
parameter ( snx = 20 ) |
11780 |
integer sny |
11781 |
parameter ( sny = 40 ) |
11782 |
|
11783 |
C============================================== |
11784 |
C define common blocks |
11785 |
C============================================== |
11786 |
common /addynvars_r/ adetan, aduvel, advvel, adwvel, adtheta, |
11787 |
$adsalt, adgu, adgv, adgt, adgs, adgunm1, adgvnm1, adgtnm1, adgsnm1 |
11788 |
double precision adetan(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
11789 |
double precision adgs(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
11790 |
double precision adgsnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
11791 |
double precision adgt(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
11792 |
double precision adgtnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
11793 |
double precision adgu(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
11794 |
double precision adgunm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
11795 |
double precision adgv(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
11796 |
double precision adgvnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
11797 |
double precision adsalt(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
11798 |
double precision adtheta(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
11799 |
double precision aduvel(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
11800 |
double precision advvel(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
11801 |
double precision adwvel(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
11802 |
|
11803 |
common /dynvars_r/ etan, uvel, vvel, wvel, theta, salt, gu, gv, |
11804 |
$gt, gs, gunm1, gvnm1, gtnm1, gsnm1 |
11805 |
double precision etan(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
11806 |
double precision gs(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
11807 |
double precision gsnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
11808 |
double precision gt(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
11809 |
double precision gtnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
11810 |
double precision gu(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
11811 |
double precision gunm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
11812 |
double precision gv(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
11813 |
double precision gvnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
11814 |
double precision salt(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
11815 |
double precision theta(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
11816 |
double precision uvel(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
11817 |
double precision vvel(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
11818 |
double precision wvel(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
11819 |
|
11820 |
C============================================== |
11821 |
C define arguments |
11822 |
C============================================== |
11823 |
integer bi |
11824 |
integer bj |
11825 |
integer imax |
11826 |
integer imin |
11827 |
integer jmax |
11828 |
integer jmin |
11829 |
integer k |
11830 |
|
11831 |
C============================================== |
11832 |
C define local variables |
11833 |
C============================================== |
11834 |
integer i |
11835 |
integer j |
11836 |
double precision tfreezing |
11837 |
|
11838 |
C---------------------------------------------- |
11839 |
C ROUTINE BODY |
11840 |
C---------------------------------------------- |
11841 |
tfreezing = -1.9 |
11842 |
do j = jmin, jmax |
11843 |
do i = imin, imax |
11844 |
if (gtnm1(i,j,k,bi,bj) .lt. tfreezing) then |
11845 |
adgtnm1(i,j,k,bi,bj) = 0.d0 |
11846 |
endif |
11847 |
end do |
11848 |
end do |
11849 |
|
11850 |
end |
11851 |
|
11852 |
|
11853 |
subroutine adgmredi_calc_diff( bi, bj, imin, imax, jmin, jmax, k, |
11854 |
$maskup, adkappart, adkappars ) |
11855 |
C*************************************************************** |
11856 |
C*************************************************************** |
11857 |
C** This routine was generated by the ** |
11858 |
C** Tangent linear and Adjoint Model Compiler, TAMC 5.2.14 ** |
11859 |
C*************************************************************** |
11860 |
C*************************************************************** |
11861 |
C============================================== |
11862 |
C all entries are defined explicitly |
11863 |
C============================================== |
11864 |
implicit none |
11865 |
|
11866 |
C============================================== |
11867 |
C define parameters |
11868 |
C============================================== |
11869 |
integer max_len_fnam |
11870 |
parameter ( max_len_fnam = 512 ) |
11871 |
integer nr |
11872 |
parameter ( nr = 15 ) |
11873 |
integer nsx |
11874 |
parameter ( nsx = 1 ) |
11875 |
integer nsy |
11876 |
parameter ( nsy = 1 ) |
11877 |
integer olx |
11878 |
parameter ( olx = 3 ) |
11879 |
integer oly |
11880 |
parameter ( oly = 3 ) |
11881 |
integer snx |
11882 |
parameter ( snx = 20 ) |
11883 |
integer sny |
11884 |
parameter ( sny = 40 ) |
11885 |
|
11886 |
C============================================== |
11887 |
C define common blocks |
11888 |
C============================================== |
11889 |
common /adgm_wtensor/ adkwx, adkwy, adkwz |
11890 |
double precision adkwx(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
11891 |
double precision adkwy(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
11892 |
double precision adkwz(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
11893 |
|
11894 |
common /gm_params/ gm_background_k, gm_maxslope, gm_visbeck_alpha, |
11895 |
$ gm_visbeck_length, gm_visbeck_depth, gm_visbeck_maxval_k, |
11896 |
$gm_taper_scheme, gm_scrit, gm_sd |
11897 |
double precision gm_background_k |
11898 |
double precision gm_maxslope |
11899 |
double precision gm_scrit |
11900 |
double precision gm_sd |
11901 |
character*(max_len_fnam) gm_taper_scheme |
11902 |
double precision gm_visbeck_alpha |
11903 |
double precision gm_visbeck_depth |
11904 |
double precision gm_visbeck_length |
11905 |
double precision gm_visbeck_maxval_k |
11906 |
|
11907 |
C============================================== |
11908 |
C define arguments |
11909 |
C============================================== |
11910 |
double precision adkappars(1-olx:snx+olx,1-oly:sny+oly,nr) |
11911 |
double precision adkappart(1-olx:snx+olx,1-oly:sny+oly,nr) |
11912 |
integer bi |
11913 |
integer bj |
11914 |
integer imax |
11915 |
integer imin |
11916 |
integer jmax |
11917 |
integer jmin |
11918 |
integer k |
11919 |
double precision maskup(1-olx:snx+olx,1-oly:sny+oly) |
11920 |
|
11921 |
C============================================== |
11922 |
C define local variables |
11923 |
C============================================== |
11924 |
integer i |
11925 |
integer j |
11926 |
|
11927 |
C---------------------------------------------- |
11928 |
C ROUTINE BODY |
11929 |
C---------------------------------------------- |
11930 |
do j = jmin, jmax |
11931 |
do i = imin, imax |
11932 |
adkwz(i,j,k,bi,bj) = adkwz(i,j,k,bi,bj)+adkappars(i,j,k)* |
11933 |
$maskup(i,j)*gm_background_k |
11934 |
end do |
11935 |
end do |
11936 |
do j = jmin, jmax |
11937 |
do i = imin, imax |
11938 |
adkwz(i,j,k,bi,bj) = adkwz(i,j,k,bi,bj)+adkappart(i,j,k)* |
11939 |
$maskup(i,j)*gm_background_k |
11940 |
end do |
11941 |
end do |
11942 |
|
11943 |
end |
11944 |
|
11945 |
|
11946 |
subroutine adgmredi_calc_tensor( bi, bj, k, sigmax, sigmay, |
11947 |
$sigmar, adsigmax, adsigmay, adsigmar ) |
11948 |
C*************************************************************** |
11949 |
C*************************************************************** |
11950 |
C** This routine was generated by the ** |
11951 |
C** Tangent linear and Adjoint Model Compiler, TAMC 5.2.14 ** |
11952 |
C*************************************************************** |
11953 |
C*************************************************************** |
11954 |
C============================================== |
11955 |
C all entries are defined explicitly |
11956 |
C============================================== |
11957 |
implicit none |
11958 |
|
11959 |
C============================================== |
11960 |
C define parameters |
11961 |
C============================================== |
11962 |
integer nr |
11963 |
parameter ( nr = 15 ) |
11964 |
integer nsx |
11965 |
parameter ( nsx = 1 ) |
11966 |
integer nsy |
11967 |
parameter ( nsy = 1 ) |
11968 |
integer olx |
11969 |
parameter ( olx = 3 ) |
11970 |
integer oly |
11971 |
parameter ( oly = 3 ) |
11972 |
integer snx |
11973 |
parameter ( snx = 20 ) |
11974 |
integer sny |
11975 |
parameter ( sny = 40 ) |
11976 |
|
11977 |
C============================================== |
11978 |
C define common blocks |
11979 |
C============================================== |
11980 |
common /adgm_wtensor/ adkwx, adkwy, adkwz |
11981 |
double precision adkwx(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
11982 |
double precision adkwy(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
11983 |
double precision adkwz(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
11984 |
|
11985 |
common /grid_r/ dxc, dxf, dxg, dxv, dyc, dyf, dyg, dyu, drc, drf, |
11986 |
$h, hfacc, hfacw, hfacs, depthink, recip_dxc, recip_dxf, recip_dxg, |
11987 |
$ recip_dxv, recip_dyc, recip_dyf, recip_dyg, recip_dyu, recip_drc, |
11988 |
$ recip_drf, recip_h, recip_hfacc, recip_hfacw, recip_hfacs, rkfac, |
11989 |
$ recip_rkfac, safac, xc, yc, ra, raw, ras, raz, rc, rf, yc0, xc0, |
11990 |
$xg, yg, maskw, masks, recip_ra, recip_raw, recip_ras, recip_raz, |
11991 |
$tanphiatu, tanphiatv |
11992 |
double precision depthink(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
11993 |
double precision drc(1:nr) |
11994 |
double precision drf(1:nr) |
11995 |
double precision dxc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
11996 |
double precision dxf(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
11997 |
double precision dxg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
11998 |
double precision dxv(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
11999 |
double precision dyc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
12000 |
double precision dyf(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
12001 |
double precision dyg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
12002 |
double precision dyu(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
12003 |
double precision h(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
12004 |
double precision hfacc(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) |
12005 |
double precision hfacs(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) |
12006 |
double precision hfacw(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) |
12007 |
double precision masks(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) |
12008 |
double precision maskw(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) |
12009 |
double precision ra(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
12010 |
double precision ras(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
12011 |
double precision raw(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
12012 |
double precision raz(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
12013 |
double precision rc(1:nr) |
12014 |
double precision recip_drc(1:nr) |
12015 |
double precision recip_drf(1:nr) |
12016 |
double precision recip_dxc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
12017 |
double precision recip_dxf(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
12018 |
double precision recip_dxg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
12019 |
double precision recip_dxv(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
12020 |
double precision recip_dyc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
12021 |
double precision recip_dyf(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
12022 |
double precision recip_dyg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
12023 |
double precision recip_dyu(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
12024 |
double precision recip_h(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
12025 |
double precision recip_hfacc(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx, |
12026 |
$nsy) |
12027 |
double precision recip_hfacs(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx, |
12028 |
$nsy) |
12029 |
double precision recip_hfacw(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx, |
12030 |
$nsy) |
12031 |
double precision recip_ra(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
12032 |
double precision recip_ras(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
12033 |
double precision recip_raw(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
12034 |
double precision recip_raz(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
12035 |
double precision recip_rkfac |
12036 |
double precision rf(1:nr+1) |
12037 |
double precision rkfac |
12038 |
double precision safac(1:nr) |
12039 |
double precision tanphiatu(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
12040 |
double precision tanphiatv(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
12041 |
double precision xc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
12042 |
double precision xc0 |
12043 |
double precision xg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
12044 |
double precision yc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
12045 |
double precision yc0 |
12046 |
double precision yg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
12047 |
|
12048 |
C============================================== |
12049 |
C define arguments |
12050 |
C============================================== |
12051 |
double precision adsigmar(1-olx:snx+olx,1-oly:sny+oly,nr) |
12052 |
double precision adsigmax(1-olx:snx+olx,1-oly:sny+oly,nr) |
12053 |
double precision adsigmay(1-olx:snx+olx,1-oly:sny+oly,nr) |
12054 |
integer bi |
12055 |
integer bj |
12056 |
integer k |
12057 |
double precision sigmar(1-olx:snx+olx,1-oly:sny+oly,nr) |
12058 |
double precision sigmax(1-olx:snx+olx,1-oly:sny+oly,nr) |
12059 |
double precision sigmay(1-olx:snx+olx,1-oly:sny+oly,nr) |
12060 |
|
12061 |
C============================================== |
12062 |
C define local variables |
12063 |
C============================================== |
12064 |
double precision addrdsigmaltd(1-olx:snx+olx,1-oly:sny+oly) |
12065 |
double precision addsigmadrreal(1-olx:snx+olx,1-oly:sny+oly) |
12066 |
double precision adslopex(1-olx:snx+olx,1-oly:sny+oly) |
12067 |
double precision adslopey(1-olx:snx+olx,1-oly:sny+oly) |
12068 |
double precision adssq |
12069 |
double precision drdsigmaltd(1-olx:snx+olx,1-oly:sny+oly) |
12070 |
double precision dsigmadrreal(1-olx:snx+olx,1-oly:sny+oly) |
12071 |
integer i |
12072 |
integer ip1 |
12073 |
integer ip2 |
12074 |
integer j |
12075 |
integer km1 |
12076 |
integer mythid |
12077 |
double precision slopex(1-olx:snx+olx,1-oly:sny+oly) |
12078 |
double precision slopey(1-olx:snx+olx,1-oly:sny+oly) |
12079 |
|
12080 |
C---------------------------------------------- |
12081 |
C RESET LOCAL ADJOINT VARIABLES |
12082 |
C---------------------------------------------- |
12083 |
do ip2 = 1-oly, sny+oly |
12084 |
do ip1 = 1-olx, snx+olx |
12085 |
addrdsigmaltd(ip1,ip2) = 0.d0 |
12086 |
end do |
12087 |
end do |
12088 |
do ip2 = 1-oly, sny+oly |
12089 |
do ip1 = 1-olx, snx+olx |
12090 |
addsigmadrreal(ip1,ip2) = 0.d0 |
12091 |
end do |
12092 |
end do |
12093 |
do ip2 = 1-oly, sny+oly |
12094 |
do ip1 = 1-olx, snx+olx |
12095 |
adslopex(ip1,ip2) = 0.d0 |
12096 |
end do |
12097 |
end do |
12098 |
do ip2 = 1-oly, sny+oly |
12099 |
do ip1 = 1-olx, snx+olx |
12100 |
adslopey(ip1,ip2) = 0.d0 |
12101 |
end do |
12102 |
end do |
12103 |
adssq = 0.d0 |
12104 |
|
12105 |
C---------------------------------------------- |
12106 |
C ROUTINE BODY |
12107 |
C---------------------------------------------- |
12108 |
km1 = max(1,k-1) |
12109 |
do j = 1-oly+1, sny+oly-1 |
12110 |
do i = 1-olx+1, snx+olx-1 |
12111 |
slopex(i,j) = 0.25*(sigmax(i+1,j,km1)+sigmax(i,j,km1)+ |
12112 |
$sigmax(i+1,j,k)+sigmax(i,j,k)) |
12113 |
slopey(i,j) = 0.25*(sigmay(i,j+1,km1)+sigmay(i,j,km1)+ |
12114 |
$sigmay(i,j+1,k)+sigmay(i,j,k)) |
12115 |
dsigmadrreal(i,j) = sigmar(i,j,k) |
12116 |
if (hfacc(i,j,k,bi,bj) .eq. 0.) then |
12117 |
slopex(i,j) = 0. |
12118 |
slopey(i,j) = 0. |
12119 |
endif |
12120 |
end do |
12121 |
end do |
12122 |
call gmredi_slope_limit( dsigmadrreal,rf(k),slopex,slopey, |
12123 |
$drdsigmaltd,bi,bj,mythid ) |
12124 |
do j = 1-oly+1, sny+oly-1 |
12125 |
adssq = 0.d0 |
12126 |
do i = 1-olx+1, snx+olx-1 |
12127 |
adssq = 0.d0 |
12128 |
if (hfacc(i,j,k,bi,bj) .eq. 0.) then |
12129 |
slopex(i,j) = 0. |
12130 |
slopey(i,j) = 0. |
12131 |
endif |
12132 |
adssq = adssq+adkwz(i,j,k,bi,bj) |
12133 |
adkwz(i,j,k,bi,bj) = 0.d0 |
12134 |
adslopey(i,j) = adslopey(i,j)+2*adkwy(i,j,k,bi,bj) |
12135 |
adkwy(i,j,k,bi,bj) = 0.d0 |
12136 |
adslopex(i,j) = adslopex(i,j)+2*adkwx(i,j,k,bi,bj) |
12137 |
adkwx(i,j,k,bi,bj) = 0.d0 |
12138 |
adslopex(i,j) = adslopex(i,j)+2*adssq*slopex(i,j) |
12139 |
adslopey(i,j) = adslopey(i,j)+2*adssq*slopey(i,j) |
12140 |
adssq = 0.d0 |
12141 |
if (hfacc(i,j,k,bi,bj) .eq. 0.) then |
12142 |
adslopey(i,j) = 0.d0 |
12143 |
adslopex(i,j) = 0.d0 |
12144 |
endif |
12145 |
end do |
12146 |
end do |
12147 |
do j = 1-oly+1, sny+oly-1 |
12148 |
do i = 1-olx+1, snx+olx-1 |
12149 |
slopex(i,j) = 0.25*(sigmax(i+1,j,km1)+sigmax(i,j,km1)+ |
12150 |
$sigmax(i+1,j,k)+sigmax(i,j,k)) |
12151 |
slopey(i,j) = 0.25*(sigmay(i,j+1,km1)+sigmay(i,j,km1)+ |
12152 |
$sigmay(i,j+1,k)+sigmay(i,j,k)) |
12153 |
if (hfacc(i,j,k,bi,bj) .eq. 0.) then |
12154 |
slopex(i,j) = 0. |
12155 |
slopey(i,j) = 0. |
12156 |
endif |
12157 |
end do |
12158 |
end do |
12159 |
call adgmredi_slope_limit( dsigmadrreal,slopex,slopey, |
12160 |
$addsigmadrreal,adslopex,adslopey,addrdsigmaltd ) |
12161 |
do j = 1-oly+1, sny+oly-1 |
12162 |
do i = 1-olx+1, snx+olx-1 |
12163 |
if (hfacc(i,j,k,bi,bj) .eq. 0.) then |
12164 |
adslopey(i,j) = 0.d0 |
12165 |
adslopex(i,j) = 0.d0 |
12166 |
endif |
12167 |
adsigmar(i,j,k) = adsigmar(i,j,k)+addsigmadrreal(i,j) |
12168 |
addsigmadrreal(i,j) = 0.d0 |
12169 |
adsigmay(i,j+1,k) = adsigmay(i,j+1,k)+0.25*adslopey(i,j) |
12170 |
adsigmay(i,j+1,km1) = adsigmay(i,j+1,km1)+0.25*adslopey(i,j) |
12171 |
adsigmay(i,j,k) = adsigmay(i,j,k)+0.25*adslopey(i,j) |
12172 |
adsigmay(i,j,km1) = adsigmay(i,j,km1)+0.25*adslopey(i,j) |
12173 |
adslopey(i,j) = 0.d0 |
12174 |
adsigmax(i+1,j,k) = adsigmax(i+1,j,k)+0.25*adslopex(i,j) |
12175 |
adsigmax(i,j,k) = adsigmax(i,j,k)+0.25*adslopex(i,j) |
12176 |
adsigmax(i+1,j,km1) = adsigmax(i+1,j,km1)+0.25*adslopex(i,j) |
12177 |
adsigmax(i,j,km1) = adsigmax(i,j,km1)+0.25*adslopex(i,j) |
12178 |
adslopex(i,j) = 0.d0 |
12179 |
end do |
12180 |
end do |
12181 |
|
12182 |
end |
12183 |
|
12184 |
|
12185 |
subroutine adgmredi_calc_tensor_dummy( bi, bj, k ) |
12186 |
C*************************************************************** |
12187 |
C*************************************************************** |
12188 |
C** This routine was generated by the ** |
12189 |
C** Tangent linear and Adjoint Model Compiler, TAMC 5.2.14 ** |
12190 |
C*************************************************************** |
12191 |
C*************************************************************** |
12192 |
C============================================== |
12193 |
C all entries are defined explicitly |
12194 |
C============================================== |
12195 |
implicit none |
12196 |
|
12197 |
C============================================== |
12198 |
C define parameters |
12199 |
C============================================== |
12200 |
integer nr |
12201 |
parameter ( nr = 15 ) |
12202 |
integer nsx |
12203 |
parameter ( nsx = 1 ) |
12204 |
integer nsy |
12205 |
parameter ( nsy = 1 ) |
12206 |
integer olx |
12207 |
parameter ( olx = 3 ) |
12208 |
integer oly |
12209 |
parameter ( oly = 3 ) |
12210 |
integer snx |
12211 |
parameter ( snx = 20 ) |
12212 |
integer sny |
12213 |
parameter ( sny = 40 ) |
12214 |
|
12215 |
C============================================== |
12216 |
C define common blocks |
12217 |
C============================================== |
12218 |
common /adgm_wtensor/ adkwx, adkwy, adkwz |
12219 |
double precision adkwx(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
12220 |
double precision adkwy(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
12221 |
double precision adkwz(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
12222 |
|
12223 |
C============================================== |
12224 |
C define arguments |
12225 |
C============================================== |
12226 |
integer bi |
12227 |
integer bj |
12228 |
integer k |
12229 |
|
12230 |
C============================================== |
12231 |
C define local variables |
12232 |
C============================================== |
12233 |
integer i |
12234 |
integer j |
12235 |
|
12236 |
C---------------------------------------------- |
12237 |
C ROUTINE BODY |
12238 |
C---------------------------------------------- |
12239 |
do j = 1-oly+1, sny+oly-1 |
12240 |
do i = 1-olx+1, snx+olx-1 |
12241 |
adkwz(i,j,k,bi,bj) = 0.d0 |
12242 |
adkwy(i,j,k,bi,bj) = 0.d0 |
12243 |
adkwx(i,j,k,bi,bj) = 0.d0 |
12244 |
end do |
12245 |
end do |
12246 |
|
12247 |
end |
12248 |
|
12249 |
|
12250 |
subroutine adgmredi_rtransport( imin, imax, jmin, jmax, bi, bj, k, |
12251 |
$ tracer, adtracer, addf ) |
12252 |
C*************************************************************** |
12253 |
C*************************************************************** |
12254 |
C** This routine was generated by the ** |
12255 |
C** Tangent linear and Adjoint Model Compiler, TAMC 5.2.14 ** |
12256 |
C*************************************************************** |
12257 |
C*************************************************************** |
12258 |
C============================================== |
12259 |
C all entries are defined explicitly |
12260 |
C============================================== |
12261 |
implicit none |
12262 |
|
12263 |
C============================================== |
12264 |
C define parameters |
12265 |
C============================================== |
12266 |
integer max_len_fnam |
12267 |
parameter ( max_len_fnam = 512 ) |
12268 |
integer nr |
12269 |
parameter ( nr = 15 ) |
12270 |
integer nsx |
12271 |
parameter ( nsx = 1 ) |
12272 |
integer nsy |
12273 |
parameter ( nsy = 1 ) |
12274 |
integer olx |
12275 |
parameter ( olx = 3 ) |
12276 |
integer oly |
12277 |
parameter ( oly = 3 ) |
12278 |
integer snx |
12279 |
parameter ( snx = 20 ) |
12280 |
integer sny |
12281 |
parameter ( sny = 40 ) |
12282 |
|
12283 |
C============================================== |
12284 |
C define common blocks |
12285 |
C============================================== |
12286 |
common /adgm_wtensor/ adkwx, adkwy, adkwz |
12287 |
double precision adkwx(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
12288 |
double precision adkwy(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
12289 |
double precision adkwz(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
12290 |
|
12291 |
common /gm_params/ gm_background_k, gm_maxslope, gm_visbeck_alpha, |
12292 |
$ gm_visbeck_length, gm_visbeck_depth, gm_visbeck_maxval_k, |
12293 |
$gm_taper_scheme, gm_scrit, gm_sd |
12294 |
double precision gm_background_k |
12295 |
double precision gm_maxslope |
12296 |
double precision gm_scrit |
12297 |
double precision gm_sd |
12298 |
character*(max_len_fnam) gm_taper_scheme |
12299 |
double precision gm_visbeck_alpha |
12300 |
double precision gm_visbeck_depth |
12301 |
double precision gm_visbeck_length |
12302 |
double precision gm_visbeck_maxval_k |
12303 |
|
12304 |
common /gm_wtensor/ kwx, kwy, kwz |
12305 |
double precision kwx(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
12306 |
double precision kwy(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
12307 |
double precision kwz(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
12308 |
|
12309 |
common /grid_r/ dxc, dxf, dxg, dxv, dyc, dyf, dyg, dyu, drc, drf, |
12310 |
$h, hfacc, hfacw, hfacs, depthink, recip_dxc, recip_dxf, recip_dxg, |
12311 |
$ recip_dxv, recip_dyc, recip_dyf, recip_dyg, recip_dyu, recip_drc, |
12312 |
$ recip_drf, recip_h, recip_hfacc, recip_hfacw, recip_hfacs, rkfac, |
12313 |
$ recip_rkfac, safac, xc, yc, ra, raw, ras, raz, rc, rf, yc0, xc0, |
12314 |
$xg, yg, maskw, masks, recip_ra, recip_raw, recip_ras, recip_raz, |
12315 |
$tanphiatu, tanphiatv |
12316 |
double precision depthink(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
12317 |
double precision drc(1:nr) |
12318 |
double precision drf(1:nr) |
12319 |
double precision dxc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
12320 |
double precision dxf(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
12321 |
double precision dxg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
12322 |
double precision dxv(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
12323 |
double precision dyc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
12324 |
double precision dyf(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
12325 |
double precision dyg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
12326 |
double precision dyu(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
12327 |
double precision h(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
12328 |
double precision hfacc(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) |
12329 |
double precision hfacs(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) |
12330 |
double precision hfacw(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) |
12331 |
double precision masks(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) |
12332 |
double precision maskw(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) |
12333 |
double precision ra(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
12334 |
double precision ras(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
12335 |
double precision raw(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
12336 |
double precision raz(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
12337 |
double precision rc(1:nr) |
12338 |
double precision recip_drc(1:nr) |
12339 |
double precision recip_drf(1:nr) |
12340 |
double precision recip_dxc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
12341 |
double precision recip_dxf(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
12342 |
double precision recip_dxg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
12343 |
double precision recip_dxv(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
12344 |
double precision recip_dyc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
12345 |
double precision recip_dyf(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
12346 |
double precision recip_dyg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
12347 |
double precision recip_dyu(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
12348 |
double precision recip_h(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
12349 |
double precision recip_hfacc(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx, |
12350 |
$nsy) |
12351 |
double precision recip_hfacs(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx, |
12352 |
$nsy) |
12353 |
double precision recip_hfacw(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx, |
12354 |
$nsy) |
12355 |
double precision recip_ra(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
12356 |
double precision recip_ras(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
12357 |
double precision recip_raw(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
12358 |
double precision recip_raz(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
12359 |
double precision recip_rkfac |
12360 |
double precision rf(1:nr+1) |
12361 |
double precision rkfac |
12362 |
double precision safac(1:nr) |
12363 |
double precision tanphiatu(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
12364 |
double precision tanphiatv(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
12365 |
double precision xc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
12366 |
double precision xc0 |
12367 |
double precision xg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
12368 |
double precision yc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
12369 |
double precision yc0 |
12370 |
double precision yg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
12371 |
|
12372 |
common /parm_packages/ usekpp, usegmredi, useobcs, useaim, useecco |
12373 |
logical useaim |
12374 |
logical useecco |
12375 |
logical usegmredi |
12376 |
logical usekpp |
12377 |
logical useobcs |
12378 |
|
12379 |
C============================================== |
12380 |
C define arguments |
12381 |
C============================================== |
12382 |
double precision addf(1-olx:snx+olx,1-oly:sny+oly) |
12383 |
double precision adtracer(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
12384 |
integer bi |
12385 |
integer bj |
12386 |
integer imax |
12387 |
integer imin |
12388 |
integer jmax |
12389 |
integer jmin |
12390 |
integer k |
12391 |
double precision tracer(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
12392 |
|
12393 |
C============================================== |
12394 |
C define local variables |
12395 |
C============================================== |
12396 |
double precision addtdx |
12397 |
double precision addtdy |
12398 |
double precision dtdx |
12399 |
double precision dtdy |
12400 |
integer i |
12401 |
integer j |
12402 |
|
12403 |
C---------------------------------------------- |
12404 |
C RESET LOCAL ADJOINT VARIABLES |
12405 |
C---------------------------------------------- |
12406 |
addtdx = 0.d0 |
12407 |
addtdy = 0.d0 |
12408 |
|
12409 |
C---------------------------------------------- |
12410 |
C ROUTINE BODY |
12411 |
C---------------------------------------------- |
12412 |
if (usegmredi .and. k .gt. 1) then |
12413 |
do j = jmin, jmax |
12414 |
addtdx = 0.d0 |
12415 |
addtdy = 0.d0 |
12416 |
do i = imin, imax |
12417 |
addtdx = 0.d0 |
12418 |
addtdy = 0.d0 |
12419 |
dtdx = 0.5*(0.5*(maskw(i+1,j,k,bi,bj)*recip_dxc(i+1,j,bi,bj) |
12420 |
$*(tracer(i+1,j,k,bi,bj)-tracer(i,j,k,bi,bj))+maskw(i,j,k,bi,bj)* |
12421 |
$recip_dxc(i,j,bi,bj)*(tracer(i,j,k,bi,bj)-tracer(i-1,j,k,bi,bj)))+ |
12422 |
$0.5*(maskw(i+1,j,k-1,bi,bj)*recip_dxc(i+1,j,bi,bj)*(tracer(i+1,j, |
12423 |
$k-1,bi,bj)-tracer(i,j,k-1,bi,bj))+maskw(i,j,k-1,bi,bj)* |
12424 |
$recip_dxc(i,j,bi,bj)*(tracer(i,j,k-1,bi,bj)-tracer(i-1,j,k-1,bi, |
12425 |
$bj)))) |
12426 |
dtdy = 0.5*(0.5*(masks(i,j,k,bi,bj)*recip_dyc(i,j,bi,bj)* |
12427 |
$(tracer(i,j,k,bi,bj)-tracer(i,j-1,k,bi,bj))+masks(i,j+1,k,bi,bj)* |
12428 |
$recip_dyc(i,j+1,bi,bj)*(tracer(i,j+1,k,bi,bj)-tracer(i,j,k,bi,bj)) |
12429 |
$)+0.5*(masks(i,j,k-1,bi,bj)*recip_dyc(i,j,bi,bj)*(tracer(i,j,k-1, |
12430 |
$bi,bj)-tracer(i,j-1,k-1,bi,bj))+masks(i,j+1,k-1,bi,bj)* |
12431 |
$recip_dyc(i,j+1,bi,bj)*(tracer(i,j+1,k-1,bi,bj)-tracer(i,j,k-1,bi, |
12432 |
$bj)))) |
12433 |
addtdx = addtdx-addf(i,j)*ra(i,j,bi,bj)*gm_background_k* |
12434 |
$kwx(i,j,k,bi,bj) |
12435 |
addtdy = addtdy-addf(i,j)*ra(i,j,bi,bj)*gm_background_k* |
12436 |
$kwy(i,j,k,bi,bj) |
12437 |
adkwx(i,j,k,bi,bj) = adkwx(i,j,k,bi,bj)-addf(i,j)*ra(i,j,bi, |
12438 |
$bj)*gm_background_k*dtdx |
12439 |
adkwy(i,j,k,bi,bj) = adkwy(i,j,k,bi,bj)-addf(i,j)*ra(i,j,bi, |
12440 |
$bj)*gm_background_k*dtdy |
12441 |
adtracer(i,j-1,k-1,bi,bj) = adtracer(i,j-1,k-1,bi,bj)-0.25* |
12442 |
$addtdy*masks(i,j,k-1,bi,bj)*recip_dyc(i,j,bi,bj) |
12443 |
adtracer(i,j-1,k,bi,bj) = adtracer(i,j-1,k,bi,bj)-0.25* |
12444 |
$addtdy*masks(i,j,k,bi,bj)*recip_dyc(i,j,bi,bj) |
12445 |
adtracer(i,j+1,k-1,bi,bj) = adtracer(i,j+1,k-1,bi,bj)+0.25* |
12446 |
$addtdy*masks(i,j+1,k-1,bi,bj)*recip_dyc(i,j+1,bi,bj) |
12447 |
adtracer(i,j+1,k,bi,bj) = adtracer(i,j+1,k,bi,bj)+0.25* |
12448 |
$addtdy*masks(i,j+1,k,bi,bj)*recip_dyc(i,j+1,bi,bj) |
12449 |
adtracer(i,j,k-1,bi,bj) = adtracer(i,j,k-1,bi,bj)+0.25* |
12450 |
$addtdy*(masks(i,j,k-1,bi,bj)*recip_dyc(i,j,bi,bj)-masks(i,j+1,k-1, |
12451 |
$bi,bj)*recip_dyc(i,j+1,bi,bj)) |
12452 |
adtracer(i,j,k,bi,bj) = adtracer(i,j,k,bi,bj)+0.25*addtdy* |
12453 |
$(masks(i,j,k,bi,bj)*recip_dyc(i,j,bi,bj)-masks(i,j+1,k,bi,bj)* |
12454 |
$recip_dyc(i,j+1,bi,bj)) |
12455 |
addtdy = 0.d0 |
12456 |
adtracer(i-1,j,k-1,bi,bj) = adtracer(i-1,j,k-1,bi,bj)-0.25* |
12457 |
$addtdx*maskw(i,j,k-1,bi,bj)*recip_dxc(i,j,bi,bj) |
12458 |
adtracer(i+1,j,k-1,bi,bj) = adtracer(i+1,j,k-1,bi,bj)+0.25* |
12459 |
$addtdx*maskw(i+1,j,k-1,bi,bj)*recip_dxc(i+1,j,bi,bj) |
12460 |
adtracer(i,j,k-1,bi,bj) = adtracer(i,j,k-1,bi,bj)+0.25* |
12461 |
$addtdx*((-(maskw(i+1,j,k-1,bi,bj)*recip_dxc(i+1,j,bi,bj)))+ |
12462 |
$maskw(i,j,k-1,bi,bj)*recip_dxc(i,j,bi,bj)) |
12463 |
adtracer(i-1,j,k,bi,bj) = adtracer(i-1,j,k,bi,bj)-0.25* |
12464 |
$addtdx*maskw(i,j,k,bi,bj)*recip_dxc(i,j,bi,bj) |
12465 |
adtracer(i+1,j,k,bi,bj) = adtracer(i+1,j,k,bi,bj)+0.25* |
12466 |
$addtdx*maskw(i+1,j,k,bi,bj)*recip_dxc(i+1,j,bi,bj) |
12467 |
adtracer(i,j,k,bi,bj) = adtracer(i,j,k,bi,bj)+0.25*addtdx* |
12468 |
$((-(maskw(i+1,j,k,bi,bj)*recip_dxc(i+1,j,bi,bj)))+maskw(i,j,k,bi, |
12469 |
$bj)*recip_dxc(i,j,bi,bj)) |
12470 |
addtdx = 0.d0 |
12471 |
end do |
12472 |
end do |
12473 |
endif |
12474 |
|
12475 |
end |
12476 |
|
12477 |
|
12478 |
subroutine adgmredi_slope_limit( dsigmadrreal, slopex, slopey, |
12479 |
$addsigmadrreal, adslopex, adslopey, addrdsigmaltd ) |
12480 |
C*************************************************************** |
12481 |
C*************************************************************** |
12482 |
C** This routine was generated by the ** |
12483 |
C** Tangent linear and Adjoint Model Compiler, TAMC 5.2.14 ** |
12484 |
C*************************************************************** |
12485 |
C*************************************************************** |
12486 |
C============================================== |
12487 |
C all entries are defined explicitly |
12488 |
C============================================== |
12489 |
implicit none |
12490 |
|
12491 |
C============================================== |
12492 |
C define parameters |
12493 |
C============================================== |
12494 |
integer max_len_fnam |
12495 |
parameter ( max_len_fnam = 512 ) |
12496 |
integer olx |
12497 |
parameter ( olx = 3 ) |
12498 |
integer oly |
12499 |
parameter ( oly = 3 ) |
12500 |
double precision small_number |
12501 |
parameter ( small_number = 1.e-12 ) |
12502 |
integer snx |
12503 |
parameter ( snx = 20 ) |
12504 |
integer sny |
12505 |
parameter ( sny = 40 ) |
12506 |
|
12507 |
C============================================== |
12508 |
C define common blocks |
12509 |
C============================================== |
12510 |
common /gm_params/ gm_background_k, gm_maxslope, gm_visbeck_alpha, |
12511 |
$ gm_visbeck_length, gm_visbeck_depth, gm_visbeck_maxval_k, |
12512 |
$gm_taper_scheme, gm_scrit, gm_sd |
12513 |
double precision gm_background_k |
12514 |
double precision gm_maxslope |
12515 |
double precision gm_scrit |
12516 |
double precision gm_sd |
12517 |
character*(max_len_fnam) gm_taper_scheme |
12518 |
double precision gm_visbeck_alpha |
12519 |
double precision gm_visbeck_depth |
12520 |
double precision gm_visbeck_length |
12521 |
double precision gm_visbeck_maxval_k |
12522 |
|
12523 |
common /gm_params2/ gm_rmaxslope |
12524 |
double precision gm_rmaxslope |
12525 |
|
12526 |
C============================================== |
12527 |
C define arguments |
12528 |
C============================================== |
12529 |
double precision addrdsigmaltd(1-olx:snx+olx,1-oly:sny+oly) |
12530 |
double precision addsigmadrreal(1-olx:snx+olx,1-oly:sny+oly) |
12531 |
double precision adslopex(1-olx:snx+olx,1-oly:sny+oly) |
12532 |
double precision adslopey(1-olx:snx+olx,1-oly:sny+oly) |
12533 |
double precision dsigmadrreal(1-olx:snx+olx,1-oly:sny+oly) |
12534 |
double precision slopex(1-olx:snx+olx,1-oly:sny+oly) |
12535 |
double precision slopey(1-olx:snx+olx,1-oly:sny+oly) |
12536 |
|
12537 |
C============================================== |
12538 |
C define local variables |
12539 |
C============================================== |
12540 |
double precision addsigmadrltd |
12541 |
double precision adf1 |
12542 |
double precision adgradsmod |
12543 |
double precision adsmod |
12544 |
double precision adstratlimit |
12545 |
double precision adsx |
12546 |
double precision adsy |
12547 |
double precision drdsigmaltd(1-olx:snx+olx,1-oly:sny+oly) |
12548 |
double precision dsigmadrltd |
12549 |
double precision f1 |
12550 |
double precision gradsmod |
12551 |
integer i |
12552 |
integer j |
12553 |
double precision smod |
12554 |
double precision stratlimit |
12555 |
double precision sx |
12556 |
double precision sy |
12557 |
|
12558 |
C---------------------------------------------- |
12559 |
C RESET LOCAL ADJOINT VARIABLES |
12560 |
C---------------------------------------------- |
12561 |
addsigmadrltd = 0.d0 |
12562 |
adf1 = 0.d0 |
12563 |
adgradsmod = 0.d0 |
12564 |
adsmod = 0.d0 |
12565 |
adstratlimit = 0.d0 |
12566 |
adsx = 0.d0 |
12567 |
adsy = 0.d0 |
12568 |
|
12569 |
C---------------------------------------------- |
12570 |
C ROUTINE BODY |
12571 |
C---------------------------------------------- |
12572 |
if (gm_taper_scheme .eq. 'orig') then |
12573 |
do j = 1-oly+1, sny+oly-1 |
12574 |
addsigmadrltd = 0.d0 |
12575 |
adgradsmod = 0.d0 |
12576 |
adstratlimit = 0.d0 |
12577 |
do i = 1-olx+1, snx+olx-1 |
12578 |
addsigmadrltd = 0.d0 |
12579 |
adgradsmod = 0.d0 |
12580 |
adstratlimit = 0.d0 |
12581 |
gradsmod = slopex(i,j)*slopex(i,j)+slopey(i,j)*slopey(i,j) |
12582 |
if (gradsmod .ne. 0.) then |
12583 |
gradsmod = sqrt(gradsmod) |
12584 |
endif |
12585 |
stratlimit = (-small_number)-gradsmod*gm_rmaxslope |
12586 |
if (dsigmadrreal(i,j) .lt. stratlimit) then |
12587 |
dsigmadrltd = dsigmadrreal(i,j) |
12588 |
else |
12589 |
dsigmadrltd = stratlimit |
12590 |
endif |
12591 |
drdsigmaltd(i,j) = 1./dsigmadrltd |
12592 |
addrdsigmaltd(i,j) = addrdsigmaltd(i,j)-adslopey(i,j)* |
12593 |
$slopey(i,j) |
12594 |
adslopey(i,j) = -(adslopey(i,j)*drdsigmaltd(i,j)) |
12595 |
addrdsigmaltd(i,j) = addrdsigmaltd(i,j)-adslopex(i,j)* |
12596 |
$slopex(i,j) |
12597 |
adslopex(i,j) = -(adslopex(i,j)*drdsigmaltd(i,j)) |
12598 |
addsigmadrltd = addsigmadrltd-addrdsigmaltd(i,j)/ |
12599 |
$(dsigmadrltd*dsigmadrltd) |
12600 |
addrdsigmaltd(i,j) = 0.d0 |
12601 |
if (dsigmadrreal(i,j) .lt. stratlimit) then |
12602 |
addsigmadrreal(i,j) = addsigmadrreal(i,j)+addsigmadrltd |
12603 |
addsigmadrltd = 0.d0 |
12604 |
else |
12605 |
adstratlimit = adstratlimit+addsigmadrltd |
12606 |
addsigmadrltd = 0.d0 |
12607 |
endif |
12608 |
adgradsmod = adgradsmod-adstratlimit*gm_rmaxslope |
12609 |
adstratlimit = 0.d0 |
12610 |
gradsmod = slopex(i,j)*slopex(i,j)+slopey(i,j)*slopey(i,j) |
12611 |
if (gradsmod .ne. 0.) then |
12612 |
adgradsmod = adgradsmod*(1./(2.*sqrt(gradsmod))) |
12613 |
endif |
12614 |
adslopex(i,j) = adslopex(i,j)+2*adgradsmod*slopex(i,j) |
12615 |
adslopey(i,j) = adslopey(i,j)+2*adgradsmod*slopey(i,j) |
12616 |
adgradsmod = 0.d0 |
12617 |
end do |
12618 |
end do |
12619 |
else if (gm_taper_scheme .eq. 'clipping') then |
12620 |
do j = 1-oly+1, sny+oly-1 |
12621 |
addsigmadrltd = 0.d0 |
12622 |
adgradsmod = 0.d0 |
12623 |
do i = 1-olx+1, snx+olx-1 |
12624 |
addsigmadrltd = 0.d0 |
12625 |
adgradsmod = 0.d0 |
12626 |
gradsmod = slopex(i,j)*slopex(i,j)+slopey(i,j)*slopey(i,j) |
12627 |
if (gradsmod .ne. 0.) then |
12628 |
gradsmod = sqrt(gradsmod) |
12629 |
endif |
12630 |
dsigmadrltd = -(small_number+gradsmod*gm_rmaxslope) |
12631 |
if (dsigmadrreal(i,j) .lt. dsigmadrltd) then |
12632 |
dsigmadrltd = dsigmadrreal(i,j) |
12633 |
endif |
12634 |
drdsigmaltd(i,j) = 1./dsigmadrltd |
12635 |
addrdsigmaltd(i,j) = addrdsigmaltd(i,j)-adslopey(i,j)* |
12636 |
$slopey(i,j) |
12637 |
adslopey(i,j) = -(adslopey(i,j)*drdsigmaltd(i,j)) |
12638 |
addrdsigmaltd(i,j) = addrdsigmaltd(i,j)-adslopex(i,j)* |
12639 |
$slopex(i,j) |
12640 |
adslopex(i,j) = -(adslopex(i,j)*drdsigmaltd(i,j)) |
12641 |
addsigmadrltd = addsigmadrltd-addrdsigmaltd(i,j)/ |
12642 |
$(dsigmadrltd*dsigmadrltd) |
12643 |
addrdsigmaltd(i,j) = 0.d0 |
12644 |
dsigmadrltd = -(small_number+gradsmod*gm_rmaxslope) |
12645 |
if (dsigmadrreal(i,j) .lt. dsigmadrltd) then |
12646 |
addsigmadrreal(i,j) = addsigmadrreal(i,j)+addsigmadrltd |
12647 |
addsigmadrltd = 0.d0 |
12648 |
endif |
12649 |
adgradsmod = adgradsmod-addsigmadrltd*gm_rmaxslope |
12650 |
addsigmadrltd = 0.d0 |
12651 |
gradsmod = slopex(i,j)*slopex(i,j)+slopey(i,j)*slopey(i,j) |
12652 |
if (gradsmod .ne. 0.) then |
12653 |
adgradsmod = adgradsmod*(1./(2.*sqrt(gradsmod))) |
12654 |
endif |
12655 |
adslopex(i,j) = adslopex(i,j)+2*adgradsmod*slopex(i,j) |
12656 |
adslopey(i,j) = adslopey(i,j)+2*adgradsmod*slopey(i,j) |
12657 |
adgradsmod = 0.d0 |
12658 |
end do |
12659 |
end do |
12660 |
else if (gm_taper_scheme .eq. 'gkw91') then |
12661 |
do j = 1-oly+1, sny+oly-1 |
12662 |
addsigmadrltd = 0.d0 |
12663 |
adgradsmod = 0.d0 |
12664 |
do i = 1-olx+1, snx+olx-1 |
12665 |
addsigmadrltd = 0.d0 |
12666 |
adgradsmod = 0.d0 |
12667 |
gradsmod = slopex(i,j)*slopex(i,j)+slopey(i,j)*slopey(i,j) |
12668 |
if (gradsmod .ne. 0.) then |
12669 |
gradsmod = sqrt(gradsmod) |
12670 |
endif |
12671 |
dsigmadrltd = dsigmadrreal(i,j) |
12672 |
if (dsigmadrltd .ne. 0.) then |
12673 |
drdsigmaltd(i,j) = 1./dsigmadrltd |
12674 |
else |
12675 |
drdsigmaltd(i,j) = 0. |
12676 |
endif |
12677 |
if (gradsmod .le. gm_maxslope*abs(dsigmadrreal(i,j))) then |
12678 |
addrdsigmaltd(i,j) = addrdsigmaltd(i,j)-adslopey(i,j)* |
12679 |
$slopey(i,j) |
12680 |
adslopey(i,j) = -(adslopey(i,j)*drdsigmaltd(i,j)) |
12681 |
addrdsigmaltd(i,j) = addrdsigmaltd(i,j)-adslopex(i,j)* |
12682 |
$slopex(i,j) |
12683 |
adslopex(i,j) = -(adslopex(i,j)*drdsigmaltd(i,j)) |
12684 |
else |
12685 |
addsigmadrltd = addsigmadrltd-adslopey(i,j)*slopey(i,j)* |
12686 |
$(gm_maxslope/gradsmod)**2 |
12687 |
adgradsmod = adgradsmod+2*adslopey(i,j)*slopey(i,j)* |
12688 |
$dsigmadrltd*gm_maxslope/(gradsmod*gradsmod)*(gm_maxslope/gradsmod) |
12689 |
adslopey(i,j) = -(adslopey(i,j)*dsigmadrltd*(gm_maxslope/ |
12690 |
$gradsmod)**2) |
12691 |
addsigmadrltd = addsigmadrltd-adslopex(i,j)*slopex(i,j)* |
12692 |
$(gm_maxslope/gradsmod)**2 |
12693 |
adgradsmod = adgradsmod+2*adslopex(i,j)*slopex(i,j)* |
12694 |
$dsigmadrltd*gm_maxslope/(gradsmod*gradsmod)*(gm_maxslope/gradsmod) |
12695 |
adslopex(i,j) = -(adslopex(i,j)*dsigmadrltd*(gm_maxslope/ |
12696 |
$gradsmod)**2) |
12697 |
endif |
12698 |
if (dsigmadrltd .ne. 0.) then |
12699 |
addsigmadrltd = addsigmadrltd-addrdsigmaltd(i,j)/ |
12700 |
$(dsigmadrltd*dsigmadrltd) |
12701 |
addrdsigmaltd(i,j) = 0.d0 |
12702 |
else |
12703 |
addrdsigmaltd(i,j) = 0.d0 |
12704 |
endif |
12705 |
addsigmadrreal(i,j) = addsigmadrreal(i,j)+addsigmadrltd |
12706 |
addsigmadrltd = 0.d0 |
12707 |
gradsmod = slopex(i,j)*slopex(i,j)+slopey(i,j)*slopey(i,j) |
12708 |
if (gradsmod .ne. 0.) then |
12709 |
adgradsmod = adgradsmod*(1./(2.*sqrt(gradsmod))) |
12710 |
endif |
12711 |
adslopex(i,j) = adslopex(i,j)+2*adgradsmod*slopex(i,j) |
12712 |
adslopey(i,j) = adslopey(i,j)+2*adgradsmod*slopey(i,j) |
12713 |
adgradsmod = 0.d0 |
12714 |
end do |
12715 |
end do |
12716 |
else if (gm_taper_scheme .eq. 'dm95') then |
12717 |
do j = 1-oly+1, sny+oly-1 |
12718 |
addsigmadrltd = 0.d0 |
12719 |
adf1 = 0.d0 |
12720 |
adsmod = 0.d0 |
12721 |
adsx = 0.d0 |
12722 |
adsy = 0.d0 |
12723 |
do i = 1-olx+1, snx+olx-1 |
12724 |
addsigmadrltd = 0.d0 |
12725 |
adf1 = 0.d0 |
12726 |
adsmod = 0.d0 |
12727 |
adsx = 0.d0 |
12728 |
adsy = 0.d0 |
12729 |
dsigmadrltd = dsigmadrreal(i,j) |
12730 |
if (dsigmadrltd .ne. 0.) then |
12731 |
drdsigmaltd(i,j) = 1./dsigmadrltd |
12732 |
else |
12733 |
drdsigmaltd(i,j) = 0. |
12734 |
endif |
12735 |
sx = -(slopex(i,j)*drdsigmaltd(i,j)) |
12736 |
sy = -(slopey(i,j)*drdsigmaltd(i,j)) |
12737 |
smod = sx*sx+sy*sy |
12738 |
if (smod .ne. 0.) then |
12739 |
smod = sqrt(smod) |
12740 |
endif |
12741 |
f1 = 0.5*(1.+tanh((gm_scrit-smod)/gm_sd)) |
12742 |
adf1 = adf1+adslopey(i,j)*sy |
12743 |
adsy = adsy+adslopey(i,j)*f1 |
12744 |
adslopey(i,j) = 0.d0 |
12745 |
adf1 = adf1+adslopex(i,j)*sx |
12746 |
adsx = adsx+adslopex(i,j)*f1 |
12747 |
adslopex(i,j) = 0.d0 |
12748 |
adsmod = adsmod-0.5*adf1*(1./cosh((gm_scrit-smod)/gm_sd)**2/ |
12749 |
$gm_sd) |
12750 |
adf1 = 0.d0 |
12751 |
smod = sx*sx+sy*sy |
12752 |
if (smod .ne. 0.) then |
12753 |
adsmod = adsmod*(1./(2.*sqrt(smod))) |
12754 |
endif |
12755 |
adsx = adsx+2*adsmod*sx |
12756 |
adsy = adsy+2*adsmod*sy |
12757 |
adsmod = 0.d0 |
12758 |
addrdsigmaltd(i,j) = addrdsigmaltd(i,j)-adsy*slopey(i,j) |
12759 |
adslopey(i,j) = adslopey(i,j)-adsy*drdsigmaltd(i,j) |
12760 |
adsy = 0.d0 |
12761 |
addrdsigmaltd(i,j) = addrdsigmaltd(i,j)-adsx*slopex(i,j) |
12762 |
adslopex(i,j) = adslopex(i,j)-adsx*drdsigmaltd(i,j) |
12763 |
adsx = 0.d0 |
12764 |
if (dsigmadrltd .ne. 0.) then |
12765 |
addsigmadrltd = addsigmadrltd-addrdsigmaltd(i,j)/ |
12766 |
$(dsigmadrltd*dsigmadrltd) |
12767 |
addrdsigmaltd(i,j) = 0.d0 |
12768 |
else |
12769 |
addrdsigmaltd(i,j) = 0.d0 |
12770 |
endif |
12771 |
addsigmadrreal(i,j) = addsigmadrreal(i,j)+addsigmadrltd |
12772 |
addsigmadrltd = 0.d0 |
12773 |
end do |
12774 |
end do |
12775 |
else if (gm_taper_scheme .eq. 'ldd97') then |
12776 |
do j = 1-oly+1, sny+oly-1 |
12777 |
addsigmadrltd = 0.d0 |
12778 |
adf1 = 0.d0 |
12779 |
adsmod = 0.d0 |
12780 |
adsx = 0.d0 |
12781 |
do i = 1-olx+1, snx+olx-1 |
12782 |
addsigmadrltd = 0.d0 |
12783 |
adf1 = 0.d0 |
12784 |
adsmod = 0.d0 |
12785 |
adsx = 0.d0 |
12786 |
dsigmadrltd = dsigmadrreal(i,j) |
12787 |
if (dsigmadrltd .ne. 0.) then |
12788 |
drdsigmaltd(i,j) = 1./dsigmadrltd |
12789 |
else |
12790 |
drdsigmaltd(i,j) = 0. |
12791 |
endif |
12792 |
sx = -(slopey(i,j)*drdsigmaltd(i,j)) |
12793 |
smod = sx*sx+sy*sy |
12794 |
if (smod .ne. 0.) then |
12795 |
smod = sqrt(smod) |
12796 |
endif |
12797 |
f1 = 0.5*(1.+tanh((gm_scrit-smod)/gm_sd)) |
12798 |
adf1 = adf1+adslopey(i,j)*sy |
12799 |
adsy = adsy+adslopey(i,j)*f1 |
12800 |
adslopey(i,j) = 0.d0 |
12801 |
adf1 = adf1+adslopex(i,j)*sx |
12802 |
adsx = adsx+adslopex(i,j)*f1 |
12803 |
adslopex(i,j) = 0.d0 |
12804 |
adsmod = adsmod-0.5*adf1*(1./cosh((gm_scrit-smod)/gm_sd)**2/ |
12805 |
$gm_sd) |
12806 |
adf1 = 0.d0 |
12807 |
smod = sx*sx+sy*sy |
12808 |
if (smod .ne. 0.) then |
12809 |
adsmod = adsmod*(1./(2.*sqrt(smod))) |
12810 |
endif |
12811 |
adsx = adsx+2*adsmod*sx |
12812 |
adsy = adsy+2*adsmod*sy |
12813 |
adsmod = 0.d0 |
12814 |
addrdsigmaltd(i,j) = addrdsigmaltd(i,j)-adsx*slopey(i,j) |
12815 |
adslopey(i,j) = adslopey(i,j)-adsx*drdsigmaltd(i,j) |
12816 |
adsx = 0.d0 |
12817 |
if (dsigmadrltd .ne. 0.) then |
12818 |
addsigmadrltd = addsigmadrltd-addrdsigmaltd(i,j)/ |
12819 |
$(dsigmadrltd*dsigmadrltd) |
12820 |
addrdsigmaltd(i,j) = 0.d0 |
12821 |
else |
12822 |
addrdsigmaltd(i,j) = 0.d0 |
12823 |
endif |
12824 |
addsigmadrreal(i,j) = addsigmadrreal(i,j)+addsigmadrltd |
12825 |
addsigmadrltd = 0.d0 |
12826 |
end do |
12827 |
end do |
12828 |
else if (gm_taper_scheme .eq. ' ') then |
12829 |
do j = 1-oly+1, sny+oly-1 |
12830 |
addsigmadrltd = 0.d0 |
12831 |
do i = 1-olx+1, snx+olx-1 |
12832 |
addsigmadrltd = 0.d0 |
12833 |
dsigmadrltd = dsigmadrreal(i,j) |
12834 |
if (dsigmadrltd .ne. 0.) then |
12835 |
drdsigmaltd(i,j) = 1./dsigmadrltd |
12836 |
else |
12837 |
drdsigmaltd(i,j) = 0. |
12838 |
endif |
12839 |
addrdsigmaltd(i,j) = addrdsigmaltd(i,j)-adslopey(i,j)* |
12840 |
$slopey(i,j) |
12841 |
adslopey(i,j) = -(adslopey(i,j)*drdsigmaltd(i,j)) |
12842 |
addrdsigmaltd(i,j) = addrdsigmaltd(i,j)-adslopex(i,j)* |
12843 |
$slopex(i,j) |
12844 |
adslopex(i,j) = -(adslopex(i,j)*drdsigmaltd(i,j)) |
12845 |
if (dsigmadrltd .ne. 0.) then |
12846 |
addsigmadrltd = addsigmadrltd-addrdsigmaltd(i,j)/ |
12847 |
$(dsigmadrltd*dsigmadrltd) |
12848 |
addrdsigmaltd(i,j) = 0.d0 |
12849 |
else |
12850 |
addrdsigmaltd(i,j) = 0.d0 |
12851 |
endif |
12852 |
addsigmadrreal(i,j) = addsigmadrreal(i,j)+addsigmadrltd |
12853 |
addsigmadrltd = 0.d0 |
12854 |
end do |
12855 |
end do |
12856 |
endif |
12857 |
|
12858 |
end |
12859 |
|
12860 |
|
12861 |
subroutine adgmredi_xtransport( imin, imax, jmin, jmax, bi, bj, k, |
12862 |
$ xa, adtracer, addf ) |
12863 |
C*************************************************************** |
12864 |
C*************************************************************** |
12865 |
C** This routine was generated by the ** |
12866 |
C** Tangent linear and Adjoint Model Compiler, TAMC 5.2.14 ** |
12867 |
C*************************************************************** |
12868 |
C*************************************************************** |
12869 |
C============================================== |
12870 |
C all entries are defined explicitly |
12871 |
C============================================== |
12872 |
implicit none |
12873 |
|
12874 |
C============================================== |
12875 |
C define parameters |
12876 |
C============================================== |
12877 |
integer max_len_fnam |
12878 |
parameter ( max_len_fnam = 512 ) |
12879 |
integer nr |
12880 |
parameter ( nr = 15 ) |
12881 |
integer nsx |
12882 |
parameter ( nsx = 1 ) |
12883 |
integer nsy |
12884 |
parameter ( nsy = 1 ) |
12885 |
integer olx |
12886 |
parameter ( olx = 3 ) |
12887 |
integer oly |
12888 |
parameter ( oly = 3 ) |
12889 |
integer snx |
12890 |
parameter ( snx = 20 ) |
12891 |
integer sny |
12892 |
parameter ( sny = 40 ) |
12893 |
|
12894 |
C============================================== |
12895 |
C define common blocks |
12896 |
C============================================== |
12897 |
common /gm_params/ gm_background_k, gm_maxslope, gm_visbeck_alpha, |
12898 |
$ gm_visbeck_length, gm_visbeck_depth, gm_visbeck_maxval_k, |
12899 |
$gm_taper_scheme, gm_scrit, gm_sd |
12900 |
double precision gm_background_k |
12901 |
double precision gm_maxslope |
12902 |
double precision gm_scrit |
12903 |
double precision gm_sd |
12904 |
character*(max_len_fnam) gm_taper_scheme |
12905 |
double precision gm_visbeck_alpha |
12906 |
double precision gm_visbeck_depth |
12907 |
double precision gm_visbeck_length |
12908 |
double precision gm_visbeck_maxval_k |
12909 |
|
12910 |
common /grid_r/ dxc, dxf, dxg, dxv, dyc, dyf, dyg, dyu, drc, drf, |
12911 |
$h, hfacc, hfacw, hfacs, depthink, recip_dxc, recip_dxf, recip_dxg, |
12912 |
$ recip_dxv, recip_dyc, recip_dyf, recip_dyg, recip_dyu, recip_drc, |
12913 |
$ recip_drf, recip_h, recip_hfacc, recip_hfacw, recip_hfacs, rkfac, |
12914 |
$ recip_rkfac, safac, xc, yc, ra, raw, ras, raz, rc, rf, yc0, xc0, |
12915 |
$xg, yg, maskw, masks, recip_ra, recip_raw, recip_ras, recip_raz, |
12916 |
$tanphiatu, tanphiatv |
12917 |
double precision depthink(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
12918 |
double precision drc(1:nr) |
12919 |
double precision drf(1:nr) |
12920 |
double precision dxc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
12921 |
double precision dxf(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
12922 |
double precision dxg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
12923 |
double precision dxv(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
12924 |
double precision dyc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
12925 |
double precision dyf(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
12926 |
double precision dyg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
12927 |
double precision dyu(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
12928 |
double precision h(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
12929 |
double precision hfacc(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) |
12930 |
double precision hfacs(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) |
12931 |
double precision hfacw(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) |
12932 |
double precision masks(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) |
12933 |
double precision maskw(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) |
12934 |
double precision ra(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
12935 |
double precision ras(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
12936 |
double precision raw(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
12937 |
double precision raz(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
12938 |
double precision rc(1:nr) |
12939 |
double precision recip_drc(1:nr) |
12940 |
double precision recip_drf(1:nr) |
12941 |
double precision recip_dxc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
12942 |
double precision recip_dxf(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
12943 |
double precision recip_dxg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
12944 |
double precision recip_dxv(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
12945 |
double precision recip_dyc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
12946 |
double precision recip_dyf(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
12947 |
double precision recip_dyg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
12948 |
double precision recip_dyu(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
12949 |
double precision recip_h(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
12950 |
double precision recip_hfacc(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx, |
12951 |
$nsy) |
12952 |
double precision recip_hfacs(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx, |
12953 |
$nsy) |
12954 |
double precision recip_hfacw(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx, |
12955 |
$nsy) |
12956 |
double precision recip_ra(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
12957 |
double precision recip_ras(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
12958 |
double precision recip_raw(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
12959 |
double precision recip_raz(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
12960 |
double precision recip_rkfac |
12961 |
double precision rf(1:nr+1) |
12962 |
double precision rkfac |
12963 |
double precision safac(1:nr) |
12964 |
double precision tanphiatu(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
12965 |
double precision tanphiatv(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
12966 |
double precision xc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
12967 |
double precision xc0 |
12968 |
double precision xg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
12969 |
double precision yc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
12970 |
double precision yc0 |
12971 |
double precision yg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
12972 |
|
12973 |
common /parm_packages/ usekpp, usegmredi, useobcs, useaim, useecco |
12974 |
logical useaim |
12975 |
logical useecco |
12976 |
logical usegmredi |
12977 |
logical usekpp |
12978 |
logical useobcs |
12979 |
|
12980 |
C============================================== |
12981 |
C define arguments |
12982 |
C============================================== |
12983 |
double precision addf(1-olx:snx+olx,1-oly:sny+oly) |
12984 |
double precision adtracer(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
12985 |
integer bi |
12986 |
integer bj |
12987 |
integer imax |
12988 |
integer imin |
12989 |
integer jmax |
12990 |
integer jmin |
12991 |
integer k |
12992 |
double precision xa(1-olx:snx+olx,1-oly:sny+oly) |
12993 |
|
12994 |
C============================================== |
12995 |
C define local variables |
12996 |
C============================================== |
12997 |
integer i |
12998 |
integer j |
12999 |
|
13000 |
C---------------------------------------------- |
13001 |
C ROUTINE BODY |
13002 |
C---------------------------------------------- |
13003 |
if (usegmredi) then |
13004 |
do j = jmin, jmax |
13005 |
do i = imin, imax |
13006 |
adtracer(i-1,j,k,bi,bj) = adtracer(i-1,j,k,bi,bj)+addf(i,j)* |
13007 |
$xa(i,j)*gm_background_k*recip_dxc(i,j,bi,bj) |
13008 |
adtracer(i,j,k,bi,bj) = adtracer(i,j,k,bi,bj)-addf(i,j)* |
13009 |
$xa(i,j)*gm_background_k*recip_dxc(i,j,bi,bj) |
13010 |
end do |
13011 |
end do |
13012 |
endif |
13013 |
|
13014 |
end |
13015 |
|
13016 |
|
13017 |
subroutine adgmredi_ytransport( imin, imax, jmin, jmax, bi, bj, k, |
13018 |
$ ya, adtracer, addf ) |
13019 |
C*************************************************************** |
13020 |
C*************************************************************** |
13021 |
C** This routine was generated by the ** |
13022 |
C** Tangent linear and Adjoint Model Compiler, TAMC 5.2.14 ** |
13023 |
C*************************************************************** |
13024 |
C*************************************************************** |
13025 |
C============================================== |
13026 |
C all entries are defined explicitly |
13027 |
C============================================== |
13028 |
implicit none |
13029 |
|
13030 |
C============================================== |
13031 |
C define parameters |
13032 |
C============================================== |
13033 |
integer max_len_fnam |
13034 |
parameter ( max_len_fnam = 512 ) |
13035 |
integer nr |
13036 |
parameter ( nr = 15 ) |
13037 |
integer nsx |
13038 |
parameter ( nsx = 1 ) |
13039 |
integer nsy |
13040 |
parameter ( nsy = 1 ) |
13041 |
integer olx |
13042 |
parameter ( olx = 3 ) |
13043 |
integer oly |
13044 |
parameter ( oly = 3 ) |
13045 |
integer snx |
13046 |
parameter ( snx = 20 ) |
13047 |
integer sny |
13048 |
parameter ( sny = 40 ) |
13049 |
|
13050 |
C============================================== |
13051 |
C define common blocks |
13052 |
C============================================== |
13053 |
common /gm_params/ gm_background_k, gm_maxslope, gm_visbeck_alpha, |
13054 |
$ gm_visbeck_length, gm_visbeck_depth, gm_visbeck_maxval_k, |
13055 |
$gm_taper_scheme, gm_scrit, gm_sd |
13056 |
double precision gm_background_k |
13057 |
double precision gm_maxslope |
13058 |
double precision gm_scrit |
13059 |
double precision gm_sd |
13060 |
character*(max_len_fnam) gm_taper_scheme |
13061 |
double precision gm_visbeck_alpha |
13062 |
double precision gm_visbeck_depth |
13063 |
double precision gm_visbeck_length |
13064 |
double precision gm_visbeck_maxval_k |
13065 |
|
13066 |
common /grid_r/ dxc, dxf, dxg, dxv, dyc, dyf, dyg, dyu, drc, drf, |
13067 |
$h, hfacc, hfacw, hfacs, depthink, recip_dxc, recip_dxf, recip_dxg, |
13068 |
$ recip_dxv, recip_dyc, recip_dyf, recip_dyg, recip_dyu, recip_drc, |
13069 |
$ recip_drf, recip_h, recip_hfacc, recip_hfacw, recip_hfacs, rkfac, |
13070 |
$ recip_rkfac, safac, xc, yc, ra, raw, ras, raz, rc, rf, yc0, xc0, |
13071 |
$xg, yg, maskw, masks, recip_ra, recip_raw, recip_ras, recip_raz, |
13072 |
$tanphiatu, tanphiatv |
13073 |
double precision depthink(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
13074 |
double precision drc(1:nr) |
13075 |
double precision drf(1:nr) |
13076 |
double precision dxc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
13077 |
double precision dxf(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
13078 |
double precision dxg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
13079 |
double precision dxv(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
13080 |
double precision dyc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
13081 |
double precision dyf(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
13082 |
double precision dyg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
13083 |
double precision dyu(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
13084 |
double precision h(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
13085 |
double precision hfacc(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) |
13086 |
double precision hfacs(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) |
13087 |
double precision hfacw(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) |
13088 |
double precision masks(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) |
13089 |
double precision maskw(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) |
13090 |
double precision ra(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
13091 |
double precision ras(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
13092 |
double precision raw(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
13093 |
double precision raz(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
13094 |
double precision rc(1:nr) |
13095 |
double precision recip_drc(1:nr) |
13096 |
double precision recip_drf(1:nr) |
13097 |
double precision recip_dxc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
13098 |
double precision recip_dxf(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
13099 |
double precision recip_dxg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
13100 |
double precision recip_dxv(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
13101 |
double precision recip_dyc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
13102 |
double precision recip_dyf(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
13103 |
double precision recip_dyg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
13104 |
double precision recip_dyu(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
13105 |
double precision recip_h(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
13106 |
double precision recip_hfacc(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx, |
13107 |
$nsy) |
13108 |
double precision recip_hfacs(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx, |
13109 |
$nsy) |
13110 |
double precision recip_hfacw(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx, |
13111 |
$nsy) |
13112 |
double precision recip_ra(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
13113 |
double precision recip_ras(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
13114 |
double precision recip_raw(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
13115 |
double precision recip_raz(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
13116 |
double precision recip_rkfac |
13117 |
double precision rf(1:nr+1) |
13118 |
double precision rkfac |
13119 |
double precision safac(1:nr) |
13120 |
double precision tanphiatu(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
13121 |
double precision tanphiatv(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
13122 |
double precision xc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
13123 |
double precision xc0 |
13124 |
double precision xg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
13125 |
double precision yc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
13126 |
double precision yc0 |
13127 |
double precision yg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
13128 |
|
13129 |
common /parm_packages/ usekpp, usegmredi, useobcs, useaim, useecco |
13130 |
logical useaim |
13131 |
logical useecco |
13132 |
logical usegmredi |
13133 |
logical usekpp |
13134 |
logical useobcs |
13135 |
|
13136 |
C============================================== |
13137 |
C define arguments |
13138 |
C============================================== |
13139 |
double precision addf(1-olx:snx+olx,1-oly:sny+oly) |
13140 |
double precision adtracer(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
13141 |
integer bi |
13142 |
integer bj |
13143 |
integer imax |
13144 |
integer imin |
13145 |
integer jmax |
13146 |
integer jmin |
13147 |
integer k |
13148 |
double precision ya(1-olx:snx+olx,1-oly:sny+oly) |
13149 |
|
13150 |
C============================================== |
13151 |
C define local variables |
13152 |
C============================================== |
13153 |
integer i |
13154 |
integer j |
13155 |
|
13156 |
C---------------------------------------------- |
13157 |
C ROUTINE BODY |
13158 |
C---------------------------------------------- |
13159 |
if (usegmredi) then |
13160 |
do j = jmin, jmax |
13161 |
do i = imin, imax |
13162 |
adtracer(i,j-1,k,bi,bj) = adtracer(i,j-1,k,bi,bj)+addf(i,j)* |
13163 |
$ya(i,j)*gm_background_k*recip_dyc(i,j,bi,bj) |
13164 |
adtracer(i,j,k,bi,bj) = adtracer(i,j,k,bi,bj)-addf(i,j)* |
13165 |
$ya(i,j)*gm_background_k*recip_dyc(i,j,bi,bj) |
13166 |
end do |
13167 |
end do |
13168 |
endif |
13169 |
|
13170 |
end |
13171 |
|
13172 |
|
13173 |
subroutine adgrad_sigma( bi, bj, k, adrhok, adsigkm1, adsigkp1, |
13174 |
$adsigmax, adsigmay, adsigmar ) |
13175 |
C*************************************************************** |
13176 |
C*************************************************************** |
13177 |
C** This routine was generated by the ** |
13178 |
C** Tangent linear and Adjoint Model Compiler, TAMC 5.2.14 ** |
13179 |
C*************************************************************** |
13180 |
C*************************************************************** |
13181 |
C============================================== |
13182 |
C all entries are defined explicitly |
13183 |
C============================================== |
13184 |
implicit none |
13185 |
|
13186 |
C============================================== |
13187 |
C define parameters |
13188 |
C============================================== |
13189 |
integer nr |
13190 |
parameter ( nr = 15 ) |
13191 |
integer nsx |
13192 |
parameter ( nsx = 1 ) |
13193 |
integer nsy |
13194 |
parameter ( nsy = 1 ) |
13195 |
integer olx |
13196 |
parameter ( olx = 3 ) |
13197 |
integer oly |
13198 |
parameter ( oly = 3 ) |
13199 |
integer snx |
13200 |
parameter ( snx = 20 ) |
13201 |
integer sny |
13202 |
parameter ( sny = 40 ) |
13203 |
|
13204 |
C============================================== |
13205 |
C define common blocks |
13206 |
C============================================== |
13207 |
common /grid_r/ dxc, dxf, dxg, dxv, dyc, dyf, dyg, dyu, drc, drf, |
13208 |
$h, hfacc, hfacw, hfacs, depthink, recip_dxc, recip_dxf, recip_dxg, |
13209 |
$ recip_dxv, recip_dyc, recip_dyf, recip_dyg, recip_dyu, recip_drc, |
13210 |
$ recip_drf, recip_h, recip_hfacc, recip_hfacw, recip_hfacs, rkfac, |
13211 |
$ recip_rkfac, safac, xc, yc, ra, raw, ras, raz, rc, rf, yc0, xc0, |
13212 |
$xg, yg, maskw, masks, recip_ra, recip_raw, recip_ras, recip_raz, |
13213 |
$tanphiatu, tanphiatv |
13214 |
double precision depthink(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
13215 |
double precision drc(1:nr) |
13216 |
double precision drf(1:nr) |
13217 |
double precision dxc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
13218 |
double precision dxf(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
13219 |
double precision dxg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
13220 |
double precision dxv(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
13221 |
double precision dyc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
13222 |
double precision dyf(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
13223 |
double precision dyg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
13224 |
double precision dyu(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
13225 |
double precision h(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
13226 |
double precision hfacc(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) |
13227 |
double precision hfacs(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) |
13228 |
double precision hfacw(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) |
13229 |
double precision masks(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) |
13230 |
double precision maskw(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) |
13231 |
double precision ra(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
13232 |
double precision ras(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
13233 |
double precision raw(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
13234 |
double precision raz(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
13235 |
double precision rc(1:nr) |
13236 |
double precision recip_drc(1:nr) |
13237 |
double precision recip_drf(1:nr) |
13238 |
double precision recip_dxc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
13239 |
double precision recip_dxf(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
13240 |
double precision recip_dxg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
13241 |
double precision recip_dxv(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
13242 |
double precision recip_dyc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
13243 |
double precision recip_dyf(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
13244 |
double precision recip_dyg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
13245 |
double precision recip_dyu(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
13246 |
double precision recip_h(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
13247 |
double precision recip_hfacc(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx, |
13248 |
$nsy) |
13249 |
double precision recip_hfacs(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx, |
13250 |
$nsy) |
13251 |
double precision recip_hfacw(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx, |
13252 |
$nsy) |
13253 |
double precision recip_ra(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
13254 |
double precision recip_ras(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
13255 |
double precision recip_raw(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
13256 |
double precision recip_raz(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
13257 |
double precision recip_rkfac |
13258 |
double precision rf(1:nr+1) |
13259 |
double precision rkfac |
13260 |
double precision safac(1:nr) |
13261 |
double precision tanphiatu(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
13262 |
double precision tanphiatv(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
13263 |
double precision xc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
13264 |
double precision xc0 |
13265 |
double precision xg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
13266 |
double precision yc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
13267 |
double precision yc0 |
13268 |
double precision yg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
13269 |
|
13270 |
C============================================== |
13271 |
C define arguments |
13272 |
C============================================== |
13273 |
double precision adrhok(1-olx:snx+olx,1-oly:sny+oly) |
13274 |
double precision adsigkm1(1-olx:snx+olx,1-oly:sny+oly) |
13275 |
double precision adsigkp1(1-olx:snx+olx,1-oly:sny+oly) |
13276 |
double precision adsigmar(1-olx:snx+olx,1-oly:sny+oly,nr) |
13277 |
double precision adsigmax(1-olx:snx+olx,1-oly:sny+oly,nr) |
13278 |
double precision adsigmay(1-olx:snx+olx,1-oly:sny+oly,nr) |
13279 |
integer bi |
13280 |
integer bj |
13281 |
integer k |
13282 |
|
13283 |
C============================================== |
13284 |
C define local variables |
13285 |
C============================================== |
13286 |
integer i |
13287 |
integer j |
13288 |
|
13289 |
C---------------------------------------------- |
13290 |
C ROUTINE BODY |
13291 |
C---------------------------------------------- |
13292 |
do j = 1-oly, sny+oly |
13293 |
do i = 1-olx, snx+olx |
13294 |
if (k .ne. 1 .and. hfacc(i,j,k,bi,bj) .ne. 0.) then |
13295 |
adsigkm1(i,j) = adsigkm1(i,j)+adsigmar(i,j,k)*recip_drc(k)* |
13296 |
$rkfac |
13297 |
adsigkp1(i,j) = adsigkp1(i,j)-adsigmar(i,j,k)*recip_drc(k)* |
13298 |
$rkfac |
13299 |
adsigmar(i,j,k) = 0.d0 |
13300 |
else |
13301 |
adsigmar(i,j,k) = 0.d0 |
13302 |
endif |
13303 |
end do |
13304 |
end do |
13305 |
do j = 1-oly+1, sny+oly |
13306 |
do i = 1-olx, snx+olx |
13307 |
adrhok(i,j-1) = adrhok(i,j-1)-adsigmay(i,j,k)*masks(i,j,k,bi, |
13308 |
$bj)*recip_dyc(i,j,bi,bj) |
13309 |
adrhok(i,j) = adrhok(i,j)+adsigmay(i,j,k)*masks(i,j,k,bi,bj)* |
13310 |
$recip_dyc(i,j,bi,bj) |
13311 |
adsigmay(i,j,k) = 0.d0 |
13312 |
end do |
13313 |
end do |
13314 |
do j = 1-oly, sny+oly |
13315 |
do i = 1-olx+1, snx+olx |
13316 |
adrhok(i-1,j) = adrhok(i-1,j)-adsigmax(i,j,k)*maskw(i,j,k,bi, |
13317 |
$bj)*recip_dxc(i,j,bi,bj) |
13318 |
adrhok(i,j) = adrhok(i,j)+adsigmax(i,j,k)*maskw(i,j,k,bi,bj)* |
13319 |
$recip_dxc(i,j,bi,bj) |
13320 |
adsigmax(i,j,k) = 0.d0 |
13321 |
end do |
13322 |
end do |
13323 |
|
13324 |
end |
13325 |
|
13326 |
|
13327 |
subroutine adimpldiff( bi, bj, imin, imax, jmin, jmax, deltatx, |
13328 |
$kapparx, recip_hfac, gxnm1, adkapparx, adgxnm1 ) |
13329 |
C*************************************************************** |
13330 |
C*************************************************************** |
13331 |
C** This routine was generated by the ** |
13332 |
C** Tangent linear and Adjoint Model Compiler, TAMC 5.2.14 ** |
13333 |
C*************************************************************** |
13334 |
C*************************************************************** |
13335 |
C============================================== |
13336 |
C all entries are defined explicitly |
13337 |
C============================================== |
13338 |
implicit none |
13339 |
|
13340 |
C============================================== |
13341 |
C define parameters |
13342 |
C============================================== |
13343 |
integer nr |
13344 |
parameter ( nr = 15 ) |
13345 |
integer nsx |
13346 |
parameter ( nsx = 1 ) |
13347 |
integer nsy |
13348 |
parameter ( nsy = 1 ) |
13349 |
integer olx |
13350 |
parameter ( olx = 3 ) |
13351 |
integer oly |
13352 |
parameter ( oly = 3 ) |
13353 |
integer snx |
13354 |
parameter ( snx = 20 ) |
13355 |
integer sny |
13356 |
parameter ( sny = 40 ) |
13357 |
|
13358 |
C============================================== |
13359 |
C define common blocks |
13360 |
C============================================== |
13361 |
common /grid_r/ dxc, dxf, dxg, dxv, dyc, dyf, dyg, dyu, drc, drf, |
13362 |
$h, hfacc, hfacw, hfacs, depthink, recip_dxc, recip_dxf, recip_dxg, |
13363 |
$ recip_dxv, recip_dyc, recip_dyf, recip_dyg, recip_dyu, recip_drc, |
13364 |
$ recip_drf, recip_h, recip_hfacc, recip_hfacw, recip_hfacs, rkfac, |
13365 |
$ recip_rkfac, safac, xc, yc, ra, raw, ras, raz, rc, rf, yc0, xc0, |
13366 |
$xg, yg, maskw, masks, recip_ra, recip_raw, recip_ras, recip_raz, |
13367 |
$tanphiatu, tanphiatv |
13368 |
double precision depthink(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
13369 |
double precision drc(1:nr) |
13370 |
double precision drf(1:nr) |
13371 |
double precision dxc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
13372 |
double precision dxf(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
13373 |
double precision dxg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
13374 |
double precision dxv(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
13375 |
double precision dyc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
13376 |
double precision dyf(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
13377 |
double precision dyg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
13378 |
double precision dyu(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
13379 |
double precision h(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
13380 |
double precision hfacc(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) |
13381 |
double precision hfacs(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) |
13382 |
double precision hfacw(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) |
13383 |
double precision masks(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) |
13384 |
double precision maskw(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) |
13385 |
double precision ra(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
13386 |
double precision ras(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
13387 |
double precision raw(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
13388 |
double precision raz(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
13389 |
double precision rc(1:nr) |
13390 |
double precision recip_drc(1:nr) |
13391 |
double precision recip_drf(1:nr) |
13392 |
double precision recip_dxc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
13393 |
double precision recip_dxf(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
13394 |
double precision recip_dxg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
13395 |
double precision recip_dxv(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
13396 |
double precision recip_dyc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
13397 |
double precision recip_dyf(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
13398 |
double precision recip_dyg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
13399 |
double precision recip_dyu(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
13400 |
double precision recip_h(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
13401 |
double precision recip_hfacc(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx, |
13402 |
$nsy) |
13403 |
double precision recip_hfacs(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx, |
13404 |
$nsy) |
13405 |
double precision recip_hfacw(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx, |
13406 |
$nsy) |
13407 |
double precision recip_ra(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
13408 |
double precision recip_ras(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
13409 |
double precision recip_raw(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
13410 |
double precision recip_raz(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
13411 |
double precision recip_rkfac |
13412 |
double precision rf(1:nr+1) |
13413 |
double precision rkfac |
13414 |
double precision safac(1:nr) |
13415 |
double precision tanphiatu(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
13416 |
double precision tanphiatv(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
13417 |
double precision xc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
13418 |
double precision xc0 |
13419 |
double precision xg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
13420 |
double precision yc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
13421 |
double precision yc0 |
13422 |
double precision yg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
13423 |
|
13424 |
C============================================== |
13425 |
C define arguments |
13426 |
C============================================== |
13427 |
double precision adgxnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
13428 |
double precision adkapparx(1-olx:snx+olx,1-oly:sny+oly,nr) |
13429 |
integer bi |
13430 |
integer bj |
13431 |
double precision deltatx |
13432 |
double precision gxnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
13433 |
integer imax |
13434 |
integer imin |
13435 |
integer jmax |
13436 |
integer jmin |
13437 |
double precision kapparx(1-olx:snx+olx,1-oly:sny+oly,nr) |
13438 |
double precision recip_hfac(1-olx:snx+olx,1-oly:sny+oly,nr,nsx, |
13439 |
$nsy) |
13440 |
|
13441 |
C============================================== |
13442 |
C define local variables |
13443 |
C============================================== |
13444 |
double precision a(1-olx:snx+olx,1-oly:sny+oly,nr) |
13445 |
double precision ada(1-olx:snx+olx,1-oly:sny+oly,nr) |
13446 |
double precision adb(1-olx:snx+olx,1-oly:sny+oly,nr) |
13447 |
double precision adbet(1-olx:snx+olx,1-oly:sny+oly,nr) |
13448 |
double precision adc(1-olx:snx+olx,1-oly:sny+oly,nr) |
13449 |
double precision adgam(1-olx:snx+olx,1-oly:sny+oly,nr) |
13450 |
double precision adgynm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
13451 |
double precision b(1-olx:snx+olx,1-oly:sny+oly,nr) |
13452 |
double precision bet(1-olx:snx+olx,1-oly:sny+oly,nr) |
13453 |
double precision c(1-olx:snx+olx,1-oly:sny+oly,nr) |
13454 |
double precision gam(1-olx:snx+olx,1-oly:sny+oly,nr) |
13455 |
double precision gynm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
13456 |
integer i |
13457 |
integer ip1 |
13458 |
integer ip2 |
13459 |
integer ip3 |
13460 |
integer ip4 |
13461 |
integer ip5 |
13462 |
integer j |
13463 |
integer k |
13464 |
|
13465 |
C---------------------------------------------- |
13466 |
C RESET LOCAL ADJOINT VARIABLES |
13467 |
C---------------------------------------------- |
13468 |
do ip3 = 1, nr |
13469 |
do ip2 = 1-oly, sny+oly |
13470 |
do ip1 = 1-olx, snx+olx |
13471 |
ada(ip1,ip2,ip3) = 0.d0 |
13472 |
end do |
13473 |
end do |
13474 |
end do |
13475 |
do ip3 = 1, nr |
13476 |
do ip2 = 1-oly, sny+oly |
13477 |
do ip1 = 1-olx, snx+olx |
13478 |
adb(ip1,ip2,ip3) = 0.d0 |
13479 |
end do |
13480 |
end do |
13481 |
end do |
13482 |
do ip3 = 1, nr |
13483 |
do ip2 = 1-oly, sny+oly |
13484 |
do ip1 = 1-olx, snx+olx |
13485 |
adbet(ip1,ip2,ip3) = 0.d0 |
13486 |
end do |
13487 |
end do |
13488 |
end do |
13489 |
do ip3 = 1, nr |
13490 |
do ip2 = 1-oly, sny+oly |
13491 |
do ip1 = 1-olx, snx+olx |
13492 |
adc(ip1,ip2,ip3) = 0.d0 |
13493 |
end do |
13494 |
end do |
13495 |
end do |
13496 |
do ip3 = 1, nr |
13497 |
do ip2 = 1-oly, sny+oly |
13498 |
do ip1 = 1-olx, snx+olx |
13499 |
adgam(ip1,ip2,ip3) = 0.d0 |
13500 |
end do |
13501 |
end do |
13502 |
end do |
13503 |
do ip5 = 1, nsy |
13504 |
do ip4 = 1, nsx |
13505 |
do ip3 = 1, nr |
13506 |
do ip2 = 1-oly, sny+oly |
13507 |
do ip1 = 1-olx, snx+olx |
13508 |
adgynm1(ip1,ip2,ip3,ip4,ip5) = 0.d0 |
13509 |
end do |
13510 |
end do |
13511 |
end do |
13512 |
end do |
13513 |
end do |
13514 |
|
13515 |
C---------------------------------------------- |
13516 |
C ROUTINE BODY |
13517 |
C---------------------------------------------- |
13518 |
do k = 1, nr |
13519 |
do j = jmin, jmax |
13520 |
do i = imin, imax |
13521 |
gynm1(i,j,k,bi,bj) = 0.d0 |
13522 |
end do |
13523 |
end do |
13524 |
end do |
13525 |
do j = jmin, jmax |
13526 |
do i = imin, imax |
13527 |
a(i,j,1) = 0.d0 |
13528 |
end do |
13529 |
end do |
13530 |
do k = 2, nr |
13531 |
do j = jmin, jmax |
13532 |
do i = imin, imax |
13533 |
a(i,j,k) = -(deltatx*recip_hfac(i,j,k,bi,bj)*recip_drf(k)* |
13534 |
$kapparx(i,j,k)*recip_drc(k)) |
13535 |
end do |
13536 |
end do |
13537 |
end do |
13538 |
do k = 1, nr-1 |
13539 |
do j = jmin, jmax |
13540 |
do i = imin, imax |
13541 |
c(i,j,k) = -(deltatx*recip_hfac(i,j,k,bi,bj)*recip_drf(k)* |
13542 |
$kapparx(i,j,k+1)*recip_drc(k+1)) |
13543 |
if (recip_hfac(i,j,k+1,bi,bj) .eq. 0.) then |
13544 |
c(i,j,k) = 0. |
13545 |
endif |
13546 |
end do |
13547 |
end do |
13548 |
end do |
13549 |
do j = jmin, jmax |
13550 |
do i = imin, imax |
13551 |
c(i,j,nr) = 0.d0 |
13552 |
end do |
13553 |
end do |
13554 |
do k = 1, nr |
13555 |
do j = jmin, jmax |
13556 |
do i = imin, imax |
13557 |
b(i,j,k) = 1.d0-c(i,j,k)-a(i,j,k) |
13558 |
end do |
13559 |
end do |
13560 |
end do |
13561 |
do k = 1, nr |
13562 |
do j = jmin, jmax |
13563 |
do i = imin, imax |
13564 |
bet(i,j,k) = 0.d0 |
13565 |
gam(i,j,k) = 0.d0 |
13566 |
end do |
13567 |
end do |
13568 |
end do |
13569 |
if (nr .gt. 1) then |
13570 |
do j = jmin, jmax |
13571 |
do i = imin, imax |
13572 |
if (b(i,j,1) .ne. 0.) then |
13573 |
bet(i,j,1) = 1.d0/b(i,j,1) |
13574 |
endif |
13575 |
end do |
13576 |
end do |
13577 |
endif |
13578 |
if (nr .gt. 2) then |
13579 |
do k = 2, nr |
13580 |
do j = jmin, jmax |
13581 |
do i = imin, imax |
13582 |
gam(i,j,k) = c(i,j,k-1)*bet(i,j,k-1) |
13583 |
if (b(i,j,k)-a(i,j,k)*gam(i,j,k) .ne. 0.) then |
13584 |
bet(i,j,k) = 1.d0/(b(i,j,k)-a(i,j,k)*gam(i,j,k)) |
13585 |
endif |
13586 |
end do |
13587 |
end do |
13588 |
end do |
13589 |
endif |
13590 |
do j = jmin, jmax |
13591 |
do i = imin, imax |
13592 |
gynm1(i,j,1,bi,bj) = gxnm1(i,j,1,bi,bj)*bet(i,j,1) |
13593 |
end do |
13594 |
end do |
13595 |
do k = 2, nr |
13596 |
do j = jmin, jmax |
13597 |
do i = imin, imax |
13598 |
gynm1(i,j,k,bi,bj) = bet(i,j,k)*(gxnm1(i,j,k,bi,bj)-a(i,j,k) |
13599 |
$*gynm1(i,j,k-1,bi,bj)) |
13600 |
end do |
13601 |
end do |
13602 |
end do |
13603 |
do k = 1, nr |
13604 |
do j = jmin, jmax |
13605 |
do i = imin, imax |
13606 |
adgynm1(i,j,k,bi,bj) = adgynm1(i,j,k,bi,bj)+adgxnm1(i,j,k, |
13607 |
$bi,bj) |
13608 |
adgxnm1(i,j,k,bi,bj) = 0.d0 |
13609 |
end do |
13610 |
end do |
13611 |
end do |
13612 |
do k = nr-1, 2, -1 |
13613 |
do j = jmin, jmax |
13614 |
do i = imin, imax |
13615 |
gynm1(i,j,k,bi,bj) = gynm1(i,j,k,bi,bj)-gam(i,j,k+1)* |
13616 |
$gynm1(i,j,k+1,bi,bj) |
13617 |
end do |
13618 |
end do |
13619 |
end do |
13620 |
do k = 1, nr-1 |
13621 |
do j = jmin, jmax |
13622 |
do i = imin, imax |
13623 |
adgam(i,j,k+1) = adgam(i,j,k+1)-adgynm1(i,j,k,bi,bj)* |
13624 |
$gynm1(i,j,k+1,bi,bj) |
13625 |
adgynm1(i,j,k+1,bi,bj) = adgynm1(i,j,k+1,bi,bj)-adgynm1(i,j, |
13626 |
$k,bi,bj)*gam(i,j,k+1) |
13627 |
end do |
13628 |
end do |
13629 |
end do |
13630 |
do j = jmin, jmax |
13631 |
do i = imin, imax |
13632 |
gynm1(i,j,1,bi,bj) = gxnm1(i,j,1,bi,bj)*bet(i,j,1) |
13633 |
end do |
13634 |
end do |
13635 |
do k = 2, nr-1 |
13636 |
do j = jmin, jmax |
13637 |
do i = imin, imax |
13638 |
gynm1(i,j,k,bi,bj) = bet(i,j,k)*(gxnm1(i,j,k,bi,bj)-a(i,j,k) |
13639 |
$*gynm1(i,j,k-1,bi,bj)) |
13640 |
end do |
13641 |
end do |
13642 |
end do |
13643 |
do k = nr, 2, -1 |
13644 |
do j = jmin, jmax |
13645 |
do i = imin, imax |
13646 |
ada(i,j,k) = ada(i,j,k)-adgynm1(i,j,k,bi,bj)*bet(i,j,k)* |
13647 |
$gynm1(i,j,k-1,bi,bj) |
13648 |
adbet(i,j,k) = adbet(i,j,k)+adgynm1(i,j,k,bi,bj)*(gxnm1(i,j, |
13649 |
$k,bi,bj)-a(i,j,k)*gynm1(i,j,k-1,bi,bj)) |
13650 |
adgxnm1(i,j,k,bi,bj) = adgxnm1(i,j,k,bi,bj)+adgynm1(i,j,k, |
13651 |
$bi,bj)*bet(i,j,k) |
13652 |
adgynm1(i,j,k-1,bi,bj) = adgynm1(i,j,k-1,bi,bj)-adgynm1(i,j, |
13653 |
$k,bi,bj)*bet(i,j,k)*a(i,j,k) |
13654 |
adgynm1(i,j,k,bi,bj) = 0.d0 |
13655 |
end do |
13656 |
end do |
13657 |
end do |
13658 |
do j = jmin, jmax |
13659 |
do i = imin, imax |
13660 |
adbet(i,j,1) = adbet(i,j,1)+adgynm1(i,j,1,bi,bj)*gxnm1(i,j,1, |
13661 |
$bi,bj) |
13662 |
adgxnm1(i,j,1,bi,bj) = adgxnm1(i,j,1,bi,bj)+adgynm1(i,j,1,bi, |
13663 |
$bj)*bet(i,j,1) |
13664 |
adgynm1(i,j,1,bi,bj) = 0.d0 |
13665 |
end do |
13666 |
end do |
13667 |
do k = 1, nr |
13668 |
do j = jmin, jmax |
13669 |
do i = imin, imax |
13670 |
bet(i,j,k) = 0.d0 |
13671 |
gam(i,j,k) = 0.d0 |
13672 |
end do |
13673 |
end do |
13674 |
end do |
13675 |
if (nr .gt. 1) then |
13676 |
do j = jmin, jmax |
13677 |
do i = imin, imax |
13678 |
if (b(i,j,1) .ne. 0.) then |
13679 |
bet(i,j,1) = 1.d0/b(i,j,1) |
13680 |
endif |
13681 |
end do |
13682 |
end do |
13683 |
endif |
13684 |
if (nr .gt. 2) then |
13685 |
do k = 2, nr-1 |
13686 |
do j = jmin, jmax |
13687 |
do i = imin, imax |
13688 |
gam(i,j,k) = c(i,j,k-1)*bet(i,j,k-1) |
13689 |
if (b(i,j,k)-a(i,j,k)*gam(i,j,k) .ne. 0.) then |
13690 |
bet(i,j,k) = 1.d0/(b(i,j,k)-a(i,j,k)*gam(i,j,k)) |
13691 |
endif |
13692 |
end do |
13693 |
end do |
13694 |
end do |
13695 |
do k = nr, 2, -1 |
13696 |
do j = jmin, jmax |
13697 |
do i = imin, imax |
13698 |
gam(i,j,k) = c(i,j,k-1)*bet(i,j,k-1) |
13699 |
if (b(i,j,k)-a(i,j,k)*gam(i,j,k) .ne. 0.) then |
13700 |
ada(i,j,k) = ada(i,j,k)+adbet(i,j,k)*(1.d0*gam(i,j,k)/ |
13701 |
$((b(i,j,k)-a(i,j,k)*gam(i,j,k))*(b(i,j,k)-a(i,j,k)*gam(i,j,k)))) |
13702 |
adb(i,j,k) = adb(i,j,k)-adbet(i,j,k)/((b(i,j,k)-a(i,j,k) |
13703 |
$*gam(i,j,k))*(b(i,j,k)-a(i,j,k)*gam(i,j,k))) |
13704 |
adgam(i,j,k) = adgam(i,j,k)+adbet(i,j,k)*(1.d0*a(i,j,k)/ |
13705 |
$((b(i,j,k)-a(i,j,k)*gam(i,j,k))*(b(i,j,k)-a(i,j,k)*gam(i,j,k)))) |
13706 |
adbet(i,j,k) = 0.d0 |
13707 |
endif |
13708 |
adbet(i,j,k-1) = adbet(i,j,k-1)+adgam(i,j,k)*c(i,j,k-1) |
13709 |
adc(i,j,k-1) = adc(i,j,k-1)+adgam(i,j,k)*bet(i,j,k-1) |
13710 |
adgam(i,j,k) = 0.d0 |
13711 |
end do |
13712 |
end do |
13713 |
end do |
13714 |
endif |
13715 |
if (nr .gt. 1) then |
13716 |
do j = jmin, jmax |
13717 |
do i = imin, imax |
13718 |
if (b(i,j,1) .ne. 0.) then |
13719 |
adb(i,j,1) = adb(i,j,1)-adbet(i,j,1)/(b(i,j,1)*b(i,j,1)) |
13720 |
adbet(i,j,1) = 0.d0 |
13721 |
endif |
13722 |
end do |
13723 |
end do |
13724 |
endif |
13725 |
do k = 1, nr |
13726 |
do j = jmin, jmax |
13727 |
do i = imin, imax |
13728 |
ada(i,j,k) = ada(i,j,k)-adb(i,j,k) |
13729 |
adc(i,j,k) = adc(i,j,k)-adb(i,j,k) |
13730 |
adb(i,j,k) = 0.d0 |
13731 |
end do |
13732 |
end do |
13733 |
end do |
13734 |
do j = jmin, jmax |
13735 |
do i = imin, imax |
13736 |
adc(i,j,nr) = 0.d0 |
13737 |
end do |
13738 |
end do |
13739 |
do k = 1, nr-1 |
13740 |
do j = jmin, jmax |
13741 |
do i = imin, imax |
13742 |
if (recip_hfac(i,j,k+1,bi,bj) .eq. 0.) then |
13743 |
adc(i,j,k) = 0.d0 |
13744 |
endif |
13745 |
adkapparx(i,j,k+1) = adkapparx(i,j,k+1)-adc(i,j,k)*deltatx* |
13746 |
$recip_hfac(i,j,k,bi,bj)*recip_drf(k)*recip_drc(k+1) |
13747 |
adc(i,j,k) = 0.d0 |
13748 |
end do |
13749 |
end do |
13750 |
end do |
13751 |
do k = 2, nr |
13752 |
do j = jmin, jmax |
13753 |
do i = imin, imax |
13754 |
adkapparx(i,j,k) = adkapparx(i,j,k)-ada(i,j,k)*deltatx* |
13755 |
$recip_hfac(i,j,k,bi,bj)*recip_drf(k)*recip_drc(k) |
13756 |
ada(i,j,k) = 0.d0 |
13757 |
end do |
13758 |
end do |
13759 |
end do |
13760 |
|
13761 |
end |
13762 |
|
13763 |
|
13764 |
subroutine mdinitialise_varia( mythid ) |
13765 |
C*************************************************************** |
13766 |
C*************************************************************** |
13767 |
C** This routine was generated by the ** |
13768 |
C** Tangent linear and Adjoint Model Compiler, TAMC 5.2.14 ** |
13769 |
C*************************************************************** |
13770 |
C*************************************************************** |
13771 |
C============================================== |
13772 |
C all entries are defined explicitly |
13773 |
C============================================== |
13774 |
implicit none |
13775 |
|
13776 |
C============================================== |
13777 |
C define parameters |
13778 |
C============================================== |
13779 |
integer max_no_threads |
13780 |
parameter ( max_no_threads = 32 ) |
13781 |
integer npx |
13782 |
parameter ( npx = 1 ) |
13783 |
integer npy |
13784 |
parameter ( npy = 1 ) |
13785 |
integer nr |
13786 |
parameter ( nr = 15 ) |
13787 |
integer nsx |
13788 |
parameter ( nsx = 1 ) |
13789 |
integer nsy |
13790 |
parameter ( nsy = 1 ) |
13791 |
integer snx |
13792 |
parameter ( snx = 20 ) |
13793 |
integer nx |
13794 |
parameter ( nx = snx*nsx*npx ) |
13795 |
integer sny |
13796 |
parameter ( sny = 40 ) |
13797 |
integer ny |
13798 |
parameter ( ny = sny*nsy*npy ) |
13799 |
integer olx |
13800 |
parameter ( olx = 3 ) |
13801 |
integer oly |
13802 |
parameter ( oly = 3 ) |
13803 |
|
13804 |
C============================================== |
13805 |
C define common blocks |
13806 |
C============================================== |
13807 |
common /eeparams_i/ errormessageunit, standardmessageunit, |
13808 |
$scrunit1, scrunit2, eedataunit, modeldataunit, numberofprocs, |
13809 |
$pidio, myprocid, mypx, mypy, myxgloballo, myygloballo, nthreads, |
13810 |
$mybxlo, mybxhi, mybylo, mybyhi, ntx, nty, ioerrorcount |
13811 |
integer eedataunit |
13812 |
integer errormessageunit |
13813 |
integer ioerrorcount(max_no_threads) |
13814 |
integer modeldataunit |
13815 |
integer mybxhi(max_no_threads) |
13816 |
integer mybxlo(max_no_threads) |
13817 |
integer mybyhi(max_no_threads) |
13818 |
integer mybylo(max_no_threads) |
13819 |
integer myprocid |
13820 |
integer mypx |
13821 |
integer mypy |
13822 |
integer myxgloballo |
13823 |
integer myygloballo |
13824 |
integer nthreads |
13825 |
integer ntx |
13826 |
integer nty |
13827 |
integer numberofprocs |
13828 |
integer pidio |
13829 |
integer scrunit1 |
13830 |
integer scrunit2 |
13831 |
integer standardmessageunit |
13832 |
|
13833 |
common /parm_i/ cg2dmaxiters, cg2dchkresfreq, cg3dmaxiters, |
13834 |
$cg3dchkresfreq, niter0, ntimesteps, nenditer, numstepsperpickup, |
13835 |
$writestateprec, nchecklev, writebinaryprec, readbinaryprec, nshap, |
13836 |
$ zonal_filt_sinpow, zonal_filt_cospow |
13837 |
integer cg2dchkresfreq |
13838 |
integer cg2dmaxiters |
13839 |
integer cg3dchkresfreq |
13840 |
integer cg3dmaxiters |
13841 |
integer nchecklev |
13842 |
integer nenditer |
13843 |
integer niter0 |
13844 |
integer nshap |
13845 |
integer ntimesteps |
13846 |
integer numstepsperpickup |
13847 |
integer readbinaryprec |
13848 |
integer writebinaryprec |
13849 |
integer writestateprec |
13850 |
integer zonal_filt_cospow |
13851 |
integer zonal_filt_sinpow |
13852 |
|
13853 |
common /parm_l/ usingcartesiangrid, usingsphericalpolargrid, |
13854 |
$no_slip_sides, no_slip_bottom, staggertimestep, momviscosity, |
13855 |
$momadvection, momforcing, usecoriolis, mompressureforcing, |
13856 |
$tempdiffusion, tempadvection, tempforcing, saltdiffusion, |
13857 |
$saltadvection, saltforcing, implicitfreesurface, rigidlid, |
13858 |
$momstepping, tempstepping, saltstepping, metricterms, |
13859 |
$usingsphericalpolarmterms, useconstantf, usebetaplanef, |
13860 |
$usespheref, implicitdiffusion, implicitviscosity, |
13861 |
$dothetaclimrelax, dosaltclimrelax, periodicexternalforcing, |
13862 |
$usingpcoords, usingzcoords, nonhydrostatic, globalfiles, |
13863 |
$allowfreezing, groundatk1, usepickupbeforec35 |
13864 |
logical allowfreezing |
13865 |
logical dosaltclimrelax |
13866 |
logical dothetaclimrelax |
13867 |
logical globalfiles |
13868 |
logical groundatk1 |
13869 |
logical implicitdiffusion |
13870 |
logical implicitfreesurface |
13871 |
logical implicitviscosity |
13872 |
logical metricterms |
13873 |
logical momadvection |
13874 |
logical momforcing |
13875 |
logical mompressureforcing |
13876 |
logical momstepping |
13877 |
logical momviscosity |
13878 |
logical no_slip_bottom |
13879 |
logical no_slip_sides |
13880 |
logical nonhydrostatic |
13881 |
logical periodicexternalforcing |
13882 |
logical rigidlid |
13883 |
logical saltadvection |
13884 |
logical saltdiffusion |
13885 |
logical saltforcing |
13886 |
logical saltstepping |
13887 |
logical staggertimestep |
13888 |
logical tempadvection |
13889 |
logical tempdiffusion |
13890 |
logical tempforcing |
13891 |
logical tempstepping |
13892 |
logical usebetaplanef |
13893 |
logical useconstantf |
13894 |
logical usecoriolis |
13895 |
logical usepickupbeforec35 |
13896 |
logical usespheref |
13897 |
logical usingcartesiangrid |
13898 |
logical usingpcoords |
13899 |
logical usingsphericalpolargrid |
13900 |
logical usingsphericalpolarmterms |
13901 |
logical usingzcoords |
13902 |
|
13903 |
common /parm_r/ cg2dtargetresidual, cg2dpcoffdfac, |
13904 |
$cg3dtargetresidual, delp, delz, delr, delx, dely, deltat, |
13905 |
$deltatmom, deltattracer, deltatclock, abeps, starttime, phimin, |
13906 |
$thetamin, rsphere, recip_rsphere, f0, fcori, beta, viscah, viscaz, |
13907 |
$ visca4, viscar, diffkht, diffkzt, diffk4t, diffkrt, diffkhs, |
13908 |
$diffkzs, diffk4s, diffkrs, delt, taucd, rcd, freesurffac, |
13909 |
$implicsurfpress, implicdiv2dflow, hfacmin, hfacmindz, gravity, |
13910 |
$recip_gravity, gbaro, rhonil, recip_rhonil, recip_rhoconst, |
13911 |
$rhoconst, tref, sref, endtime, chkptfreq, pchkptfreq, dumpfreq, |
13912 |
$tavefreq, affacmom, vffacmom, pffacmom, cffacmom, fofacmom, |
13913 |
$mtfacmom, cospower, cadjfreq, omega, tauthetaclimrelax, |
13914 |
$lambdathetaclimrelax, tausaltclimrelax, lambdasaltclimrelax, |
13915 |
$externforcingcycle, externforcingperiod, viscap, diffkpt, diffkps, |
13916 |
$ hfacmindr, hfacmindp, theta_s, specvol_s, horivertratio, |
13917 |
$recip_horivertratio, latfftfiltlo, ivdc_kappa, ro_sealevel, |
13918 |
$zonal_filt_lat, bottomdraglinear, bottomdragquadratic |
13919 |
double precision abeps |
13920 |
double precision affacmom |
13921 |
double precision beta |
13922 |
double precision bottomdraglinear |
13923 |
double precision bottomdragquadratic |
13924 |
double precision cadjfreq |
13925 |
double precision cffacmom |
13926 |
double precision cg2dpcoffdfac |
13927 |
double precision cg2dtargetresidual |
13928 |
double precision cg3dtargetresidual |
13929 |
double precision chkptfreq |
13930 |
double precision cospower |
13931 |
double precision delp(nr) |
13932 |
double precision delr(nr) |
13933 |
double precision delt |
13934 |
double precision deltat |
13935 |
double precision deltatclock |
13936 |
double precision deltatmom |
13937 |
double precision deltattracer |
13938 |
double precision delx(nx) |
13939 |
double precision dely(ny) |
13940 |
double precision delz(nr) |
13941 |
double precision diffk4s |
13942 |
double precision diffk4t |
13943 |
double precision diffkhs |
13944 |
double precision diffkht |
13945 |
double precision diffkps |
13946 |
double precision diffkpt |
13947 |
double precision diffkrs |
13948 |
double precision diffkrt |
13949 |
double precision diffkzs |
13950 |
double precision diffkzt |
13951 |
double precision dumpfreq |
13952 |
double precision endtime |
13953 |
double precision externforcingcycle |
13954 |
double precision externforcingperiod |
13955 |
double precision f0 |
13956 |
double precision fcori(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
13957 |
double precision fofacmom |
13958 |
double precision freesurffac |
13959 |
double precision gbaro |
13960 |
double precision gravity |
13961 |
double precision hfacmin |
13962 |
double precision hfacmindp |
13963 |
double precision hfacmindr |
13964 |
double precision hfacmindz |
13965 |
double precision horivertratio |
13966 |
double precision implicdiv2dflow |
13967 |
double precision implicsurfpress |
13968 |
double precision ivdc_kappa |
13969 |
double precision lambdasaltclimrelax |
13970 |
double precision lambdathetaclimrelax |
13971 |
double precision latfftfiltlo |
13972 |
double precision mtfacmom |
13973 |
double precision omega |
13974 |
double precision pchkptfreq |
13975 |
double precision pffacmom |
13976 |
double precision phimin |
13977 |
double precision rcd |
13978 |
double precision recip_gravity |
13979 |
double precision recip_horivertratio |
13980 |
double precision recip_rhoconst |
13981 |
double precision recip_rhonil |
13982 |
double precision recip_rsphere |
13983 |
double precision rhoconst |
13984 |
double precision rhonil |
13985 |
double precision ro_sealevel |
13986 |
double precision rsphere |
13987 |
double precision specvol_s(nr) |
13988 |
double precision sref(nr) |
13989 |
double precision starttime |
13990 |
double precision taucd |
13991 |
double precision tausaltclimrelax |
13992 |
double precision tauthetaclimrelax |
13993 |
double precision tavefreq |
13994 |
double precision theta_s(nr) |
13995 |
double precision thetamin |
13996 |
double precision tref(nr) |
13997 |
double precision vffacmom |
13998 |
double precision visca4 |
13999 |
double precision viscah |
14000 |
double precision viscap |
14001 |
double precision viscar |
14002 |
double precision viscaz |
14003 |
double precision zonal_filt_lat |
14004 |
|
14005 |
C============================================== |
14006 |
C define arguments |
14007 |
C============================================== |
14008 |
integer mythid |
14009 |
|
14010 |
C============================================== |
14011 |
C define local variables |
14012 |
C============================================== |
14013 |
integer bi |
14014 |
integer bj |
14015 |
integer imax |
14016 |
integer imin |
14017 |
integer jmax |
14018 |
integer jmin |
14019 |
|
14020 |
C********************************************** |
14021 |
C executable statements of routine |
14022 |
C********************************************** |
14023 |
call barrier( mythid ) |
14024 |
call ini_fields( mythid ) |
14025 |
call barrier( mythid ) |
14026 |
if (usepickupbeforec35) then |
14027 |
if (starttime .ne. 0.) then |
14028 |
call mdthe_correction_step( starttime,niter0,mythid ) |
14029 |
endif |
14030 |
endif |
14031 |
if (starttime .eq. 0.) then |
14032 |
do bj = mybylo(mythid), mybyhi(mythid) |
14033 |
do bi = mybxlo(mythid), mybxhi(mythid) |
14034 |
imin = 1-olx |
14035 |
imax = snx+olx |
14036 |
jmin = 1-oly |
14037 |
jmax = sny+oly |
14038 |
call convective_adjustment_ini( bi,bj,imin,imax,jmin,jmax, |
14039 |
$starttime,niter0,mythid ) |
14040 |
end do |
14041 |
end do |
14042 |
call barrier( mythid ) |
14043 |
endif |
14044 |
call packages_init_variables( mythid ) |
14045 |
if (tavefreq .gt. 0.) then |
14046 |
do bj = mybylo(mythid), mybyhi(mythid) |
14047 |
bi = mybxhi(mythid) |
14048 |
end do |
14049 |
endif |
14050 |
end |
14051 |
|
14052 |
|
14053 |
subroutine adinitialise_varia( mythid ) |
14054 |
C*************************************************************** |
14055 |
C*************************************************************** |
14056 |
C** This routine was generated by the ** |
14057 |
C** Tangent linear and Adjoint Model Compiler, TAMC 5.2.14 ** |
14058 |
C*************************************************************** |
14059 |
C*************************************************************** |
14060 |
C============================================== |
14061 |
C all entries are defined explicitly |
14062 |
C============================================== |
14063 |
implicit none |
14064 |
|
14065 |
C============================================== |
14066 |
C define parameters |
14067 |
C============================================== |
14068 |
integer npx |
14069 |
parameter ( npx = 1 ) |
14070 |
integer npy |
14071 |
parameter ( npy = 1 ) |
14072 |
integer nr |
14073 |
parameter ( nr = 15 ) |
14074 |
integer nsx |
14075 |
parameter ( nsx = 1 ) |
14076 |
integer nsy |
14077 |
parameter ( nsy = 1 ) |
14078 |
integer snx |
14079 |
parameter ( snx = 20 ) |
14080 |
integer nx |
14081 |
parameter ( nx = snx*nsx*npx ) |
14082 |
integer sny |
14083 |
parameter ( sny = 40 ) |
14084 |
integer ny |
14085 |
parameter ( ny = sny*nsy*npy ) |
14086 |
integer olx |
14087 |
parameter ( olx = 3 ) |
14088 |
integer oly |
14089 |
parameter ( oly = 3 ) |
14090 |
|
14091 |
C============================================== |
14092 |
C define common blocks |
14093 |
C============================================== |
14094 |
common /addynvars_cd/ addynvars_cd1, addynvars_cd2, addynvars_cd3, |
14095 |
$ addynvars_cd4, addynvars_cd5, addynvars_cd6, addynvars_cd7 |
14096 |
double precision addynvars_cd1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx, |
14097 |
$nsy) |
14098 |
double precision addynvars_cd2(1-olx:snx+olx,1-oly:sny+oly,nr,nsx, |
14099 |
$nsy) |
14100 |
double precision addynvars_cd3(1-olx:snx+olx,1-oly:sny+oly,nsx, |
14101 |
$nsy) |
14102 |
double precision addynvars_cd4(1-olx:snx+olx,1-oly:sny+oly,nr,nsx, |
14103 |
$nsy) |
14104 |
double precision addynvars_cd5(1-olx:snx+olx,1-oly:sny+oly,nr,nsx, |
14105 |
$nsy) |
14106 |
double precision addynvars_cd6(1-olx:snx+olx,1-oly:sny+oly,nr,nsx, |
14107 |
$nsy) |
14108 |
double precision addynvars_cd7(1-olx:snx+olx,1-oly:sny+oly,nr,nsx, |
14109 |
$nsy) |
14110 |
|
14111 |
common /addynvars_r/ addynvars_r1, addynvars_r2, addynvars_r3, |
14112 |
$addynvars_r4, addynvars_r5, addynvars_r6, addynvars_r7, |
14113 |
$addynvars_r8, addynvars_r9, addynvars_r10, addynvars_r11, |
14114 |
$addynvars_r12, addynvars_r13, addynvars_r14 |
14115 |
double precision addynvars_r1(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
14116 |
double precision addynvars_r10(1-olx:snx+olx,1-oly:sny+oly,nr,nsx, |
14117 |
$nsy) |
14118 |
double precision addynvars_r11(1-olx:snx+olx,1-oly:sny+oly,nr,nsx, |
14119 |
$nsy) |
14120 |
double precision addynvars_r12(1-olx:snx+olx,1-oly:sny+oly,nr,nsx, |
14121 |
$nsy) |
14122 |
double precision addynvars_r13(1-olx:snx+olx,1-oly:sny+oly,nr,nsx, |
14123 |
$nsy) |
14124 |
double precision addynvars_r14(1-olx:snx+olx,1-oly:sny+oly,nr,nsx, |
14125 |
$nsy) |
14126 |
double precision addynvars_r2(1-olx:snx+olx,1-oly:sny+oly,nr,nsx, |
14127 |
$nsy) |
14128 |
double precision addynvars_r3(1-olx:snx+olx,1-oly:sny+oly,nr,nsx, |
14129 |
$nsy) |
14130 |
double precision addynvars_r4(1-olx:snx+olx,1-oly:sny+oly,nr,nsx, |
14131 |
$nsy) |
14132 |
double precision addynvars_r5(1-olx:snx+olx,1-oly:sny+oly,nr,nsx, |
14133 |
$nsy) |
14134 |
double precision addynvars_r6(1-olx:snx+olx,1-oly:sny+oly,nr,nsx, |
14135 |
$nsy) |
14136 |
double precision addynvars_r7(1-olx:snx+olx,1-oly:sny+oly,nr,nsx, |
14137 |
$nsy) |
14138 |
double precision addynvars_r8(1-olx:snx+olx,1-oly:sny+oly,nr,nsx, |
14139 |
$nsy) |
14140 |
double precision addynvars_r9(1-olx:snx+olx,1-oly:sny+oly,nr,nsx, |
14141 |
$nsy) |
14142 |
|
14143 |
common /parm_l/ usingcartesiangrid, usingsphericalpolargrid, |
14144 |
$no_slip_sides, no_slip_bottom, staggertimestep, momviscosity, |
14145 |
$momadvection, momforcing, usecoriolis, mompressureforcing, |
14146 |
$tempdiffusion, tempadvection, tempforcing, saltdiffusion, |
14147 |
$saltadvection, saltforcing, implicitfreesurface, rigidlid, |
14148 |
$momstepping, tempstepping, saltstepping, metricterms, |
14149 |
$usingsphericalpolarmterms, useconstantf, usebetaplanef, |
14150 |
$usespheref, implicitdiffusion, implicitviscosity, |
14151 |
$dothetaclimrelax, dosaltclimrelax, periodicexternalforcing, |
14152 |
$usingpcoords, usingzcoords, nonhydrostatic, globalfiles, |
14153 |
$allowfreezing, groundatk1, usepickupbeforec35 |
14154 |
logical allowfreezing |
14155 |
logical dosaltclimrelax |
14156 |
logical dothetaclimrelax |
14157 |
logical globalfiles |
14158 |
logical groundatk1 |
14159 |
logical implicitdiffusion |
14160 |
logical implicitfreesurface |
14161 |
logical implicitviscosity |
14162 |
logical metricterms |
14163 |
logical momadvection |
14164 |
logical momforcing |
14165 |
logical mompressureforcing |
14166 |
logical momstepping |
14167 |
logical momviscosity |
14168 |
logical no_slip_bottom |
14169 |
logical no_slip_sides |
14170 |
logical nonhydrostatic |
14171 |
logical periodicexternalforcing |
14172 |
logical rigidlid |
14173 |
logical saltadvection |
14174 |
logical saltdiffusion |
14175 |
logical saltforcing |
14176 |
logical saltstepping |
14177 |
logical staggertimestep |
14178 |
logical tempadvection |
14179 |
logical tempdiffusion |
14180 |
logical tempforcing |
14181 |
logical tempstepping |
14182 |
logical usebetaplanef |
14183 |
logical useconstantf |
14184 |
logical usecoriolis |
14185 |
logical usepickupbeforec35 |
14186 |
logical usespheref |
14187 |
logical usingcartesiangrid |
14188 |
logical usingpcoords |
14189 |
logical usingsphericalpolargrid |
14190 |
logical usingsphericalpolarmterms |
14191 |
logical usingzcoords |
14192 |
|
14193 |
common /parm_r/ cg2dtargetresidual, cg2dpcoffdfac, |
14194 |
$cg3dtargetresidual, delp, delz, delr, delx, dely, deltat, |
14195 |
$deltatmom, deltattracer, deltatclock, abeps, starttime, phimin, |
14196 |
$thetamin, rsphere, recip_rsphere, f0, fcori, beta, viscah, viscaz, |
14197 |
$ visca4, viscar, diffkht, diffkzt, diffk4t, diffkrt, diffkhs, |
14198 |
$diffkzs, diffk4s, diffkrs, delt, taucd, rcd, freesurffac, |
14199 |
$implicsurfpress, implicdiv2dflow, hfacmin, hfacmindz, gravity, |
14200 |
$recip_gravity, gbaro, rhonil, recip_rhonil, recip_rhoconst, |
14201 |
$rhoconst, tref, sref, endtime, chkptfreq, pchkptfreq, dumpfreq, |
14202 |
$tavefreq, affacmom, vffacmom, pffacmom, cffacmom, fofacmom, |
14203 |
$mtfacmom, cospower, cadjfreq, omega, tauthetaclimrelax, |
14204 |
$lambdathetaclimrelax, tausaltclimrelax, lambdasaltclimrelax, |
14205 |
$externforcingcycle, externforcingperiod, viscap, diffkpt, diffkps, |
14206 |
$ hfacmindr, hfacmindp, theta_s, specvol_s, horivertratio, |
14207 |
$recip_horivertratio, latfftfiltlo, ivdc_kappa, ro_sealevel, |
14208 |
$zonal_filt_lat, bottomdraglinear, bottomdragquadratic |
14209 |
double precision abeps |
14210 |
double precision affacmom |
14211 |
double precision beta |
14212 |
double precision bottomdraglinear |
14213 |
double precision bottomdragquadratic |
14214 |
double precision cadjfreq |
14215 |
double precision cffacmom |
14216 |
double precision cg2dpcoffdfac |
14217 |
double precision cg2dtargetresidual |
14218 |
double precision cg3dtargetresidual |
14219 |
double precision chkptfreq |
14220 |
double precision cospower |
14221 |
double precision delp(nr) |
14222 |
double precision delr(nr) |
14223 |
double precision delt |
14224 |
double precision deltat |
14225 |
double precision deltatclock |
14226 |
double precision deltatmom |
14227 |
double precision deltattracer |
14228 |
double precision delx(nx) |
14229 |
double precision dely(ny) |
14230 |
double precision delz(nr) |
14231 |
double precision diffk4s |
14232 |
double precision diffk4t |
14233 |
double precision diffkhs |
14234 |
double precision diffkht |
14235 |
double precision diffkps |
14236 |
double precision diffkpt |
14237 |
double precision diffkrs |
14238 |
double precision diffkrt |
14239 |
double precision diffkzs |
14240 |
double precision diffkzt |
14241 |
double precision dumpfreq |
14242 |
double precision endtime |
14243 |
double precision externforcingcycle |
14244 |
double precision externforcingperiod |
14245 |
double precision f0 |
14246 |
double precision fcori(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
14247 |
double precision fofacmom |
14248 |
double precision freesurffac |
14249 |
double precision gbaro |
14250 |
double precision gravity |
14251 |
double precision hfacmin |
14252 |
double precision hfacmindp |
14253 |
double precision hfacmindr |
14254 |
double precision hfacmindz |
14255 |
double precision horivertratio |
14256 |
double precision implicdiv2dflow |
14257 |
double precision implicsurfpress |
14258 |
double precision ivdc_kappa |
14259 |
double precision lambdasaltclimrelax |
14260 |
double precision lambdathetaclimrelax |
14261 |
double precision latfftfiltlo |
14262 |
double precision mtfacmom |
14263 |
double precision omega |
14264 |
double precision pchkptfreq |
14265 |
double precision pffacmom |
14266 |
double precision phimin |
14267 |
double precision rcd |
14268 |
double precision recip_gravity |
14269 |
double precision recip_horivertratio |
14270 |
double precision recip_rhoconst |
14271 |
double precision recip_rhonil |
14272 |
double precision recip_rsphere |
14273 |
double precision rhoconst |
14274 |
double precision rhonil |
14275 |
double precision ro_sealevel |
14276 |
double precision rsphere |
14277 |
double precision specvol_s(nr) |
14278 |
double precision sref(nr) |
14279 |
double precision starttime |
14280 |
double precision taucd |
14281 |
double precision tausaltclimrelax |
14282 |
double precision tauthetaclimrelax |
14283 |
double precision tavefreq |
14284 |
double precision theta_s(nr) |
14285 |
double precision thetamin |
14286 |
double precision tref(nr) |
14287 |
double precision vffacmom |
14288 |
double precision visca4 |
14289 |
double precision viscah |
14290 |
double precision viscap |
14291 |
double precision viscar |
14292 |
double precision viscaz |
14293 |
double precision zonal_filt_lat |
14294 |
|
14295 |
C============================================== |
14296 |
C define arguments |
14297 |
C============================================== |
14298 |
integer mythid |
14299 |
|
14300 |
C============================================== |
14301 |
C define local variables |
14302 |
C============================================== |
14303 |
integer ip1 |
14304 |
integer ip2 |
14305 |
integer ip3 |
14306 |
integer ip4 |
14307 |
integer ip5 |
14308 |
|
14309 |
C---------------------------------------------- |
14310 |
C ROUTINE BODY |
14311 |
C---------------------------------------------- |
14312 |
call barrier( mythid ) |
14313 |
call barrier( mythid ) |
14314 |
if (starttime .eq. 0.) then |
14315 |
call barrier( mythid ) |
14316 |
endif |
14317 |
call adpackages_init_variables( mythid ) |
14318 |
if (starttime .eq. 0.) then |
14319 |
call barrier( mythid ) |
14320 |
endif |
14321 |
if (usepickupbeforec35) then |
14322 |
if (starttime .ne. 0.) then |
14323 |
call adthe_correction_step( starttime,mythid ) |
14324 |
endif |
14325 |
endif |
14326 |
call barrier( mythid ) |
14327 |
do ip5 = 1, nsy |
14328 |
do ip4 = 1, nsx |
14329 |
do ip3 = 1, nr |
14330 |
do ip2 = 1-oly, sny+oly |
14331 |
do ip1 = 1-olx, snx+olx |
14332 |
addynvars_cd1(ip1,ip2,ip3,ip4,ip5) = 0.d0 |
14333 |
end do |
14334 |
end do |
14335 |
end do |
14336 |
end do |
14337 |
end do |
14338 |
do ip5 = 1, nsy |
14339 |
do ip4 = 1, nsx |
14340 |
do ip3 = 1, nr |
14341 |
do ip2 = 1-oly, sny+oly |
14342 |
do ip1 = 1-olx, snx+olx |
14343 |
addynvars_cd2(ip1,ip2,ip3,ip4,ip5) = 0.d0 |
14344 |
end do |
14345 |
end do |
14346 |
end do |
14347 |
end do |
14348 |
end do |
14349 |
do ip4 = 1, nsy |
14350 |
do ip3 = 1, nsx |
14351 |
do ip2 = 1-oly, sny+oly |
14352 |
do ip1 = 1-olx, snx+olx |
14353 |
addynvars_cd3(ip1,ip2,ip3,ip4) = 0.d0 |
14354 |
end do |
14355 |
end do |
14356 |
end do |
14357 |
end do |
14358 |
do ip5 = 1, nsy |
14359 |
do ip4 = 1, nsx |
14360 |
do ip3 = 1, nr |
14361 |
do ip2 = 1-oly, sny+oly |
14362 |
do ip1 = 1-olx, snx+olx |
14363 |
addynvars_cd4(ip1,ip2,ip3,ip4,ip5) = 0.d0 |
14364 |
end do |
14365 |
end do |
14366 |
end do |
14367 |
end do |
14368 |
end do |
14369 |
do ip5 = 1, nsy |
14370 |
do ip4 = 1, nsx |
14371 |
do ip3 = 1, nr |
14372 |
do ip2 = 1-oly, sny+oly |
14373 |
do ip1 = 1-olx, snx+olx |
14374 |
addynvars_cd5(ip1,ip2,ip3,ip4,ip5) = 0.d0 |
14375 |
end do |
14376 |
end do |
14377 |
end do |
14378 |
end do |
14379 |
end do |
14380 |
do ip4 = 1, nsy |
14381 |
do ip3 = 1, nsx |
14382 |
do ip2 = 1-oly, sny+oly |
14383 |
do ip1 = 1-olx, snx+olx |
14384 |
addynvars_r1(ip1,ip2,ip3,ip4) = 0.d0 |
14385 |
end do |
14386 |
end do |
14387 |
end do |
14388 |
end do |
14389 |
do ip5 = 1, nsy |
14390 |
do ip4 = 1, nsx |
14391 |
do ip3 = 1, nr |
14392 |
do ip2 = 1-oly, sny+oly |
14393 |
do ip1 = 1-olx, snx+olx |
14394 |
addynvars_r10(ip1,ip2,ip3,ip4,ip5) = 0.d0 |
14395 |
end do |
14396 |
end do |
14397 |
end do |
14398 |
end do |
14399 |
end do |
14400 |
do ip5 = 1, nsy |
14401 |
do ip4 = 1, nsx |
14402 |
do ip3 = 1, nr |
14403 |
do ip2 = 1-oly, sny+oly |
14404 |
do ip1 = 1-olx, snx+olx |
14405 |
addynvars_r11(ip1,ip2,ip3,ip4,ip5) = 0.d0 |
14406 |
end do |
14407 |
end do |
14408 |
end do |
14409 |
end do |
14410 |
end do |
14411 |
do ip5 = 1, nsy |
14412 |
do ip4 = 1, nsx |
14413 |
do ip3 = 1, nr |
14414 |
do ip2 = 1-oly, sny+oly |
14415 |
do ip1 = 1-olx, snx+olx |
14416 |
addynvars_r12(ip1,ip2,ip3,ip4,ip5) = 0.d0 |
14417 |
end do |
14418 |
end do |
14419 |
end do |
14420 |
end do |
14421 |
end do |
14422 |
do ip5 = 1, nsy |
14423 |
do ip4 = 1, nsx |
14424 |
do ip3 = 1, nr |
14425 |
do ip2 = 1-oly, sny+oly |
14426 |
do ip1 = 1-olx, snx+olx |
14427 |
addynvars_r13(ip1,ip2,ip3,ip4,ip5) = 0.d0 |
14428 |
end do |
14429 |
end do |
14430 |
end do |
14431 |
end do |
14432 |
end do |
14433 |
do ip5 = 1, nsy |
14434 |
do ip4 = 1, nsx |
14435 |
do ip3 = 1, nr |
14436 |
do ip2 = 1-oly, sny+oly |
14437 |
do ip1 = 1-olx, snx+olx |
14438 |
addynvars_r14(ip1,ip2,ip3,ip4,ip5) = 0.d0 |
14439 |
end do |
14440 |
end do |
14441 |
end do |
14442 |
end do |
14443 |
end do |
14444 |
do ip5 = 1, nsy |
14445 |
do ip4 = 1, nsx |
14446 |
do ip3 = 1, nr |
14447 |
do ip2 = 1-oly, sny+oly |
14448 |
do ip1 = 1-olx, snx+olx |
14449 |
addynvars_r2(ip1,ip2,ip3,ip4,ip5) = 0.d0 |
14450 |
end do |
14451 |
end do |
14452 |
end do |
14453 |
end do |
14454 |
end do |
14455 |
do ip5 = 1, nsy |
14456 |
do ip4 = 1, nsx |
14457 |
do ip3 = 1, nr |
14458 |
do ip2 = 1-oly, sny+oly |
14459 |
do ip1 = 1-olx, snx+olx |
14460 |
addynvars_r3(ip1,ip2,ip3,ip4,ip5) = 0.d0 |
14461 |
end do |
14462 |
end do |
14463 |
end do |
14464 |
end do |
14465 |
end do |
14466 |
do ip5 = 1, nsy |
14467 |
do ip4 = 1, nsx |
14468 |
do ip3 = 1, nr |
14469 |
do ip2 = 1-oly, sny+oly |
14470 |
do ip1 = 1-olx, snx+olx |
14471 |
addynvars_r4(ip1,ip2,ip3,ip4,ip5) = 0.d0 |
14472 |
end do |
14473 |
end do |
14474 |
end do |
14475 |
end do |
14476 |
end do |
14477 |
do ip5 = 1, nsy |
14478 |
do ip4 = 1, nsx |
14479 |
do ip3 = 1, nr |
14480 |
do ip2 = 1-oly, sny+oly |
14481 |
do ip1 = 1-olx, snx+olx |
14482 |
addynvars_r5(ip1,ip2,ip3,ip4,ip5) = 0.d0 |
14483 |
end do |
14484 |
end do |
14485 |
end do |
14486 |
end do |
14487 |
end do |
14488 |
do ip5 = 1, nsy |
14489 |
do ip4 = 1, nsx |
14490 |
do ip3 = 1, nr |
14491 |
do ip2 = 1-oly, sny+oly |
14492 |
do ip1 = 1-olx, snx+olx |
14493 |
addynvars_r6(ip1,ip2,ip3,ip4,ip5) = 0.d0 |
14494 |
end do |
14495 |
end do |
14496 |
end do |
14497 |
end do |
14498 |
end do |
14499 |
do ip5 = 1, nsy |
14500 |
do ip4 = 1, nsx |
14501 |
do ip3 = 1, nr |
14502 |
do ip2 = 1-oly, sny+oly |
14503 |
do ip1 = 1-olx, snx+olx |
14504 |
addynvars_r7(ip1,ip2,ip3,ip4,ip5) = 0.d0 |
14505 |
end do |
14506 |
end do |
14507 |
end do |
14508 |
end do |
14509 |
end do |
14510 |
do ip5 = 1, nsy |
14511 |
do ip4 = 1, nsx |
14512 |
do ip3 = 1, nr |
14513 |
do ip2 = 1-oly, sny+oly |
14514 |
do ip1 = 1-olx, snx+olx |
14515 |
addynvars_r8(ip1,ip2,ip3,ip4,ip5) = 0.d0 |
14516 |
end do |
14517 |
end do |
14518 |
end do |
14519 |
end do |
14520 |
end do |
14521 |
do ip5 = 1, nsy |
14522 |
do ip4 = 1, nsx |
14523 |
do ip3 = 1, nr |
14524 |
do ip2 = 1-oly, sny+oly |
14525 |
do ip1 = 1-olx, snx+olx |
14526 |
addynvars_r9(ip1,ip2,ip3,ip4,ip5) = 0.d0 |
14527 |
end do |
14528 |
end do |
14529 |
end do |
14530 |
end do |
14531 |
end do |
14532 |
call barrier( mythid ) |
14533 |
|
14534 |
end |
14535 |
|
14536 |
|
14537 |
subroutine adintegrate_for_w( bi, bj, k, adufld, advfld, adwfld ) |
14538 |
C*************************************************************** |
14539 |
C*************************************************************** |
14540 |
C** This routine was generated by the ** |
14541 |
C** Tangent linear and Adjoint Model Compiler, TAMC 5.2.14 ** |
14542 |
C*************************************************************** |
14543 |
C*************************************************************** |
14544 |
C============================================== |
14545 |
C all entries are defined explicitly |
14546 |
C============================================== |
14547 |
implicit none |
14548 |
|
14549 |
C============================================== |
14550 |
C define parameters |
14551 |
C============================================== |
14552 |
integer nr |
14553 |
parameter ( nr = 15 ) |
14554 |
integer nsx |
14555 |
parameter ( nsx = 1 ) |
14556 |
integer nsy |
14557 |
parameter ( nsy = 1 ) |
14558 |
integer olx |
14559 |
parameter ( olx = 3 ) |
14560 |
integer oly |
14561 |
parameter ( oly = 3 ) |
14562 |
integer snx |
14563 |
parameter ( snx = 20 ) |
14564 |
integer sny |
14565 |
parameter ( sny = 40 ) |
14566 |
|
14567 |
C============================================== |
14568 |
C define common blocks |
14569 |
C============================================== |
14570 |
common /grid_r/ dxc, dxf, dxg, dxv, dyc, dyf, dyg, dyu, drc, drf, |
14571 |
$h, hfacc, hfacw, hfacs, depthink, recip_dxc, recip_dxf, recip_dxg, |
14572 |
$ recip_dxv, recip_dyc, recip_dyf, recip_dyg, recip_dyu, recip_drc, |
14573 |
$ recip_drf, recip_h, recip_hfacc, recip_hfacw, recip_hfacs, rkfac, |
14574 |
$ recip_rkfac, safac, xc, yc, ra, raw, ras, raz, rc, rf, yc0, xc0, |
14575 |
$xg, yg, maskw, masks, recip_ra, recip_raw, recip_ras, recip_raz, |
14576 |
$tanphiatu, tanphiatv |
14577 |
double precision depthink(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
14578 |
double precision drc(1:nr) |
14579 |
double precision drf(1:nr) |
14580 |
double precision dxc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
14581 |
double precision dxf(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
14582 |
double precision dxg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
14583 |
double precision dxv(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
14584 |
double precision dyc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
14585 |
double precision dyf(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
14586 |
double precision dyg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
14587 |
double precision dyu(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
14588 |
double precision h(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
14589 |
double precision hfacc(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) |
14590 |
double precision hfacs(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) |
14591 |
double precision hfacw(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) |
14592 |
double precision masks(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) |
14593 |
double precision maskw(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) |
14594 |
double precision ra(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
14595 |
double precision ras(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
14596 |
double precision raw(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
14597 |
double precision raz(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
14598 |
double precision rc(1:nr) |
14599 |
double precision recip_drc(1:nr) |
14600 |
double precision recip_drf(1:nr) |
14601 |
double precision recip_dxc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
14602 |
double precision recip_dxf(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
14603 |
double precision recip_dxg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
14604 |
double precision recip_dxv(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
14605 |
double precision recip_dyc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
14606 |
double precision recip_dyf(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
14607 |
double precision recip_dyg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
14608 |
double precision recip_dyu(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
14609 |
double precision recip_h(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
14610 |
double precision recip_hfacc(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx, |
14611 |
$nsy) |
14612 |
double precision recip_hfacs(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx, |
14613 |
$nsy) |
14614 |
double precision recip_hfacw(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx, |
14615 |
$nsy) |
14616 |
double precision recip_ra(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
14617 |
double precision recip_ras(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
14618 |
double precision recip_raw(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
14619 |
double precision recip_raz(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
14620 |
double precision recip_rkfac |
14621 |
double precision rf(1:nr+1) |
14622 |
double precision rkfac |
14623 |
double precision safac(1:nr) |
14624 |
double precision tanphiatu(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
14625 |
double precision tanphiatv(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
14626 |
double precision xc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
14627 |
double precision xc0 |
14628 |
double precision xg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
14629 |
double precision yc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
14630 |
double precision yc0 |
14631 |
double precision yg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
14632 |
|
14633 |
common /parm_l/ usingcartesiangrid, usingsphericalpolargrid, |
14634 |
$no_slip_sides, no_slip_bottom, staggertimestep, momviscosity, |
14635 |
$momadvection, momforcing, usecoriolis, mompressureforcing, |
14636 |
$tempdiffusion, tempadvection, tempforcing, saltdiffusion, |
14637 |
$saltadvection, saltforcing, implicitfreesurface, rigidlid, |
14638 |
$momstepping, tempstepping, saltstepping, metricterms, |
14639 |
$usingsphericalpolarmterms, useconstantf, usebetaplanef, |
14640 |
$usespheref, implicitdiffusion, implicitviscosity, |
14641 |
$dothetaclimrelax, dosaltclimrelax, periodicexternalforcing, |
14642 |
$usingpcoords, usingzcoords, nonhydrostatic, globalfiles, |
14643 |
$allowfreezing, groundatk1, usepickupbeforec35 |
14644 |
logical allowfreezing |
14645 |
logical dosaltclimrelax |
14646 |
logical dothetaclimrelax |
14647 |
logical globalfiles |
14648 |
logical groundatk1 |
14649 |
logical implicitdiffusion |
14650 |
logical implicitfreesurface |
14651 |
logical implicitviscosity |
14652 |
logical metricterms |
14653 |
logical momadvection |
14654 |
logical momforcing |
14655 |
logical mompressureforcing |
14656 |
logical momstepping |
14657 |
logical momviscosity |
14658 |
logical no_slip_bottom |
14659 |
logical no_slip_sides |
14660 |
logical nonhydrostatic |
14661 |
logical periodicexternalforcing |
14662 |
logical rigidlid |
14663 |
logical saltadvection |
14664 |
logical saltdiffusion |
14665 |
logical saltforcing |
14666 |
logical saltstepping |
14667 |
logical staggertimestep |
14668 |
logical tempadvection |
14669 |
logical tempdiffusion |
14670 |
logical tempforcing |
14671 |
logical tempstepping |
14672 |
logical usebetaplanef |
14673 |
logical useconstantf |
14674 |
logical usecoriolis |
14675 |
logical usepickupbeforec35 |
14676 |
logical usespheref |
14677 |
logical usingcartesiangrid |
14678 |
logical usingpcoords |
14679 |
logical usingsphericalpolargrid |
14680 |
logical usingsphericalpolarmterms |
14681 |
logical usingzcoords |
14682 |
|
14683 |
C============================================== |
14684 |
C define arguments |
14685 |
C============================================== |
14686 |
double precision adufld(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
14687 |
double precision advfld(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
14688 |
double precision adwfld(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
14689 |
integer bi |
14690 |
integer bj |
14691 |
integer k |
14692 |
|
14693 |
C============================================== |
14694 |
C define local variables |
14695 |
C============================================== |
14696 |
double precision adutrans(1-olx:snx+olx,1-oly:sny+oly) |
14697 |
double precision advtrans(1-olx:snx+olx,1-oly:sny+oly) |
14698 |
integer i |
14699 |
integer ip1 |
14700 |
integer ip2 |
14701 |
integer j |
14702 |
|
14703 |
C---------------------------------------------- |
14704 |
C RESET LOCAL ADJOINT VARIABLES |
14705 |
C---------------------------------------------- |
14706 |
do ip2 = 1-oly, sny+oly |
14707 |
do ip1 = 1-olx, snx+olx |
14708 |
adutrans(ip1,ip2) = 0.d0 |
14709 |
end do |
14710 |
end do |
14711 |
do ip2 = 1-oly, sny+oly |
14712 |
do ip1 = 1-olx, snx+olx |
14713 |
advtrans(ip1,ip2) = 0.d0 |
14714 |
end do |
14715 |
end do |
14716 |
|
14717 |
C---------------------------------------------- |
14718 |
C ROUTINE BODY |
14719 |
C---------------------------------------------- |
14720 |
if (k .eq. 1 .and. rigidlid) then |
14721 |
do j = 1-oly, sny+oly-1 |
14722 |
do i = 1-olx, snx+olx-1 |
14723 |
adwfld(i,j,k,bi,bj) = 0.d0 |
14724 |
end do |
14725 |
end do |
14726 |
else if (k .eq. nr) then |
14727 |
do j = 1-oly, sny+oly-1 |
14728 |
do i = 1-olx, snx+olx-1 |
14729 |
adutrans(i+1,j) = adutrans(i+1,j)-adwfld(i,j,k,bi,bj)* |
14730 |
$recip_ra(i,j,bi,bj) |
14731 |
adutrans(i,j) = adutrans(i,j)+adwfld(i,j,k,bi,bj)* |
14732 |
$recip_ra(i,j,bi,bj) |
14733 |
advtrans(i,j+1) = advtrans(i,j+1)-adwfld(i,j,k,bi,bj)* |
14734 |
$recip_ra(i,j,bi,bj) |
14735 |
advtrans(i,j) = advtrans(i,j)+adwfld(i,j,k,bi,bj)* |
14736 |
$recip_ra(i,j,bi,bj) |
14737 |
adwfld(i,j,k,bi,bj) = 0.d0 |
14738 |
end do |
14739 |
end do |
14740 |
else |
14741 |
do j = 1-oly, sny+oly-1 |
14742 |
do i = 1-olx, snx+olx-1 |
14743 |
adutrans(i+1,j) = adutrans(i+1,j)-adwfld(i,j,k,bi,bj)* |
14744 |
$recip_ra(i,j,bi,bj) |
14745 |
adutrans(i,j) = adutrans(i,j)+adwfld(i,j,k,bi,bj)* |
14746 |
$recip_ra(i,j,bi,bj) |
14747 |
advtrans(i,j+1) = advtrans(i,j+1)-adwfld(i,j,k,bi,bj)* |
14748 |
$recip_ra(i,j,bi,bj) |
14749 |
advtrans(i,j) = advtrans(i,j)+adwfld(i,j,k,bi,bj)* |
14750 |
$recip_ra(i,j,bi,bj) |
14751 |
adwfld(i,j,k+1,bi,bj) = adwfld(i,j,k+1,bi,bj)+adwfld(i,j,k, |
14752 |
$bi,bj) |
14753 |
adwfld(i,j,k,bi,bj) = 0.d0 |
14754 |
end do |
14755 |
end do |
14756 |
endif |
14757 |
do j = 1-oly, sny+oly |
14758 |
do i = 1-olx, snx+olx |
14759 |
advfld(i,j,k,bi,bj) = advfld(i,j,k,bi,bj)+advtrans(i,j)*dxg(i, |
14760 |
$j,bi,bj)*drf(k)*hfacs(i,j,k,bi,bj) |
14761 |
advtrans(i,j) = 0.d0 |
14762 |
adufld(i,j,k,bi,bj) = adufld(i,j,k,bi,bj)+adutrans(i,j)*dyg(i, |
14763 |
$j,bi,bj)*drf(k)*hfacw(i,j,k,bi,bj) |
14764 |
adutrans(i,j) = 0.d0 |
14765 |
end do |
14766 |
end do |
14767 |
|
14768 |
end |
14769 |
|
14770 |
|
14771 |
subroutine mdkpp_calc( bi, bj, mytime, mythid ) |
14772 |
C*************************************************************** |
14773 |
C*************************************************************** |
14774 |
C** This routine was generated by the ** |
14775 |
C** Tangent linear and Adjoint Model Compiler, TAMC 5.2.14 ** |
14776 |
C*************************************************************** |
14777 |
C*************************************************************** |
14778 |
C============================================== |
14779 |
C all entries are defined explicitly |
14780 |
C============================================== |
14781 |
implicit none |
14782 |
|
14783 |
C============================================== |
14784 |
C define parameters |
14785 |
C============================================== |
14786 |
integer olx |
14787 |
parameter ( olx = 3 ) |
14788 |
integer ibot |
14789 |
parameter ( ibot = 1-olx ) |
14790 |
integer snx |
14791 |
parameter ( snx = 20 ) |
14792 |
integer imax |
14793 |
parameter ( imax = snx+3 ) |
14794 |
integer imin |
14795 |
parameter ( imin = -2 ) |
14796 |
integer itop |
14797 |
parameter ( itop = snx+olx ) |
14798 |
integer oly |
14799 |
parameter ( oly = 3 ) |
14800 |
integer jbot |
14801 |
parameter ( jbot = 1-oly ) |
14802 |
integer sny |
14803 |
parameter ( sny = 40 ) |
14804 |
integer jmax |
14805 |
parameter ( jmax = sny+3 ) |
14806 |
integer jmin |
14807 |
parameter ( jmin = -2 ) |
14808 |
integer jtop |
14809 |
parameter ( jtop = sny+oly ) |
14810 |
integer mdiff |
14811 |
parameter ( mdiff = 3 ) |
14812 |
double precision minusone |
14813 |
parameter ( minusone = -1. ) |
14814 |
integer npx |
14815 |
parameter ( npx = 1 ) |
14816 |
integer npy |
14817 |
parameter ( npy = 1 ) |
14818 |
integer nr |
14819 |
parameter ( nr = 15 ) |
14820 |
integer nrm1 |
14821 |
parameter ( nrm1 = nr-1 ) |
14822 |
integer nrp1 |
14823 |
parameter ( nrp1 = nr+1 ) |
14824 |
integer nsx |
14825 |
parameter ( nsx = 1 ) |
14826 |
integer nsy |
14827 |
parameter ( nsy = 1 ) |
14828 |
integer nx |
14829 |
parameter ( nx = snx*nsx*npx ) |
14830 |
integer ny |
14831 |
parameter ( ny = sny*nsy*npy ) |
14832 |
double precision p0 |
14833 |
parameter ( p0 = 0. ) |
14834 |
double precision p125 |
14835 |
parameter ( p125 = 0.125 ) |
14836 |
double precision p5 |
14837 |
parameter ( p5 = 0.5 ) |
14838 |
|
14839 |
C============================================== |
14840 |
C define common blocks |
14841 |
C============================================== |
14842 |
common /dynvars_r/ etan, uvel, vvel, wvel, theta, salt, gu, gv, |
14843 |
$gt, gs, gunm1, gvnm1, gtnm1, gsnm1 |
14844 |
double precision etan(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
14845 |
double precision gs(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
14846 |
double precision gsnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
14847 |
double precision gt(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
14848 |
double precision gtnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
14849 |
double precision gu(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
14850 |
double precision gunm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
14851 |
double precision gv(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
14852 |
double precision gvnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
14853 |
double precision salt(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
14854 |
double precision theta(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
14855 |
double precision uvel(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
14856 |
double precision vvel(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
14857 |
double precision wvel(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
14858 |
|
14859 |
common /ffields/ fu, fv, qnet, empmr, sst, sss, qsw |
14860 |
double precision empmr(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
14861 |
double precision fu(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
14862 |
double precision fv(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
14863 |
double precision qnet(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
14864 |
double precision qsw(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
14865 |
double precision sss(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
14866 |
double precision sst(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
14867 |
|
14868 |
common /grid_r/ dxc, dxf, dxg, dxv, dyc, dyf, dyg, dyu, drc, drf, |
14869 |
$h, hfacc, hfacw, hfacs, depthink, recip_dxc, recip_dxf, recip_dxg, |
14870 |
$ recip_dxv, recip_dyc, recip_dyf, recip_dyg, recip_dyu, recip_drc, |
14871 |
$ recip_drf, recip_h, recip_hfacc, recip_hfacw, recip_hfacs, rkfac, |
14872 |
$ recip_rkfac, safac, xc, yc, ra, raw, ras, raz, rc, rf, yc0, xc0, |
14873 |
$xg, yg, maskw, masks, recip_ra, recip_raw, recip_ras, recip_raz, |
14874 |
$tanphiatu, tanphiatv |
14875 |
double precision depthink(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
14876 |
double precision drc(1:nr) |
14877 |
double precision drf(1:nr) |
14878 |
double precision dxc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
14879 |
double precision dxf(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
14880 |
double precision dxg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
14881 |
double precision dxv(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
14882 |
double precision dyc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
14883 |
double precision dyf(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
14884 |
double precision dyg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
14885 |
double precision dyu(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
14886 |
double precision h(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
14887 |
double precision hfacc(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) |
14888 |
double precision hfacs(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) |
14889 |
double precision hfacw(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) |
14890 |
double precision masks(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) |
14891 |
double precision maskw(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) |
14892 |
double precision ra(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
14893 |
double precision ras(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
14894 |
double precision raw(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
14895 |
double precision raz(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
14896 |
double precision rc(1:nr) |
14897 |
double precision recip_drc(1:nr) |
14898 |
double precision recip_drf(1:nr) |
14899 |
double precision recip_dxc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
14900 |
double precision recip_dxf(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
14901 |
double precision recip_dxg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
14902 |
double precision recip_dxv(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
14903 |
double precision recip_dyc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
14904 |
double precision recip_dyf(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
14905 |
double precision recip_dyg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
14906 |
double precision recip_dyu(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
14907 |
double precision recip_h(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
14908 |
double precision recip_hfacc(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx, |
14909 |
$nsy) |
14910 |
double precision recip_hfacs(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx, |
14911 |
$nsy) |
14912 |
double precision recip_hfacw(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx, |
14913 |
$nsy) |
14914 |
double precision recip_ra(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
14915 |
double precision recip_ras(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
14916 |
double precision recip_raw(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
14917 |
double precision recip_raz(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
14918 |
double precision recip_rkfac |
14919 |
double precision rf(1:nr+1) |
14920 |
double precision rkfac |
14921 |
double precision safac(1:nr) |
14922 |
double precision tanphiatu(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
14923 |
double precision tanphiatv(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
14924 |
double precision xc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
14925 |
double precision xc0 |
14926 |
double precision xg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
14927 |
double precision yc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
14928 |
double precision yc0 |
14929 |
double precision yg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
14930 |
|
14931 |
common /kmixcom/ epsln, phepsi, epsilon, vonk, db_dz, conc1, |
14932 |
$conam, concm, conc2, zetam, conas, concs, conc3, zetas |
14933 |
double precision conam |
14934 |
double precision conas |
14935 |
double precision conc1 |
14936 |
double precision conc2 |
14937 |
double precision conc3 |
14938 |
double precision concm |
14939 |
double precision concs |
14940 |
double precision db_dz |
14941 |
double precision epsilon |
14942 |
double precision epsln |
14943 |
double precision phepsi |
14944 |
double precision vonk |
14945 |
double precision zetam |
14946 |
double precision zetas |
14947 |
|
14948 |
common /kpp/ kppviscaz, kppdiffkzt, kppdiffkzs, kppghat, kpphbl |
14949 |
double precision kppdiffkzs(1-olx:snx+olx,1-oly:sny+oly,nr,nsx, |
14950 |
$nsy) |
14951 |
double precision kppdiffkzt(1-olx:snx+olx,1-oly:sny+oly,nr,nsx, |
14952 |
$nsy) |
14953 |
double precision kppghat(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
14954 |
double precision kpphbl(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
14955 |
double precision kppviscaz(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
14956 |
|
14957 |
common /kpp_i/ nzmax |
14958 |
integer nzmax(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
14959 |
|
14960 |
common /kpp_r1/ pmask, zgrid, hwide |
14961 |
double precision hwide(0:nr+1) |
14962 |
double precision pmask(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
14963 |
double precision zgrid(0:nr+1) |
14964 |
|
14965 |
common /kpp_r2/ kpp_freq, kpp_dumpfreq, kpp_tavefreq |
14966 |
double precision kpp_dumpfreq |
14967 |
double precision kpp_freq |
14968 |
double precision kpp_tavefreq |
14969 |
|
14970 |
common /kpp_short/ kppfrac |
14971 |
double precision kppfrac(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
14972 |
|
14973 |
common /parm_a/ heatcapacity_cp, recip_cp, lamba_theta |
14974 |
double precision heatcapacity_cp |
14975 |
double precision lamba_theta |
14976 |
double precision recip_cp |
14977 |
|
14978 |
common /parm_r/ cg2dtargetresidual, cg2dpcoffdfac, |
14979 |
$cg3dtargetresidual, delp, delz, delr, delx, dely, deltat, |
14980 |
$deltatmom, deltattracer, deltatclock, abeps, starttime, phimin, |
14981 |
$thetamin, rsphere, recip_rsphere, f0, fcori, beta, viscah, viscaz, |
14982 |
$ visca4, viscar, diffkht, diffkzt, diffk4t, diffkrt, diffkhs, |
14983 |
$diffkzs, diffk4s, diffkrs, delt, taucd, rcd, freesurffac, |
14984 |
$implicsurfpress, implicdiv2dflow, hfacmin, hfacmindz, gravity, |
14985 |
$recip_gravity, gbaro, rhonil, recip_rhonil, recip_rhoconst, |
14986 |
$rhoconst, tref, sref, endtime, chkptfreq, pchkptfreq, dumpfreq, |
14987 |
$tavefreq, affacmom, vffacmom, pffacmom, cffacmom, fofacmom, |
14988 |
$mtfacmom, cospower, cadjfreq, omega, tauthetaclimrelax, |
14989 |
$lambdathetaclimrelax, tausaltclimrelax, lambdasaltclimrelax, |
14990 |
$externforcingcycle, externforcingperiod, viscap, diffkpt, diffkps, |
14991 |
$ hfacmindr, hfacmindp, theta_s, specvol_s, horivertratio, |
14992 |
$recip_horivertratio, latfftfiltlo, ivdc_kappa, ro_sealevel, |
14993 |
$zonal_filt_lat, bottomdraglinear, bottomdragquadratic |
14994 |
double precision abeps |
14995 |
double precision affacmom |
14996 |
double precision beta |
14997 |
double precision bottomdraglinear |
14998 |
double precision bottomdragquadratic |
14999 |
double precision cadjfreq |
15000 |
double precision cffacmom |
15001 |
double precision cg2dpcoffdfac |
15002 |
double precision cg2dtargetresidual |
15003 |
double precision cg3dtargetresidual |
15004 |
double precision chkptfreq |
15005 |
double precision cospower |
15006 |
double precision delp(nr) |
15007 |
double precision delr(nr) |
15008 |
double precision delt |
15009 |
double precision deltat |
15010 |
double precision deltatclock |
15011 |
double precision deltatmom |
15012 |
double precision deltattracer |
15013 |
double precision delx(nx) |
15014 |
double precision dely(ny) |
15015 |
double precision delz(nr) |
15016 |
double precision diffk4s |
15017 |
double precision diffk4t |
15018 |
double precision diffkhs |
15019 |
double precision diffkht |
15020 |
double precision diffkps |
15021 |
double precision diffkpt |
15022 |
double precision diffkrs |
15023 |
double precision diffkrt |
15024 |
double precision diffkzs |
15025 |
double precision diffkzt |
15026 |
double precision dumpfreq |
15027 |
double precision endtime |
15028 |
double precision externforcingcycle |
15029 |
double precision externforcingperiod |
15030 |
double precision f0 |
15031 |
double precision fcori(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
15032 |
double precision fofacmom |
15033 |
double precision freesurffac |
15034 |
double precision gbaro |
15035 |
double precision gravity |
15036 |
double precision hfacmin |
15037 |
double precision hfacmindp |
15038 |
double precision hfacmindr |
15039 |
double precision hfacmindz |
15040 |
double precision horivertratio |
15041 |
double precision implicdiv2dflow |
15042 |
double precision implicsurfpress |
15043 |
double precision ivdc_kappa |
15044 |
double precision lambdasaltclimrelax |
15045 |
double precision lambdathetaclimrelax |
15046 |
double precision latfftfiltlo |
15047 |
double precision mtfacmom |
15048 |
double precision omega |
15049 |
double precision pchkptfreq |
15050 |
double precision pffacmom |
15051 |
double precision phimin |
15052 |
double precision rcd |
15053 |
double precision recip_gravity |
15054 |
double precision recip_horivertratio |
15055 |
double precision recip_rhoconst |
15056 |
double precision recip_rhonil |
15057 |
double precision recip_rsphere |
15058 |
double precision rhoconst |
15059 |
double precision rhonil |
15060 |
double precision ro_sealevel |
15061 |
double precision rsphere |
15062 |
double precision specvol_s(nr) |
15063 |
double precision sref(nr) |
15064 |
double precision starttime |
15065 |
double precision taucd |
15066 |
double precision tausaltclimrelax |
15067 |
double precision tauthetaclimrelax |
15068 |
double precision tavefreq |
15069 |
double precision theta_s(nr) |
15070 |
double precision thetamin |
15071 |
double precision tref(nr) |
15072 |
double precision vffacmom |
15073 |
double precision visca4 |
15074 |
double precision viscah |
15075 |
double precision viscap |
15076 |
double precision viscar |
15077 |
double precision viscaz |
15078 |
double precision zonal_filt_lat |
15079 |
|
15080 |
common /tamckeys/ key, ikey, idkey |
15081 |
integer idkey |
15082 |
integer ikey |
15083 |
integer key |
15084 |
|
15085 |
common /tendency_forcing/ surfacetendencyu, surfacetendencyv, |
15086 |
$surfacetendencyt, surfacetendencys, tempqsw |
15087 |
double precision surfacetendencys(1-olx:snx+olx,1-oly:sny+oly,nsx, |
15088 |
$nsy) |
15089 |
double precision surfacetendencyt(1-olx:snx+olx,1-oly:sny+oly,nsx, |
15090 |
$nsy) |
15091 |
double precision surfacetendencyu(1-olx:snx+olx,1-oly:sny+oly,nsx, |
15092 |
$nsy) |
15093 |
double precision surfacetendencyv(1-olx:snx+olx,1-oly:sny+oly,nsx, |
15094 |
$nsy) |
15095 |
double precision tempqsw(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
15096 |
|
15097 |
C============================================== |
15098 |
C define arguments |
15099 |
C============================================== |
15100 |
integer bi |
15101 |
integer bj |
15102 |
integer mythid |
15103 |
double precision mytime |
15104 |
|
15105 |
C============================================== |
15106 |
C define local variables |
15107 |
C============================================== |
15108 |
double precision bo(ibot:itop,jbot:jtop) |
15109 |
double precision bosol(ibot:itop,jbot:jtop) |
15110 |
double precision dbloc(ibot:itop,jbot:jtop,nr) |
15111 |
double precision dvsq(ibot:itop,jbot:jtop,nr) |
15112 |
double precision ghat(ibot:itop,jbot:jtop,nr) |
15113 |
double precision hbl(ibot:itop,jbot:jtop) |
15114 |
integer help_h |
15115 |
integer help_i |
15116 |
integer i |
15117 |
integer im1 |
15118 |
integer ip1 |
15119 |
integer j |
15120 |
integer jm1 |
15121 |
integer jp1 |
15122 |
integer k |
15123 |
integer kp1 |
15124 |
double precision ritop(ibot:itop,jbot:jtop,nr) |
15125 |
double precision shsq(ibot:itop,jbot:jtop,nr) |
15126 |
double precision tempvar1 |
15127 |
double precision tempvar2 |
15128 |
double precision ustar(ibot:itop,jbot:jtop) |
15129 |
double precision vddiff(ibot:itop,jbot:jtop,0:nrp1,mdiff) |
15130 |
integer work1(ibot:itop,jbot:jtop) |
15131 |
double precision work2(ibot:itop,jbot:jtop) |
15132 |
double precision worka(1-olx:snx+olx,1-oly:sny+oly) |
15133 |
|
15134 |
C============================================== |
15135 |
C define external procedures and functions |
15136 |
C============================================== |
15137 |
logical different_multiple |
15138 |
external different_multiple |
15139 |
|
15140 |
C********************************************** |
15141 |
C executable statements of routine |
15142 |
C********************************************** |
15143 |
if (different_multiple(kpp_freq,mytime,mytime-deltatclock) .or. |
15144 |
$mytime .eq. starttime) then |
15145 |
call statekpp( bi,bj,mythid,work2,dbloc,ritop,vddiff(ibot,jbot, |
15146 |
$1,1),vddiff(ibot,jbot,1,2) ) |
15147 |
do k = 1, nr |
15148 |
do j = jbot, jtop |
15149 |
do i = ibot, itop |
15150 |
ghat(i,j,k) = dbloc(i,j,k) |
15151 |
end do |
15152 |
end do |
15153 |
end do |
15154 |
do k = 1, nr-1 |
15155 |
help_h = k+1 |
15156 |
call kpp_smooth_horiz( help_h,bi,bj,ghat(ibot,jbot,k) ) |
15157 |
end do |
15158 |
do k = 1, nr |
15159 |
do j = jbot, jtop |
15160 |
do i = ibot, itop |
15161 |
dbloc(i,j,k) = dbloc(i,j,k)*pmask(i,j,k,bi,bj) |
15162 |
ghat(i,j,k) = ghat(i,j,k)*pmask(i,j,k,bi,bj) |
15163 |
ritop(i,j,k) = ritop(i,j,k)*pmask(i,j,k,bi,bj) |
15164 |
if (k .eq. nzmax(i,j,bi,bj)) then |
15165 |
dbloc(i,j,k) = p0 |
15166 |
ghat(i,j,k) = p0 |
15167 |
ritop(i,j,k) = p0 |
15168 |
endif |
15169 |
ritop(i,j,k) = (zgrid(1)-zgrid(k))*ritop(i,j,k) |
15170 |
end do |
15171 |
end do |
15172 |
end do |
15173 |
do j = jbot, jtop |
15174 |
do i = ibot, itop |
15175 |
ustar(i,j) = p0 |
15176 |
bo(i,j) = p0 |
15177 |
bosol(i,j) = p0 |
15178 |
end do |
15179 |
end do |
15180 |
do j = jmin, jmax |
15181 |
jp1 = j+1 |
15182 |
do i = imin, imax |
15183 |
ip1 = i+1 |
15184 |
tempvar1 = (surfacetendencyu(i,j,bi,bj)+ |
15185 |
$surfacetendencyu(ip1,j,bi,bj))*(surfacetendencyu(i,j,bi,bj)+ |
15186 |
$surfacetendencyu(ip1,j,bi,bj))+(surfacetendencyv(i,j,bi,bj)+ |
15187 |
$surfacetendencyv(i,jp1,bi,bj))*(surfacetendencyv(i,j,bi,bj)+ |
15188 |
$surfacetendencyv(i,jp1,bi,bj)) |
15189 |
if (tempvar1 .lt. phepsi*phepsi) then |
15190 |
ustar(i,j) = sqrt(phepsi*p5*delz(1)) |
15191 |
else |
15192 |
tempvar2 = sqrt(tempvar1)*p5*delz(1) |
15193 |
ustar(i,j) = sqrt(tempvar2) |
15194 |
endif |
15195 |
bo(i,j) = -(gravity*(vddiff(i,j,1,1)*surfacetendencyt(i,j, |
15196 |
$bi,bj)+vddiff(i,j,1,2)*surfacetendencys(i,j,bi,bj))*delz(1)/ |
15197 |
$work2(i,j)) |
15198 |
bosol(i,j) = gravity*vddiff(i,j,1,1)*qsw(i,j,bi,bj)* |
15199 |
$recip_cp*recip_rhonil*recip_drf(1)*delz(1)/work2(i,j) |
15200 |
end do |
15201 |
end do |
15202 |
do k = 1, nr |
15203 |
do j = jbot, jtop |
15204 |
do i = ibot, itop |
15205 |
shsq(i,j,k) = p0 |
15206 |
dvsq(i,j,k) = p0 |
15207 |
end do |
15208 |
end do |
15209 |
end do |
15210 |
do k = 1, nr |
15211 |
do j = jmin, jmax |
15212 |
jp1 = j+1 |
15213 |
do i = imin, imax |
15214 |
ip1 = i+1 |
15215 |
dvsq(i,j,k) = p5*((uvel(i,j,1,bi,bj)-uvel(i,j,k,bi,bj))* |
15216 |
$(uvel(i,j,1,bi,bj)-uvel(i,j,k,bi,bj))+(uvel(ip1,j,1,bi,bj)- |
15217 |
$uvel(ip1,j,k,bi,bj))*(uvel(ip1,j,1,bi,bj)-uvel(ip1,j,k,bi,bj))+ |
15218 |
$(vvel(i,j,1,bi,bj)-vvel(i,j,k,bi,bj))*(vvel(i,j,1,bi,bj)-vvel(i,j, |
15219 |
$k,bi,bj))+(vvel(i,jp1,1,bi,bj)-vvel(i,jp1,k,bi,bj))*(vvel(i,jp1,1, |
15220 |
$bi,bj)-vvel(i,jp1,k,bi,bj))) |
15221 |
end do |
15222 |
end do |
15223 |
end do |
15224 |
do k = 1, nrm1 |
15225 |
kp1 = k+1 |
15226 |
do j = jmin, jmax |
15227 |
jm1 = j-1 |
15228 |
jp1 = j+1 |
15229 |
do i = imin, imax |
15230 |
im1 = i-1 |
15231 |
ip1 = i+1 |
15232 |
shsq(i,j,k) = p5*((uvel(i,j,k,bi,bj)-uvel(i,j,kp1,bi,bj))* |
15233 |
$(uvel(i,j,k,bi,bj)-uvel(i,j,kp1,bi,bj))+(uvel(ip1,j,k,bi,bj)- |
15234 |
$uvel(ip1,j,kp1,bi,bj))*(uvel(ip1,j,k,bi,bj)-uvel(ip1,j,kp1,bi,bj)) |
15235 |
$+(vvel(i,j,k,bi,bj)-vvel(i,j,kp1,bi,bj))*(vvel(i,j,k,bi,bj)- |
15236 |
$vvel(i,j,kp1,bi,bj))+(vvel(i,jp1,k,bi,bj)-vvel(i,jp1,kp1,bi,bj))* |
15237 |
$(vvel(i,jp1,k,bi,bj)-vvel(i,jp1,kp1,bi,bj))) |
15238 |
shsq(i,j,k) = p5*shsq(i,j,k)+p125*((uvel(i,jm1,k,bi,bj)- |
15239 |
$uvel(i,jm1,kp1,bi,bj))*(uvel(i,jm1,k,bi,bj)-uvel(i,jm1,kp1,bi,bj)) |
15240 |
$+(uvel(ip1,jm1,k,bi,bj)-uvel(ip1,jm1,kp1,bi,bj))*(uvel(ip1,jm1,k, |
15241 |
$bi,bj)-uvel(ip1,jm1,kp1,bi,bj))+(uvel(i,jp1,k,bi,bj)-uvel(i,jp1, |
15242 |
$kp1,bi,bj))*(uvel(i,jp1,k,bi,bj)-uvel(i,jp1,kp1,bi,bj))+(uvel(ip1, |
15243 |
$jp1,k,bi,bj)-uvel(ip1,jp1,kp1,bi,bj))*(uvel(ip1,jp1,k,bi,bj)- |
15244 |
$uvel(ip1,jp1,kp1,bi,bj))+(vvel(im1,j,k,bi,bj)-vvel(im1,j,kp1,bi, |
15245 |
$bj))*(vvel(im1,j,k,bi,bj)-vvel(im1,j,kp1,bi,bj))+(vvel(im1,jp1,k, |
15246 |
$bi,bj)-vvel(im1,jp1,kp1,bi,bj))*(vvel(im1,jp1,k,bi,bj)-vvel(im1, |
15247 |
$jp1,kp1,bi,bj))+(vvel(ip1,j,k,bi,bj)-vvel(ip1,j,kp1,bi,bj))* |
15248 |
$(vvel(ip1,j,k,bi,bj)-vvel(ip1,j,kp1,bi,bj))+(vvel(ip1,jp1,k,bi,bj) |
15249 |
$-vvel(ip1,jp1,kp1,bi,bj))*(vvel(ip1,jp1,k,bi,bj)-vvel(ip1,jp1,kp1, |
15250 |
$bi,bj))) |
15251 |
end do |
15252 |
end do |
15253 |
end do |
15254 |
do j = jbot, jtop |
15255 |
do i = ibot, itop |
15256 |
work1(i,j) = nzmax(i,j,bi,bj) |
15257 |
work2(i,j) = fcori(i,j,bi,bj) |
15258 |
end do |
15259 |
end do |
15260 |
call mdkppmix( mytime,mythid,work1,shsq,dvsq,ustar,bo,bosol, |
15261 |
$dbloc,ritop,work2,ikey,vddiff,ghat,hbl ) |
15262 |
do j = jmin, jmax |
15263 |
do i = imin, imax |
15264 |
do k = 1, nr |
15265 |
kppviscaz(i,j,k,bi,bj) = vddiff(i,j,k-1,1)*pmask(i,j,k,bi, |
15266 |
$bj) |
15267 |
kppdiffkzs(i,j,k,bi,bj) = vddiff(i,j,k-1,2)*pmask(i,j,k, |
15268 |
$bi,bj) |
15269 |
kppdiffkzt(i,j,k,bi,bj) = vddiff(i,j,k-1,3)*pmask(i,j,k, |
15270 |
$bi,bj) |
15271 |
kppghat(i,j,k,bi,bj) = ghat(i,j,k)*pmask(i,j,k,bi,bj) |
15272 |
end do |
15273 |
kpphbl(i,j,bi,bj) = hbl(i,j)*pmask(i,j,1,bi,bj) |
15274 |
end do |
15275 |
end do |
15276 |
do j = 1-oly, sny+oly |
15277 |
do i = 1-olx, snx+olx |
15278 |
worka(i,j) = kpphbl(i,j,bi,bj) |
15279 |
end do |
15280 |
end do |
15281 |
help_i = (snx+2*olx)*(sny+2*oly) |
15282 |
call swfrac( help_i,minusone,mytime,mythid,worka ) |
15283 |
do j = 1-oly, sny+oly |
15284 |
do i = 1-olx, snx+olx |
15285 |
kppfrac(i,j,bi,bj) = worka(i,j) |
15286 |
end do |
15287 |
end do |
15288 |
endif |
15289 |
end |
15290 |
|
15291 |
|
15292 |
subroutine adkpp_calc( bi, bj, mytime ) |
15293 |
C*************************************************************** |
15294 |
C*************************************************************** |
15295 |
C** This routine was generated by the ** |
15296 |
C** Tangent linear and Adjoint Model Compiler, TAMC 5.2.14 ** |
15297 |
C*************************************************************** |
15298 |
C*************************************************************** |
15299 |
C============================================== |
15300 |
C all entries are defined explicitly |
15301 |
C============================================== |
15302 |
implicit none |
15303 |
|
15304 |
C============================================== |
15305 |
C define parameters |
15306 |
C============================================== |
15307 |
integer olx |
15308 |
parameter ( olx = 3 ) |
15309 |
integer ibot |
15310 |
parameter ( ibot = 1-olx ) |
15311 |
integer snx |
15312 |
parameter ( snx = 20 ) |
15313 |
integer imax |
15314 |
parameter ( imax = snx+3 ) |
15315 |
integer imin |
15316 |
parameter ( imin = -2 ) |
15317 |
integer itop |
15318 |
parameter ( itop = snx+olx ) |
15319 |
integer oly |
15320 |
parameter ( oly = 3 ) |
15321 |
integer jbot |
15322 |
parameter ( jbot = 1-oly ) |
15323 |
integer sny |
15324 |
parameter ( sny = 40 ) |
15325 |
integer jmax |
15326 |
parameter ( jmax = sny+3 ) |
15327 |
integer jmin |
15328 |
parameter ( jmin = -2 ) |
15329 |
integer jtop |
15330 |
parameter ( jtop = sny+oly ) |
15331 |
integer mdiff |
15332 |
parameter ( mdiff = 3 ) |
15333 |
double precision minusone |
15334 |
parameter ( minusone = -1. ) |
15335 |
integer npx |
15336 |
parameter ( npx = 1 ) |
15337 |
integer npy |
15338 |
parameter ( npy = 1 ) |
15339 |
integer nr |
15340 |
parameter ( nr = 15 ) |
15341 |
integer nrm1 |
15342 |
parameter ( nrm1 = nr-1 ) |
15343 |
integer nrp1 |
15344 |
parameter ( nrp1 = nr+1 ) |
15345 |
integer nsx |
15346 |
parameter ( nsx = 1 ) |
15347 |
integer nsy |
15348 |
parameter ( nsy = 1 ) |
15349 |
integer nx |
15350 |
parameter ( nx = snx*nsx*npx ) |
15351 |
integer ny |
15352 |
parameter ( ny = sny*nsy*npy ) |
15353 |
double precision p0 |
15354 |
parameter ( p0 = 0. ) |
15355 |
double precision p125 |
15356 |
parameter ( p125 = 0.125 ) |
15357 |
double precision p5 |
15358 |
parameter ( p5 = 0.5 ) |
15359 |
|
15360 |
C============================================== |
15361 |
C define common blocks |
15362 |
C============================================== |
15363 |
common /addynvars_r/ adetan, aduvel, advvel, adwvel, adtheta, |
15364 |
$adsalt, adgu, adgv, adgt, adgs, adgunm1, adgvnm1, adgtnm1, adgsnm1 |
15365 |
double precision adetan(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
15366 |
double precision adgs(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
15367 |
double precision adgsnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
15368 |
double precision adgt(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
15369 |
double precision adgtnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
15370 |
double precision adgu(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
15371 |
double precision adgunm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
15372 |
double precision adgv(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
15373 |
double precision adgvnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
15374 |
double precision adsalt(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
15375 |
double precision adtheta(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
15376 |
double precision aduvel(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
15377 |
double precision advvel(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
15378 |
double precision adwvel(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
15379 |
|
15380 |
common /adkpp/ adkppviscaz, adkppdiffkzt, adkppdiffkzs, adkppghat, |
15381 |
$ adkpphbl |
15382 |
double precision adkppdiffkzs(1-olx:snx+olx,1-oly:sny+oly,nr,nsx, |
15383 |
$nsy) |
15384 |
double precision adkppdiffkzt(1-olx:snx+olx,1-oly:sny+oly,nr,nsx, |
15385 |
$nsy) |
15386 |
double precision adkppghat(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
15387 |
double precision adkpphbl(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
15388 |
double precision adkppviscaz(1-olx:snx+olx,1-oly:sny+oly,nr,nsx, |
15389 |
$nsy) |
15390 |
|
15391 |
common /adkpp_short/ adkppfrac |
15392 |
double precision adkppfrac(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
15393 |
|
15394 |
common /adtendency_forcing/ adsurfacetendencyu, |
15395 |
$adsurfacetendencyv, adsurfacetendencyt, adsurfacetendencys |
15396 |
double precision adsurfacetendencys(1-olx:snx+olx,1-oly:sny+oly, |
15397 |
$nsx,nsy) |
15398 |
double precision adsurfacetendencyt(1-olx:snx+olx,1-oly:sny+oly, |
15399 |
$nsx,nsy) |
15400 |
double precision adsurfacetendencyu(1-olx:snx+olx,1-oly:sny+oly, |
15401 |
$nsx,nsy) |
15402 |
double precision adsurfacetendencyv(1-olx:snx+olx,1-oly:sny+oly, |
15403 |
$nsx,nsy) |
15404 |
|
15405 |
common /dynvars_r/ etan, uvel, vvel, wvel, theta, salt, gu, gv, |
15406 |
$gt, gs, gunm1, gvnm1, gtnm1, gsnm1 |
15407 |
double precision etan(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
15408 |
double precision gs(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
15409 |
double precision gsnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
15410 |
double precision gt(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
15411 |
double precision gtnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
15412 |
double precision gu(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
15413 |
double precision gunm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
15414 |
double precision gv(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
15415 |
double precision gvnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
15416 |
double precision salt(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
15417 |
double precision theta(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
15418 |
double precision uvel(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
15419 |
double precision vvel(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
15420 |
double precision wvel(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
15421 |
|
15422 |
common /ffields/ fu, fv, qnet, empmr, sst, sss, qsw |
15423 |
double precision empmr(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
15424 |
double precision fu(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
15425 |
double precision fv(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
15426 |
double precision qnet(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
15427 |
double precision qsw(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
15428 |
double precision sss(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
15429 |
double precision sst(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
15430 |
|
15431 |
common /grid_r/ dxc, dxf, dxg, dxv, dyc, dyf, dyg, dyu, drc, drf, |
15432 |
$h, hfacc, hfacw, hfacs, depthink, recip_dxc, recip_dxf, recip_dxg, |
15433 |
$ recip_dxv, recip_dyc, recip_dyf, recip_dyg, recip_dyu, recip_drc, |
15434 |
$ recip_drf, recip_h, recip_hfacc, recip_hfacw, recip_hfacs, rkfac, |
15435 |
$ recip_rkfac, safac, xc, yc, ra, raw, ras, raz, rc, rf, yc0, xc0, |
15436 |
$xg, yg, maskw, masks, recip_ra, recip_raw, recip_ras, recip_raz, |
15437 |
$tanphiatu, tanphiatv |
15438 |
double precision depthink(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
15439 |
double precision drc(1:nr) |
15440 |
double precision drf(1:nr) |
15441 |
double precision dxc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
15442 |
double precision dxf(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
15443 |
double precision dxg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
15444 |
double precision dxv(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
15445 |
double precision dyc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
15446 |
double precision dyf(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
15447 |
double precision dyg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
15448 |
double precision dyu(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
15449 |
double precision h(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
15450 |
double precision hfacc(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) |
15451 |
double precision hfacs(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) |
15452 |
double precision hfacw(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) |
15453 |
double precision masks(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) |
15454 |
double precision maskw(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) |
15455 |
double precision ra(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
15456 |
double precision ras(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
15457 |
double precision raw(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
15458 |
double precision raz(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
15459 |
double precision rc(1:nr) |
15460 |
double precision recip_drc(1:nr) |
15461 |
double precision recip_drf(1:nr) |
15462 |
double precision recip_dxc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
15463 |
double precision recip_dxf(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
15464 |
double precision recip_dxg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
15465 |
double precision recip_dxv(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
15466 |
double precision recip_dyc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
15467 |
double precision recip_dyf(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
15468 |
double precision recip_dyg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
15469 |
double precision recip_dyu(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
15470 |
double precision recip_h(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
15471 |
double precision recip_hfacc(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx, |
15472 |
$nsy) |
15473 |
double precision recip_hfacs(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx, |
15474 |
$nsy) |
15475 |
double precision recip_hfacw(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx, |
15476 |
$nsy) |
15477 |
double precision recip_ra(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
15478 |
double precision recip_ras(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
15479 |
double precision recip_raw(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
15480 |
double precision recip_raz(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
15481 |
double precision recip_rkfac |
15482 |
double precision rf(1:nr+1) |
15483 |
double precision rkfac |
15484 |
double precision safac(1:nr) |
15485 |
double precision tanphiatu(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
15486 |
double precision tanphiatv(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
15487 |
double precision xc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
15488 |
double precision xc0 |
15489 |
double precision xg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
15490 |
double precision yc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
15491 |
double precision yc0 |
15492 |
double precision yg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
15493 |
|
15494 |
common /kmixcom/ epsln, phepsi, epsilon, vonk, db_dz, conc1, |
15495 |
$conam, concm, conc2, zetam, conas, concs, conc3, zetas |
15496 |
double precision conam |
15497 |
double precision conas |
15498 |
double precision conc1 |
15499 |
double precision conc2 |
15500 |
double precision conc3 |
15501 |
double precision concm |
15502 |
double precision concs |
15503 |
double precision db_dz |
15504 |
double precision epsilon |
15505 |
double precision epsln |
15506 |
double precision phepsi |
15507 |
double precision vonk |
15508 |
double precision zetam |
15509 |
double precision zetas |
15510 |
|
15511 |
common /kpp/ kppviscaz, kppdiffkzt, kppdiffkzs, kppghat, kpphbl |
15512 |
double precision kppdiffkzs(1-olx:snx+olx,1-oly:sny+oly,nr,nsx, |
15513 |
$nsy) |
15514 |
double precision kppdiffkzt(1-olx:snx+olx,1-oly:sny+oly,nr,nsx, |
15515 |
$nsy) |
15516 |
double precision kppghat(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
15517 |
double precision kpphbl(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
15518 |
double precision kppviscaz(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
15519 |
|
15520 |
common /kpp_i/ nzmax |
15521 |
integer nzmax(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
15522 |
|
15523 |
common /kpp_r1/ pmask, zgrid, hwide |
15524 |
double precision hwide(0:nr+1) |
15525 |
double precision pmask(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
15526 |
double precision zgrid(0:nr+1) |
15527 |
|
15528 |
common /kpp_r2/ kpp_freq, kpp_dumpfreq, kpp_tavefreq |
15529 |
double precision kpp_dumpfreq |
15530 |
double precision kpp_freq |
15531 |
double precision kpp_tavefreq |
15532 |
|
15533 |
common /parm_a/ heatcapacity_cp, recip_cp, lamba_theta |
15534 |
double precision heatcapacity_cp |
15535 |
double precision lamba_theta |
15536 |
double precision recip_cp |
15537 |
|
15538 |
common /parm_r/ cg2dtargetresidual, cg2dpcoffdfac, |
15539 |
$cg3dtargetresidual, delp, delz, delr, delx, dely, deltat, |
15540 |
$deltatmom, deltattracer, deltatclock, abeps, starttime, phimin, |
15541 |
$thetamin, rsphere, recip_rsphere, f0, fcori, beta, viscah, viscaz, |
15542 |
$ visca4, viscar, diffkht, diffkzt, diffk4t, diffkrt, diffkhs, |
15543 |
$diffkzs, diffk4s, diffkrs, delt, taucd, rcd, freesurffac, |
15544 |
$implicsurfpress, implicdiv2dflow, hfacmin, hfacmindz, gravity, |
15545 |
$recip_gravity, gbaro, rhonil, recip_rhonil, recip_rhoconst, |
15546 |
$rhoconst, tref, sref, endtime, chkptfreq, pchkptfreq, dumpfreq, |
15547 |
$tavefreq, affacmom, vffacmom, pffacmom, cffacmom, fofacmom, |
15548 |
$mtfacmom, cospower, cadjfreq, omega, tauthetaclimrelax, |
15549 |
$lambdathetaclimrelax, tausaltclimrelax, lambdasaltclimrelax, |
15550 |
$externforcingcycle, externforcingperiod, viscap, diffkpt, diffkps, |
15551 |
$ hfacmindr, hfacmindp, theta_s, specvol_s, horivertratio, |
15552 |
$recip_horivertratio, latfftfiltlo, ivdc_kappa, ro_sealevel, |
15553 |
$zonal_filt_lat, bottomdraglinear, bottomdragquadratic |
15554 |
double precision abeps |
15555 |
double precision affacmom |
15556 |
double precision beta |
15557 |
double precision bottomdraglinear |
15558 |
double precision bottomdragquadratic |
15559 |
double precision cadjfreq |
15560 |
double precision cffacmom |
15561 |
double precision cg2dpcoffdfac |
15562 |
double precision cg2dtargetresidual |
15563 |
double precision cg3dtargetresidual |
15564 |
double precision chkptfreq |
15565 |
double precision cospower |
15566 |
double precision delp(nr) |
15567 |
double precision delr(nr) |
15568 |
double precision delt |
15569 |
double precision deltat |
15570 |
double precision deltatclock |
15571 |
double precision deltatmom |
15572 |
double precision deltattracer |
15573 |
double precision delx(nx) |
15574 |
double precision dely(ny) |
15575 |
double precision delz(nr) |
15576 |
double precision diffk4s |
15577 |
double precision diffk4t |
15578 |
double precision diffkhs |
15579 |
double precision diffkht |
15580 |
double precision diffkps |
15581 |
double precision diffkpt |
15582 |
double precision diffkrs |
15583 |
double precision diffkrt |
15584 |
double precision diffkzs |
15585 |
double precision diffkzt |
15586 |
double precision dumpfreq |
15587 |
double precision endtime |
15588 |
double precision externforcingcycle |
15589 |
double precision externforcingperiod |
15590 |
double precision f0 |
15591 |
double precision fcori(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
15592 |
double precision fofacmom |
15593 |
double precision freesurffac |
15594 |
double precision gbaro |
15595 |
double precision gravity |
15596 |
double precision hfacmin |
15597 |
double precision hfacmindp |
15598 |
double precision hfacmindr |
15599 |
double precision hfacmindz |
15600 |
double precision horivertratio |
15601 |
double precision implicdiv2dflow |
15602 |
double precision implicsurfpress |
15603 |
double precision ivdc_kappa |
15604 |
double precision lambdasaltclimrelax |
15605 |
double precision lambdathetaclimrelax |
15606 |
double precision latfftfiltlo |
15607 |
double precision mtfacmom |
15608 |
double precision omega |
15609 |
double precision pchkptfreq |
15610 |
double precision pffacmom |
15611 |
double precision phimin |
15612 |
double precision rcd |
15613 |
double precision recip_gravity |
15614 |
double precision recip_horivertratio |
15615 |
double precision recip_rhoconst |
15616 |
double precision recip_rhonil |
15617 |
double precision recip_rsphere |
15618 |
double precision rhoconst |
15619 |
double precision rhonil |
15620 |
double precision ro_sealevel |
15621 |
double precision rsphere |
15622 |
double precision specvol_s(nr) |
15623 |
double precision sref(nr) |
15624 |
double precision starttime |
15625 |
double precision taucd |
15626 |
double precision tausaltclimrelax |
15627 |
double precision tauthetaclimrelax |
15628 |
double precision tavefreq |
15629 |
double precision theta_s(nr) |
15630 |
double precision thetamin |
15631 |
double precision tref(nr) |
15632 |
double precision vffacmom |
15633 |
double precision visca4 |
15634 |
double precision viscah |
15635 |
double precision viscap |
15636 |
double precision viscar |
15637 |
double precision viscaz |
15638 |
double precision zonal_filt_lat |
15639 |
|
15640 |
common /tamckeys/ key, ikey, idkey |
15641 |
integer idkey |
15642 |
integer ikey |
15643 |
integer key |
15644 |
|
15645 |
common /tendency_forcing/ surfacetendencyu, surfacetendencyv, |
15646 |
$surfacetendencyt, surfacetendencys, tempqsw |
15647 |
double precision surfacetendencys(1-olx:snx+olx,1-oly:sny+oly,nsx, |
15648 |
$nsy) |
15649 |
double precision surfacetendencyt(1-olx:snx+olx,1-oly:sny+oly,nsx, |
15650 |
$nsy) |
15651 |
double precision surfacetendencyu(1-olx:snx+olx,1-oly:sny+oly,nsx, |
15652 |
$nsy) |
15653 |
double precision surfacetendencyv(1-olx:snx+olx,1-oly:sny+oly,nsx, |
15654 |
$nsy) |
15655 |
double precision tempqsw(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
15656 |
|
15657 |
C============================================== |
15658 |
C define arguments |
15659 |
C============================================== |
15660 |
integer bi |
15661 |
integer bj |
15662 |
double precision mytime |
15663 |
|
15664 |
C============================================== |
15665 |
C define local variables |
15666 |
C============================================== |
15667 |
double precision adbo(ibot:itop,jbot:jtop) |
15668 |
double precision adbosol(ibot:itop,jbot:jtop) |
15669 |
double precision addbloc(ibot:itop,jbot:jtop,nr) |
15670 |
double precision addvsq(ibot:itop,jbot:jtop,nr) |
15671 |
double precision adghat(ibot:itop,jbot:jtop,nr) |
15672 |
double precision adhbl(ibot:itop,jbot:jtop) |
15673 |
double precision adritop(ibot:itop,jbot:jtop,nr) |
15674 |
double precision adshsq(ibot:itop,jbot:jtop,nr) |
15675 |
double precision adtempvar1 |
15676 |
double precision adtempvar2 |
15677 |
double precision adustar(ibot:itop,jbot:jtop) |
15678 |
double precision advddiff(ibot:itop,jbot:jtop,0:nrp1,mdiff) |
15679 |
double precision adwork2(ibot:itop,jbot:jtop) |
15680 |
double precision adworka(1-olx:snx+olx,1-oly:sny+oly) |
15681 |
double precision bo(ibot:itop,jbot:jtop) |
15682 |
double precision bosol(ibot:itop,jbot:jtop) |
15683 |
double precision dbloc(ibot:itop,jbot:jtop,nr) |
15684 |
double precision dvsq(ibot:itop,jbot:jtop,nr) |
15685 |
double precision ghat(ibot:itop,jbot:jtop,nr) |
15686 |
double precision hbl(ibot:itop,jbot:jtop) |
15687 |
integer help_h |
15688 |
integer help_i |
15689 |
integer i |
15690 |
integer im1 |
15691 |
integer ip1 |
15692 |
integer ip2 |
15693 |
integer ip3 |
15694 |
integer ip4 |
15695 |
integer ip5 |
15696 |
integer j |
15697 |
integer jm1 |
15698 |
integer jp1 |
15699 |
integer k |
15700 |
integer kp1 |
15701 |
integer mythid |
15702 |
double precision ritop(ibot:itop,jbot:jtop,nr) |
15703 |
double precision shsq(ibot:itop,jbot:jtop,nr) |
15704 |
double precision tempvar1 |
15705 |
double precision tempvar2 |
15706 |
double precision ustar(ibot:itop,jbot:jtop) |
15707 |
double precision vddiff(ibot:itop,jbot:jtop,0:nrp1,mdiff) |
15708 |
integer work1(ibot:itop,jbot:jtop) |
15709 |
double precision work2(ibot:itop,jbot:jtop) |
15710 |
double precision worka(1-olx:snx+olx,1-oly:sny+oly) |
15711 |
|
15712 |
C============================================== |
15713 |
C define external procedures and functions |
15714 |
C============================================== |
15715 |
logical different_multiple |
15716 |
external different_multiple |
15717 |
|
15718 |
C---------------------------------------------- |
15719 |
C RESET LOCAL ADJOINT VARIABLES |
15720 |
C---------------------------------------------- |
15721 |
do ip3 = jbot, jtop |
15722 |
do ip2 = ibot, itop |
15723 |
adbo(ip2,ip3) = 0.d0 |
15724 |
end do |
15725 |
end do |
15726 |
do ip3 = jbot, jtop |
15727 |
do ip2 = ibot, itop |
15728 |
adbosol(ip2,ip3) = 0.d0 |
15729 |
end do |
15730 |
end do |
15731 |
do ip4 = 1, nr |
15732 |
do ip3 = jbot, jtop |
15733 |
do ip2 = ibot, itop |
15734 |
addbloc(ip2,ip3,ip4) = 0.d0 |
15735 |
end do |
15736 |
end do |
15737 |
end do |
15738 |
do ip4 = 1, nr |
15739 |
do ip3 = jbot, jtop |
15740 |
do ip2 = ibot, itop |
15741 |
addvsq(ip2,ip3,ip4) = 0.d0 |
15742 |
end do |
15743 |
end do |
15744 |
end do |
15745 |
do ip4 = 1, nr |
15746 |
do ip3 = jbot, jtop |
15747 |
do ip2 = ibot, itop |
15748 |
adghat(ip2,ip3,ip4) = 0.d0 |
15749 |
end do |
15750 |
end do |
15751 |
end do |
15752 |
do ip3 = jbot, jtop |
15753 |
do ip2 = ibot, itop |
15754 |
adhbl(ip2,ip3) = 0.d0 |
15755 |
end do |
15756 |
end do |
15757 |
do ip4 = 1, nr |
15758 |
do ip3 = jbot, jtop |
15759 |
do ip2 = ibot, itop |
15760 |
adritop(ip2,ip3,ip4) = 0.d0 |
15761 |
end do |
15762 |
end do |
15763 |
end do |
15764 |
do ip4 = 1, nr |
15765 |
do ip3 = jbot, jtop |
15766 |
do ip2 = ibot, itop |
15767 |
adshsq(ip2,ip3,ip4) = 0.d0 |
15768 |
end do |
15769 |
end do |
15770 |
end do |
15771 |
adtempvar1 = 0.d0 |
15772 |
adtempvar2 = 0.d0 |
15773 |
do ip3 = jbot, jtop |
15774 |
do ip2 = ibot, itop |
15775 |
adustar(ip2,ip3) = 0.d0 |
15776 |
end do |
15777 |
end do |
15778 |
do ip5 = 1, mdiff |
15779 |
do ip4 = 0, nrp1 |
15780 |
do ip3 = jbot, jtop |
15781 |
do ip2 = ibot, itop |
15782 |
advddiff(ip2,ip3,ip4,ip5) = 0.d0 |
15783 |
end do |
15784 |
end do |
15785 |
end do |
15786 |
end do |
15787 |
do ip3 = jbot, jtop |
15788 |
do ip2 = ibot, itop |
15789 |
adwork2(ip2,ip3) = 0.d0 |
15790 |
end do |
15791 |
end do |
15792 |
do ip3 = 1-oly, sny+oly |
15793 |
do ip2 = 1-olx, snx+olx |
15794 |
adworka(ip2,ip3) = 0.d0 |
15795 |
end do |
15796 |
end do |
15797 |
|
15798 |
C---------------------------------------------- |
15799 |
C ROUTINE BODY |
15800 |
C---------------------------------------------- |
15801 |
if (different_multiple(kpp_freq,mytime,mytime-deltatclock) .or. |
15802 |
$mytime .eq. starttime) then |
15803 |
call statekpp( bi,bj,mythid,work2,dbloc,ritop,vddiff(ibot,jbot, |
15804 |
$1,1),vddiff(ibot,jbot,1,2) ) |
15805 |
do k = 1, nr |
15806 |
do j = jbot, jtop |
15807 |
do i = ibot, itop |
15808 |
ghat(i,j,k) = dbloc(i,j,k) |
15809 |
end do |
15810 |
end do |
15811 |
end do |
15812 |
do k = 1, nr-1 |
15813 |
help_h = k+1 |
15814 |
call kpp_smooth_horiz( help_h,bi,bj,ghat(ibot,jbot,k) ) |
15815 |
end do |
15816 |
do k = 1, nr |
15817 |
do j = jbot, jtop |
15818 |
do i = ibot, itop |
15819 |
dbloc(i,j,k) = dbloc(i,j,k)*pmask(i,j,k,bi,bj) |
15820 |
ghat(i,j,k) = ghat(i,j,k)*pmask(i,j,k,bi,bj) |
15821 |
ritop(i,j,k) = ritop(i,j,k)*pmask(i,j,k,bi,bj) |
15822 |
if (k .eq. nzmax(i,j,bi,bj)) then |
15823 |
dbloc(i,j,k) = p0 |
15824 |
ghat(i,j,k) = p0 |
15825 |
ritop(i,j,k) = p0 |
15826 |
endif |
15827 |
ritop(i,j,k) = (zgrid(1)-zgrid(k))*ritop(i,j,k) |
15828 |
end do |
15829 |
end do |
15830 |
end do |
15831 |
do j = jbot, jtop |
15832 |
do i = ibot, itop |
15833 |
ustar(i,j) = p0 |
15834 |
bo(i,j) = p0 |
15835 |
bosol(i,j) = p0 |
15836 |
end do |
15837 |
end do |
15838 |
do j = jmin, jmax |
15839 |
jp1 = j+1 |
15840 |
do i = imin, imax |
15841 |
ip1 = i+1 |
15842 |
tempvar1 = (surfacetendencyu(i,j,bi,bj)+ |
15843 |
$surfacetendencyu(ip1,j,bi,bj))*(surfacetendencyu(i,j,bi,bj)+ |
15844 |
$surfacetendencyu(ip1,j,bi,bj))+(surfacetendencyv(i,j,bi,bj)+ |
15845 |
$surfacetendencyv(i,jp1,bi,bj))*(surfacetendencyv(i,j,bi,bj)+ |
15846 |
$surfacetendencyv(i,jp1,bi,bj)) |
15847 |
if (tempvar1 .lt. phepsi*phepsi) then |
15848 |
ustar(i,j) = sqrt(phepsi*p5*delz(1)) |
15849 |
else |
15850 |
tempvar2 = sqrt(tempvar1)*p5*delz(1) |
15851 |
ustar(i,j) = sqrt(tempvar2) |
15852 |
endif |
15853 |
bo(i,j) = -(gravity*(vddiff(i,j,1,1)*surfacetendencyt(i,j, |
15854 |
$bi,bj)+vddiff(i,j,1,2)*surfacetendencys(i,j,bi,bj))*delz(1)/ |
15855 |
$work2(i,j)) |
15856 |
bosol(i,j) = gravity*vddiff(i,j,1,1)*qsw(i,j,bi,bj)* |
15857 |
$recip_cp*recip_rhonil*recip_drf(1)*delz(1)/work2(i,j) |
15858 |
end do |
15859 |
end do |
15860 |
do k = 1, nr |
15861 |
do j = jbot, jtop |
15862 |
do i = ibot, itop |
15863 |
shsq(i,j,k) = p0 |
15864 |
dvsq(i,j,k) = p0 |
15865 |
end do |
15866 |
end do |
15867 |
end do |
15868 |
do k = 1, nr |
15869 |
do j = jmin, jmax |
15870 |
jp1 = j+1 |
15871 |
do i = imin, imax |
15872 |
ip1 = i+1 |
15873 |
dvsq(i,j,k) = p5*((uvel(i,j,1,bi,bj)-uvel(i,j,k,bi,bj))* |
15874 |
$(uvel(i,j,1,bi,bj)-uvel(i,j,k,bi,bj))+(uvel(ip1,j,1,bi,bj)- |
15875 |
$uvel(ip1,j,k,bi,bj))*(uvel(ip1,j,1,bi,bj)-uvel(ip1,j,k,bi,bj))+ |
15876 |
$(vvel(i,j,1,bi,bj)-vvel(i,j,k,bi,bj))*(vvel(i,j,1,bi,bj)-vvel(i,j, |
15877 |
$k,bi,bj))+(vvel(i,jp1,1,bi,bj)-vvel(i,jp1,k,bi,bj))*(vvel(i,jp1,1, |
15878 |
$bi,bj)-vvel(i,jp1,k,bi,bj))) |
15879 |
end do |
15880 |
end do |
15881 |
end do |
15882 |
do k = 1, nrm1 |
15883 |
kp1 = k+1 |
15884 |
do j = jmin, jmax |
15885 |
jm1 = j-1 |
15886 |
jp1 = j+1 |
15887 |
do i = imin, imax |
15888 |
im1 = i-1 |
15889 |
ip1 = i+1 |
15890 |
shsq(i,j,k) = p5*((uvel(i,j,k,bi,bj)-uvel(i,j,kp1,bi,bj))* |
15891 |
$(uvel(i,j,k,bi,bj)-uvel(i,j,kp1,bi,bj))+(uvel(ip1,j,k,bi,bj)- |
15892 |
$uvel(ip1,j,kp1,bi,bj))*(uvel(ip1,j,k,bi,bj)-uvel(ip1,j,kp1,bi,bj)) |
15893 |
$+(vvel(i,j,k,bi,bj)-vvel(i,j,kp1,bi,bj))*(vvel(i,j,k,bi,bj)- |
15894 |
$vvel(i,j,kp1,bi,bj))+(vvel(i,jp1,k,bi,bj)-vvel(i,jp1,kp1,bi,bj))* |
15895 |
$(vvel(i,jp1,k,bi,bj)-vvel(i,jp1,kp1,bi,bj))) |
15896 |
shsq(i,j,k) = p5*shsq(i,j,k)+p125*((uvel(i,jm1,k,bi,bj)- |
15897 |
$uvel(i,jm1,kp1,bi,bj))*(uvel(i,jm1,k,bi,bj)-uvel(i,jm1,kp1,bi,bj)) |
15898 |
$+(uvel(ip1,jm1,k,bi,bj)-uvel(ip1,jm1,kp1,bi,bj))*(uvel(ip1,jm1,k, |
15899 |
$bi,bj)-uvel(ip1,jm1,kp1,bi,bj))+(uvel(i,jp1,k,bi,bj)-uvel(i,jp1, |
15900 |
$kp1,bi,bj))*(uvel(i,jp1,k,bi,bj)-uvel(i,jp1,kp1,bi,bj))+(uvel(ip1, |
15901 |
$jp1,k,bi,bj)-uvel(ip1,jp1,kp1,bi,bj))*(uvel(ip1,jp1,k,bi,bj)- |
15902 |
$uvel(ip1,jp1,kp1,bi,bj))+(vvel(im1,j,k,bi,bj)-vvel(im1,j,kp1,bi, |
15903 |
$bj))*(vvel(im1,j,k,bi,bj)-vvel(im1,j,kp1,bi,bj))+(vvel(im1,jp1,k, |
15904 |
$bi,bj)-vvel(im1,jp1,kp1,bi,bj))*(vvel(im1,jp1,k,bi,bj)-vvel(im1, |
15905 |
$jp1,kp1,bi,bj))+(vvel(ip1,j,k,bi,bj)-vvel(ip1,j,kp1,bi,bj))* |
15906 |
$(vvel(ip1,j,k,bi,bj)-vvel(ip1,j,kp1,bi,bj))+(vvel(ip1,jp1,k,bi,bj) |
15907 |
$-vvel(ip1,jp1,kp1,bi,bj))*(vvel(ip1,jp1,k,bi,bj)-vvel(ip1,jp1,kp1, |
15908 |
$bi,bj))) |
15909 |
end do |
15910 |
end do |
15911 |
end do |
15912 |
do j = jbot, jtop |
15913 |
do i = ibot, itop |
15914 |
work1(i,j) = nzmax(i,j,bi,bj) |
15915 |
work2(i,j) = fcori(i,j,bi,bj) |
15916 |
end do |
15917 |
end do |
15918 |
call kppmix( mytime,mythid,work1,shsq,dvsq,ustar,bo,bosol,dbloc, |
15919 |
$ritop,work2,ikey,vddiff,ghat,hbl ) |
15920 |
do j = jmin, jmax |
15921 |
do i = imin, imax |
15922 |
kpphbl(i,j,bi,bj) = hbl(i,j)*pmask(i,j,1,bi,bj) |
15923 |
end do |
15924 |
end do |
15925 |
do j = 1-oly, sny+oly |
15926 |
do i = 1-olx, snx+olx |
15927 |
worka(i,j) = kpphbl(i,j,bi,bj) |
15928 |
end do |
15929 |
end do |
15930 |
help_i = (snx+2*olx)*(sny+2*oly) |
15931 |
do j = 1-oly, sny+oly |
15932 |
do i = 1-olx, snx+olx |
15933 |
adworka(i,j) = adworka(i,j)+adkppfrac(i,j,bi,bj) |
15934 |
adkppfrac(i,j,bi,bj) = 0.d0 |
15935 |
end do |
15936 |
end do |
15937 |
call adswfrac( help_i,minusone,worka,adworka ) |
15938 |
do j = 1-oly, sny+oly |
15939 |
do i = 1-olx, snx+olx |
15940 |
adkpphbl(i,j,bi,bj) = adkpphbl(i,j,bi,bj)+adworka(i,j) |
15941 |
adworka(i,j) = 0.d0 |
15942 |
end do |
15943 |
end do |
15944 |
do j = jmin, jmax |
15945 |
do i = imin, imax |
15946 |
adhbl(i,j) = adhbl(i,j)+adkpphbl(i,j,bi,bj)*pmask(i,j,1,bi, |
15947 |
$bj) |
15948 |
adkpphbl(i,j,bi,bj) = 0.d0 |
15949 |
do k = 1, nr |
15950 |
adghat(i,j,k) = adghat(i,j,k)+adkppghat(i,j,k,bi,bj)* |
15951 |
$pmask(i,j,k,bi,bj) |
15952 |
adkppghat(i,j,k,bi,bj) = 0.d0 |
15953 |
advddiff(i,j,k-1,3) = advddiff(i,j,k-1,3)+adkppdiffkzt(i, |
15954 |
$j,k,bi,bj)*pmask(i,j,k,bi,bj) |
15955 |
adkppdiffkzt(i,j,k,bi,bj) = 0.d0 |
15956 |
advddiff(i,j,k-1,2) = advddiff(i,j,k-1,2)+adkppdiffkzs(i, |
15957 |
$j,k,bi,bj)*pmask(i,j,k,bi,bj) |
15958 |
adkppdiffkzs(i,j,k,bi,bj) = 0.d0 |
15959 |
advddiff(i,j,k-1,1) = advddiff(i,j,k-1,1)+adkppviscaz(i,j, |
15960 |
$k,bi,bj)*pmask(i,j,k,bi,bj) |
15961 |
adkppviscaz(i,j,k,bi,bj) = 0.d0 |
15962 |
end do |
15963 |
end do |
15964 |
end do |
15965 |
call adkppmix( work1,shsq,dvsq,ustar,bo,bosol,dbloc,ritop,work2, |
15966 |
$ikey,adshsq,addvsq,adustar,adbo,adbosol,addbloc,adritop,adwork2, |
15967 |
$advddiff,adghat,adhbl ) |
15968 |
do j = jbot, jtop |
15969 |
do i = ibot, itop |
15970 |
adwork2(i,j) = 0.d0 |
15971 |
end do |
15972 |
end do |
15973 |
do k = 1, nrm1 |
15974 |
kp1 = k+1 |
15975 |
do j = jmin, jmax |
15976 |
jm1 = j-1 |
15977 |
jp1 = j+1 |
15978 |
do i = imin, imax |
15979 |
im1 = i-1 |
15980 |
ip1 = i+1 |
15981 |
aduvel(i,jm1,k,bi,bj) = aduvel(i,jm1,k,bi,bj)+2*adshsq(i, |
15982 |
$j,k)*p125*(uvel(i,jm1,k,bi,bj)-uvel(i,jm1,kp1,bi,bj)) |
15983 |
aduvel(ip1,jm1,k,bi,bj) = aduvel(ip1,jm1,k,bi,bj)+2* |
15984 |
$adshsq(i,j,k)*p125*(uvel(ip1,jm1,k,bi,bj)-uvel(ip1,jm1,kp1,bi,bj)) |
15985 |
aduvel(i,jm1,kp1,bi,bj) = aduvel(i,jm1,kp1,bi,bj)-2* |
15986 |
$adshsq(i,j,k)*p125*(uvel(i,jm1,k,bi,bj)-uvel(i,jm1,kp1,bi,bj)) |
15987 |
aduvel(ip1,jm1,kp1,bi,bj) = aduvel(ip1,jm1,kp1,bi,bj)-2* |
15988 |
$adshsq(i,j,k)*p125*(uvel(ip1,jm1,k,bi,bj)-uvel(ip1,jm1,kp1,bi,bj)) |
15989 |
aduvel(i,jp1,k,bi,bj) = aduvel(i,jp1,k,bi,bj)+2*adshsq(i, |
15990 |
$j,k)*p125*(uvel(i,jp1,k,bi,bj)-uvel(i,jp1,kp1,bi,bj)) |
15991 |
aduvel(ip1,jp1,k,bi,bj) = aduvel(ip1,jp1,k,bi,bj)+2* |
15992 |
$adshsq(i,j,k)*p125*(uvel(ip1,jp1,k,bi,bj)-uvel(ip1,jp1,kp1,bi,bj)) |
15993 |
aduvel(i,jp1,kp1,bi,bj) = aduvel(i,jp1,kp1,bi,bj)-2* |
15994 |
$adshsq(i,j,k)*p125*(uvel(i,jp1,k,bi,bj)-uvel(i,jp1,kp1,bi,bj)) |
15995 |
aduvel(ip1,jp1,kp1,bi,bj) = aduvel(ip1,jp1,kp1,bi,bj)-2* |
15996 |
$adshsq(i,j,k)*p125*(uvel(ip1,jp1,k,bi,bj)-uvel(ip1,jp1,kp1,bi,bj)) |
15997 |
advvel(im1,j,k,bi,bj) = advvel(im1,j,k,bi,bj)+2*adshsq(i, |
15998 |
$j,k)*p125*(vvel(im1,j,k,bi,bj)-vvel(im1,j,kp1,bi,bj)) |
15999 |
advvel(ip1,j,k,bi,bj) = advvel(ip1,j,k,bi,bj)+2*adshsq(i, |
16000 |
$j,k)*p125*(vvel(ip1,j,k,bi,bj)-vvel(ip1,j,kp1,bi,bj)) |
16001 |
advvel(im1,j,kp1,bi,bj) = advvel(im1,j,kp1,bi,bj)-2* |
16002 |
$adshsq(i,j,k)*p125*(vvel(im1,j,k,bi,bj)-vvel(im1,j,kp1,bi,bj)) |
16003 |
advvel(ip1,j,kp1,bi,bj) = advvel(ip1,j,kp1,bi,bj)-2* |
16004 |
$adshsq(i,j,k)*p125*(vvel(ip1,j,k,bi,bj)-vvel(ip1,j,kp1,bi,bj)) |
16005 |
advvel(im1,jp1,k,bi,bj) = advvel(im1,jp1,k,bi,bj)+2* |
16006 |
$adshsq(i,j,k)*p125*(vvel(im1,jp1,k,bi,bj)-vvel(im1,jp1,kp1,bi,bj)) |
16007 |
advvel(ip1,jp1,k,bi,bj) = advvel(ip1,jp1,k,bi,bj)+2* |
16008 |
$adshsq(i,j,k)*p125*(vvel(ip1,jp1,k,bi,bj)-vvel(ip1,jp1,kp1,bi,bj)) |
16009 |
advvel(im1,jp1,kp1,bi,bj) = advvel(im1,jp1,kp1,bi,bj)-2* |
16010 |
$adshsq(i,j,k)*p125*(vvel(im1,jp1,k,bi,bj)-vvel(im1,jp1,kp1,bi,bj)) |
16011 |
advvel(ip1,jp1,kp1,bi,bj) = advvel(ip1,jp1,kp1,bi,bj)-2* |
16012 |
$adshsq(i,j,k)*p125*(vvel(ip1,jp1,k,bi,bj)-vvel(ip1,jp1,kp1,bi,bj)) |
16013 |
adshsq(i,j,k) = adshsq(i,j,k)*p5 |
16014 |
aduvel(i,j,k,bi,bj) = aduvel(i,j,k,bi,bj)+2*adshsq(i,j,k)* |
16015 |
$p5*(uvel(i,j,k,bi,bj)-uvel(i,j,kp1,bi,bj)) |
16016 |
aduvel(ip1,j,k,bi,bj) = aduvel(ip1,j,k,bi,bj)+2*adshsq(i, |
16017 |
$j,k)*p5*(uvel(ip1,j,k,bi,bj)-uvel(ip1,j,kp1,bi,bj)) |
16018 |
aduvel(i,j,kp1,bi,bj) = aduvel(i,j,kp1,bi,bj)-2*adshsq(i, |
16019 |
$j,k)*p5*(uvel(i,j,k,bi,bj)-uvel(i,j,kp1,bi,bj)) |
16020 |
aduvel(ip1,j,kp1,bi,bj) = aduvel(ip1,j,kp1,bi,bj)-2* |
16021 |
$adshsq(i,j,k)*p5*(uvel(ip1,j,k,bi,bj)-uvel(ip1,j,kp1,bi,bj)) |
16022 |
advvel(i,j,k,bi,bj) = advvel(i,j,k,bi,bj)+2*adshsq(i,j,k)* |
16023 |
$p5*(vvel(i,j,k,bi,bj)-vvel(i,j,kp1,bi,bj)) |
16024 |
advvel(i,j,kp1,bi,bj) = advvel(i,j,kp1,bi,bj)-2*adshsq(i, |
16025 |
$j,k)*p5*(vvel(i,j,k,bi,bj)-vvel(i,j,kp1,bi,bj)) |
16026 |
advvel(i,jp1,k,bi,bj) = advvel(i,jp1,k,bi,bj)+2*adshsq(i, |
16027 |
$j,k)*p5*(vvel(i,jp1,k,bi,bj)-vvel(i,jp1,kp1,bi,bj)) |
16028 |
advvel(i,jp1,kp1,bi,bj) = advvel(i,jp1,kp1,bi,bj)-2* |
16029 |
$adshsq(i,j,k)*p5*(vvel(i,jp1,k,bi,bj)-vvel(i,jp1,kp1,bi,bj)) |
16030 |
adshsq(i,j,k) = 0.d0 |
16031 |
end do |
16032 |
end do |
16033 |
end do |
16034 |
do k = 1, nr |
16035 |
do j = jmin, jmax |
16036 |
jp1 = j+1 |
16037 |
do i = imin, imax |
16038 |
ip1 = i+1 |
16039 |
aduvel(i,j,k,bi,bj) = aduvel(i,j,k,bi,bj)-2*addvsq(i,j,k)* |
16040 |
$p5*(uvel(i,j,1,bi,bj)-uvel(i,j,k,bi,bj)) |
16041 |
aduvel(ip1,j,k,bi,bj) = aduvel(ip1,j,k,bi,bj)-2*addvsq(i, |
16042 |
$j,k)*p5*(uvel(ip1,j,1,bi,bj)-uvel(ip1,j,k,bi,bj)) |
16043 |
aduvel(i,j,1,bi,bj) = aduvel(i,j,1,bi,bj)+2*addvsq(i,j,k)* |
16044 |
$p5*(uvel(i,j,1,bi,bj)-uvel(i,j,k,bi,bj)) |
16045 |
aduvel(ip1,j,1,bi,bj) = aduvel(ip1,j,1,bi,bj)+2*addvsq(i, |
16046 |
$j,k)*p5*(uvel(ip1,j,1,bi,bj)-uvel(ip1,j,k,bi,bj)) |
16047 |
advvel(i,j,k,bi,bj) = advvel(i,j,k,bi,bj)-2*addvsq(i,j,k)* |
16048 |
$p5*(vvel(i,j,1,bi,bj)-vvel(i,j,k,bi,bj)) |
16049 |
advvel(i,j,1,bi,bj) = advvel(i,j,1,bi,bj)+2*addvsq(i,j,k)* |
16050 |
$p5*(vvel(i,j,1,bi,bj)-vvel(i,j,k,bi,bj)) |
16051 |
advvel(i,jp1,k,bi,bj) = advvel(i,jp1,k,bi,bj)-2*addvsq(i, |
16052 |
$j,k)*p5*(vvel(i,jp1,1,bi,bj)-vvel(i,jp1,k,bi,bj)) |
16053 |
advvel(i,jp1,1,bi,bj) = advvel(i,jp1,1,bi,bj)+2*addvsq(i, |
16054 |
$j,k)*p5*(vvel(i,jp1,1,bi,bj)-vvel(i,jp1,k,bi,bj)) |
16055 |
addvsq(i,j,k) = 0.d0 |
16056 |
end do |
16057 |
end do |
16058 |
end do |
16059 |
call statekpp( bi,bj,mythid,work2,dbloc,ritop,vddiff(ibot,jbot, |
16060 |
$1,1),vddiff(ibot,jbot,1,2) ) |
16061 |
do j = jbot, jtop |
16062 |
do i = ibot, itop |
16063 |
ustar(i,j) = p0 |
16064 |
bo(i,j) = p0 |
16065 |
bosol(i,j) = p0 |
16066 |
end do |
16067 |
end do |
16068 |
do j = jmin, jmax |
16069 |
adtempvar1 = 0.d0 |
16070 |
adtempvar2 = 0.d0 |
16071 |
jp1 = j+1 |
16072 |
do i = imin, imax |
16073 |
adtempvar1 = 0.d0 |
16074 |
adtempvar2 = 0.d0 |
16075 |
ip1 = i+1 |
16076 |
tempvar1 = (surfacetendencyu(i,j,bi,bj)+ |
16077 |
$surfacetendencyu(ip1,j,bi,bj))*(surfacetendencyu(i,j,bi,bj)+ |
16078 |
$surfacetendencyu(ip1,j,bi,bj))+(surfacetendencyv(i,j,bi,bj)+ |
16079 |
$surfacetendencyv(i,jp1,bi,bj))*(surfacetendencyv(i,j,bi,bj)+ |
16080 |
$surfacetendencyv(i,jp1,bi,bj)) |
16081 |
advddiff(i,j,1,1) = advddiff(i,j,1,1)+adbosol(i,j)*(gravity* |
16082 |
$qsw(i,j,bi,bj)*recip_cp*recip_rhonil*recip_drf(1)*delz(1)/work2(i, |
16083 |
$j)) |
16084 |
adwork2(i,j) = adwork2(i,j)-adbosol(i,j)*(gravity*vddiff(i, |
16085 |
$j,1,1)*qsw(i,j,bi,bj)*recip_cp*recip_rhonil*recip_drf(1)*delz(1)/ |
16086 |
$(work2(i,j)*work2(i,j))) |
16087 |
adbosol(i,j) = 0.d0 |
16088 |
adsurfacetendencys(i,j,bi,bj) = adsurfacetendencys(i,j,bi, |
16089 |
$bj)-adbo(i,j)*(gravity*vddiff(i,j,1,2)*delz(1)/work2(i,j)) |
16090 |
adsurfacetendencyt(i,j,bi,bj) = adsurfacetendencyt(i,j,bi, |
16091 |
$bj)-adbo(i,j)*(gravity*vddiff(i,j,1,1)*delz(1)/work2(i,j)) |
16092 |
advddiff(i,j,1,2) = advddiff(i,j,1,2)-adbo(i,j)*(gravity* |
16093 |
$surfacetendencys(i,j,bi,bj)*delz(1)/work2(i,j)) |
16094 |
advddiff(i,j,1,1) = advddiff(i,j,1,1)-adbo(i,j)*(gravity* |
16095 |
$surfacetendencyt(i,j,bi,bj)*delz(1)/work2(i,j)) |
16096 |
adwork2(i,j) = adwork2(i,j)+adbo(i,j)*(gravity*(vddiff(i,j, |
16097 |
$1,1)*surfacetendencyt(i,j,bi,bj)+vddiff(i,j,1,2)* |
16098 |
$surfacetendencys(i,j,bi,bj))*delz(1)/(work2(i,j)*work2(i,j))) |
16099 |
adbo(i,j) = 0.d0 |
16100 |
if (tempvar1 .lt. phepsi*phepsi) then |
16101 |
adustar(i,j) = 0.d0 |
16102 |
else |
16103 |
tempvar2 = sqrt(tempvar1)*p5*delz(1) |
16104 |
adtempvar2 = adtempvar2+adustar(i,j)*(1./(2.* |
16105 |
$sqrt(tempvar2))) |
16106 |
adustar(i,j) = 0.d0 |
16107 |
adtempvar1 = adtempvar1+adtempvar2*1./(2.*sqrt(tempvar1))* |
16108 |
$p5*delz(1) |
16109 |
adtempvar2 = 0.d0 |
16110 |
endif |
16111 |
adsurfacetendencyu(i,j,bi,bj) = adsurfacetendencyu(i,j,bi, |
16112 |
$bj)+adtempvar1*(surfacetendencyu(i,j,bi,bj)+surfacetendencyu(ip1, |
16113 |
$j,bi,bj)+surfacetendencyu(i,j,bi,bj)+surfacetendencyu(ip1,j,bi,bj) |
16114 |
$) |
16115 |
adsurfacetendencyu(ip1,j,bi,bj) = adsurfacetendencyu(ip1,j, |
16116 |
$bi,bj)+adtempvar1*(surfacetendencyu(i,j,bi,bj)+ |
16117 |
$surfacetendencyu(ip1,j,bi,bj)+surfacetendencyu(i,j,bi,bj)+ |
16118 |
$surfacetendencyu(ip1,j,bi,bj)) |
16119 |
adsurfacetendencyv(i,j,bi,bj) = adsurfacetendencyv(i,j,bi, |
16120 |
$bj)+adtempvar1*(surfacetendencyv(i,j,bi,bj)+surfacetendencyv(i, |
16121 |
$jp1,bi,bj)+surfacetendencyv(i,j,bi,bj)+surfacetendencyv(i,jp1,bi, |
16122 |
$bj)) |
16123 |
adsurfacetendencyv(i,jp1,bi,bj) = adsurfacetendencyv(i,jp1, |
16124 |
$bi,bj)+adtempvar1*(surfacetendencyv(i,j,bi,bj)+surfacetendencyv(i, |
16125 |
$jp1,bi,bj)+surfacetendencyv(i,j,bi,bj)+surfacetendencyv(i,jp1,bi, |
16126 |
$bj)) |
16127 |
adtempvar1 = 0.d0 |
16128 |
end do |
16129 |
end do |
16130 |
do k = 1, nr |
16131 |
do j = jbot, jtop |
16132 |
do i = ibot, itop |
16133 |
adritop(i,j,k) = adritop(i,j,k)*(zgrid(1)-zgrid(k)) |
16134 |
if (k .eq. nzmax(i,j,bi,bj)) then |
16135 |
adritop(i,j,k) = 0.d0 |
16136 |
adghat(i,j,k) = 0.d0 |
16137 |
addbloc(i,j,k) = 0.d0 |
16138 |
endif |
16139 |
adritop(i,j,k) = adritop(i,j,k)*pmask(i,j,k,bi,bj) |
16140 |
adghat(i,j,k) = adghat(i,j,k)*pmask(i,j,k,bi,bj) |
16141 |
addbloc(i,j,k) = addbloc(i,j,k)*pmask(i,j,k,bi,bj) |
16142 |
end do |
16143 |
end do |
16144 |
end do |
16145 |
do k = nr-1, 1, -1 |
16146 |
help_h = k+1 |
16147 |
call adkpp_smooth_horiz( help_h,bi,bj,adghat(ibot,jbot,k) ) |
16148 |
end do |
16149 |
do k = 1, nr |
16150 |
do j = jbot, jtop |
16151 |
do i = ibot, itop |
16152 |
addbloc(i,j,k) = addbloc(i,j,k)+adghat(i,j,k) |
16153 |
adghat(i,j,k) = 0.d0 |
16154 |
end do |
16155 |
end do |
16156 |
end do |
16157 |
call adstatekpp( bi,bj,adwork2,addbloc,adritop,advddiff(ibot, |
16158 |
$jbot,1,1),advddiff(ibot,jbot,1,2) ) |
16159 |
endif |
16160 |
|
16161 |
end |
16162 |
|
16163 |
|
16164 |
subroutine adkpp_calc_diff( bi, bj, imin, imax, jmin, jmax, k, |
16165 |
$maskup, kapparu, kapparv, adkappart, adkappars, adkapparu, |
16166 |
$adkapparv ) |
16167 |
C*************************************************************** |
16168 |
C*************************************************************** |
16169 |
C** This routine was generated by the ** |
16170 |
C** Tangent linear and Adjoint Model Compiler, TAMC 5.2.14 ** |
16171 |
C*************************************************************** |
16172 |
C*************************************************************** |
16173 |
C============================================== |
16174 |
C all entries are defined explicitly |
16175 |
C============================================== |
16176 |
implicit none |
16177 |
|
16178 |
C============================================== |
16179 |
C define parameters |
16180 |
C============================================== |
16181 |
integer npx |
16182 |
parameter ( npx = 1 ) |
16183 |
integer npy |
16184 |
parameter ( npy = 1 ) |
16185 |
integer nr |
16186 |
parameter ( nr = 15 ) |
16187 |
integer nsx |
16188 |
parameter ( nsx = 1 ) |
16189 |
integer nsy |
16190 |
parameter ( nsy = 1 ) |
16191 |
integer snx |
16192 |
parameter ( snx = 20 ) |
16193 |
integer nx |
16194 |
parameter ( nx = snx*nsx*npx ) |
16195 |
integer sny |
16196 |
parameter ( sny = 40 ) |
16197 |
integer ny |
16198 |
parameter ( ny = sny*nsy*npy ) |
16199 |
integer olx |
16200 |
parameter ( olx = 3 ) |
16201 |
integer oly |
16202 |
parameter ( oly = 3 ) |
16203 |
|
16204 |
C============================================== |
16205 |
C define common blocks |
16206 |
C============================================== |
16207 |
common /adkpp/ adkppviscaz, adkppdiffkzt, adkppdiffkzs, adkppghat, |
16208 |
$ adkpphbl |
16209 |
double precision adkppdiffkzs(1-olx:snx+olx,1-oly:sny+oly,nr,nsx, |
16210 |
$nsy) |
16211 |
double precision adkppdiffkzt(1-olx:snx+olx,1-oly:sny+oly,nr,nsx, |
16212 |
$nsy) |
16213 |
double precision adkppghat(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
16214 |
double precision adkpphbl(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
16215 |
double precision adkppviscaz(1-olx:snx+olx,1-oly:sny+oly,nr,nsx, |
16216 |
$nsy) |
16217 |
|
16218 |
common /grid_r/ dxc, dxf, dxg, dxv, dyc, dyf, dyg, dyu, drc, drf, |
16219 |
$h, hfacc, hfacw, hfacs, depthink, recip_dxc, recip_dxf, recip_dxg, |
16220 |
$ recip_dxv, recip_dyc, recip_dyf, recip_dyg, recip_dyu, recip_drc, |
16221 |
$ recip_drf, recip_h, recip_hfacc, recip_hfacw, recip_hfacs, rkfac, |
16222 |
$ recip_rkfac, safac, xc, yc, ra, raw, ras, raz, rc, rf, yc0, xc0, |
16223 |
$xg, yg, maskw, masks, recip_ra, recip_raw, recip_ras, recip_raz, |
16224 |
$tanphiatu, tanphiatv |
16225 |
double precision depthink(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
16226 |
double precision drc(1:nr) |
16227 |
double precision drf(1:nr) |
16228 |
double precision dxc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
16229 |
double precision dxf(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
16230 |
double precision dxg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
16231 |
double precision dxv(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
16232 |
double precision dyc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
16233 |
double precision dyf(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
16234 |
double precision dyg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
16235 |
double precision dyu(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
16236 |
double precision h(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
16237 |
double precision hfacc(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) |
16238 |
double precision hfacs(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) |
16239 |
double precision hfacw(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) |
16240 |
double precision masks(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) |
16241 |
double precision maskw(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) |
16242 |
double precision ra(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
16243 |
double precision ras(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
16244 |
double precision raw(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
16245 |
double precision raz(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
16246 |
double precision rc(1:nr) |
16247 |
double precision recip_drc(1:nr) |
16248 |
double precision recip_drf(1:nr) |
16249 |
double precision recip_dxc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
16250 |
double precision recip_dxf(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
16251 |
double precision recip_dxg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
16252 |
double precision recip_dxv(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
16253 |
double precision recip_dyc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
16254 |
double precision recip_dyf(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
16255 |
double precision recip_dyg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
16256 |
double precision recip_dyu(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
16257 |
double precision recip_h(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
16258 |
double precision recip_hfacc(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx, |
16259 |
$nsy) |
16260 |
double precision recip_hfacs(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx, |
16261 |
$nsy) |
16262 |
double precision recip_hfacw(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx, |
16263 |
$nsy) |
16264 |
double precision recip_ra(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
16265 |
double precision recip_ras(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
16266 |
double precision recip_raw(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
16267 |
double precision recip_raz(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
16268 |
double precision recip_rkfac |
16269 |
double precision rf(1:nr+1) |
16270 |
double precision rkfac |
16271 |
double precision safac(1:nr) |
16272 |
double precision tanphiatu(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
16273 |
double precision tanphiatv(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
16274 |
double precision xc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
16275 |
double precision xc0 |
16276 |
double precision xg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
16277 |
double precision yc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
16278 |
double precision yc0 |
16279 |
double precision yg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
16280 |
|
16281 |
common /kpp/ kppviscaz, kppdiffkzt, kppdiffkzs, kppghat, kpphbl |
16282 |
double precision kppdiffkzs(1-olx:snx+olx,1-oly:sny+oly,nr,nsx, |
16283 |
$nsy) |
16284 |
double precision kppdiffkzt(1-olx:snx+olx,1-oly:sny+oly,nr,nsx, |
16285 |
$nsy) |
16286 |
double precision kppghat(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
16287 |
double precision kpphbl(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
16288 |
double precision kppviscaz(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
16289 |
|
16290 |
common /parm_r/ cg2dtargetresidual, cg2dpcoffdfac, |
16291 |
$cg3dtargetresidual, delp, delz, delr, delx, dely, deltat, |
16292 |
$deltatmom, deltattracer, deltatclock, abeps, starttime, phimin, |
16293 |
$thetamin, rsphere, recip_rsphere, f0, fcori, beta, viscah, viscaz, |
16294 |
$ visca4, viscar, diffkht, diffkzt, diffk4t, diffkrt, diffkhs, |
16295 |
$diffkzs, diffk4s, diffkrs, delt, taucd, rcd, freesurffac, |
16296 |
$implicsurfpress, implicdiv2dflow, hfacmin, hfacmindz, gravity, |
16297 |
$recip_gravity, gbaro, rhonil, recip_rhonil, recip_rhoconst, |
16298 |
$rhoconst, tref, sref, endtime, chkptfreq, pchkptfreq, dumpfreq, |
16299 |
$tavefreq, affacmom, vffacmom, pffacmom, cffacmom, fofacmom, |
16300 |
$mtfacmom, cospower, cadjfreq, omega, tauthetaclimrelax, |
16301 |
$lambdathetaclimrelax, tausaltclimrelax, lambdasaltclimrelax, |
16302 |
$externforcingcycle, externforcingperiod, viscap, diffkpt, diffkps, |
16303 |
$ hfacmindr, hfacmindp, theta_s, specvol_s, horivertratio, |
16304 |
$recip_horivertratio, latfftfiltlo, ivdc_kappa, ro_sealevel, |
16305 |
$zonal_filt_lat, bottomdraglinear, bottomdragquadratic |
16306 |
double precision abeps |
16307 |
double precision affacmom |
16308 |
double precision beta |
16309 |
double precision bottomdraglinear |
16310 |
double precision bottomdragquadratic |
16311 |
double precision cadjfreq |
16312 |
double precision cffacmom |
16313 |
double precision cg2dpcoffdfac |
16314 |
double precision cg2dtargetresidual |
16315 |
double precision cg3dtargetresidual |
16316 |
double precision chkptfreq |
16317 |
double precision cospower |
16318 |
double precision delp(nr) |
16319 |
double precision delr(nr) |
16320 |
double precision delt |
16321 |
double precision deltat |
16322 |
double precision deltatclock |
16323 |
double precision deltatmom |
16324 |
double precision deltattracer |
16325 |
double precision delx(nx) |
16326 |
double precision dely(ny) |
16327 |
double precision delz(nr) |
16328 |
double precision diffk4s |
16329 |
double precision diffk4t |
16330 |
double precision diffkhs |
16331 |
double precision diffkht |
16332 |
double precision diffkps |
16333 |
double precision diffkpt |
16334 |
double precision diffkrs |
16335 |
double precision diffkrt |
16336 |
double precision diffkzs |
16337 |
double precision diffkzt |
16338 |
double precision dumpfreq |
16339 |
double precision endtime |
16340 |
double precision externforcingcycle |
16341 |
double precision externforcingperiod |
16342 |
double precision f0 |
16343 |
double precision fcori(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
16344 |
double precision fofacmom |
16345 |
double precision freesurffac |
16346 |
double precision gbaro |
16347 |
double precision gravity |
16348 |
double precision hfacmin |
16349 |
double precision hfacmindp |
16350 |
double precision hfacmindr |
16351 |
double precision hfacmindz |
16352 |
double precision horivertratio |
16353 |
double precision implicdiv2dflow |
16354 |
double precision implicsurfpress |
16355 |
double precision ivdc_kappa |
16356 |
double precision lambdasaltclimrelax |
16357 |
double precision lambdathetaclimrelax |
16358 |
double precision latfftfiltlo |
16359 |
double precision mtfacmom |
16360 |
double precision omega |
16361 |
double precision pchkptfreq |
16362 |
double precision pffacmom |
16363 |
double precision phimin |
16364 |
double precision rcd |
16365 |
double precision recip_gravity |
16366 |
double precision recip_horivertratio |
16367 |
double precision recip_rhoconst |
16368 |
double precision recip_rhonil |
16369 |
double precision recip_rsphere |
16370 |
double precision rhoconst |
16371 |
double precision rhonil |
16372 |
double precision ro_sealevel |
16373 |
double precision rsphere |
16374 |
double precision specvol_s(nr) |
16375 |
double precision sref(nr) |
16376 |
double precision starttime |
16377 |
double precision taucd |
16378 |
double precision tausaltclimrelax |
16379 |
double precision tauthetaclimrelax |
16380 |
double precision tavefreq |
16381 |
double precision theta_s(nr) |
16382 |
double precision thetamin |
16383 |
double precision tref(nr) |
16384 |
double precision vffacmom |
16385 |
double precision visca4 |
16386 |
double precision viscah |
16387 |
double precision viscap |
16388 |
double precision viscar |
16389 |
double precision viscaz |
16390 |
double precision zonal_filt_lat |
16391 |
|
16392 |
C============================================== |
16393 |
C define arguments |
16394 |
C============================================== |
16395 |
double precision adkappars(1-olx:snx+olx,1-oly:sny+oly,nr) |
16396 |
double precision adkappart(1-olx:snx+olx,1-oly:sny+oly,nr) |
16397 |
double precision adkapparu(1-olx:snx+olx,1-oly:sny+oly,nr) |
16398 |
double precision adkapparv(1-olx:snx+olx,1-oly:sny+oly,nr) |
16399 |
integer bi |
16400 |
integer bj |
16401 |
integer imax |
16402 |
integer imin |
16403 |
integer jmax |
16404 |
integer jmin |
16405 |
integer k |
16406 |
double precision kapparu(1-olx:snx+olx,1-oly:sny+oly,nr) |
16407 |
double precision kapparv(1-olx:snx+olx,1-oly:sny+oly,nr) |
16408 |
double precision maskup(1-olx:snx+olx,1-oly:sny+oly) |
16409 |
|
16410 |
C============================================== |
16411 |
C define local variables |
16412 |
C============================================== |
16413 |
integer i |
16414 |
integer j |
16415 |
|
16416 |
C---------------------------------------------- |
16417 |
C ROUTINE BODY |
16418 |
C---------------------------------------------- |
16419 |
do j = jmin, jmax |
16420 |
do i = imin, imax |
16421 |
adkppviscaz(i,j-1,k,bi,bj) = adkppviscaz(i,j-1,k,bi,bj)+0.5* |
16422 |
$adkapparv(i,j,k)*(0.5-sign(0.5d0,kapparv(i,j,k)-(kapparv(i,j,k)- |
16423 |
$viscar+masks(i,j,k,bi,bj)*0.5*(kppviscaz(i,j,k,bi,bj)+kppviscaz(i, |
16424 |
$j-1,k,bi,bj)))))*masks(i,j,k,bi,bj) |
16425 |
adkppviscaz(i,j,k,bi,bj) = adkppviscaz(i,j,k,bi,bj)+0.5* |
16426 |
$adkapparv(i,j,k)*(0.5-sign(0.5d0,kapparv(i,j,k)-(kapparv(i,j,k)- |
16427 |
$viscar+masks(i,j,k,bi,bj)*0.5*(kppviscaz(i,j,k,bi,bj)+kppviscaz(i, |
16428 |
$j-1,k,bi,bj)))))*masks(i,j,k,bi,bj) |
16429 |
adkapparv(i,j,k) = adkapparv(i,j,k)*(0.5+0.5-sign(0.5d0, |
16430 |
$kapparv(i,j,k)-(kapparv(i,j,k)-viscar+masks(i,j,k,bi,bj)*0.5* |
16431 |
$(kppviscaz(i,j,k,bi,bj)+kppviscaz(i,j-1,k,bi,bj))))+sign(0.5d0, |
16432 |
$kapparv(i,j,k)-(kapparv(i,j,k)-viscar+masks(i,j,k,bi,bj)*0.5* |
16433 |
$(kppviscaz(i,j,k,bi,bj)+kppviscaz(i,j-1,k,bi,bj))))) |
16434 |
end do |
16435 |
end do |
16436 |
do j = jmin, jmax |
16437 |
do i = imin, imax |
16438 |
adkppviscaz(i-1,j,k,bi,bj) = adkppviscaz(i-1,j,k,bi,bj)+0.5* |
16439 |
$adkapparu(i,j,k)*(0.5-sign(0.5d0,kapparu(i,j,k)-(kapparu(i,j,k)- |
16440 |
$viscar+maskw(i,j,k,bi,bj)*0.5*(kppviscaz(i,j,k,bi,bj)+kppviscaz(i- |
16441 |
$1,j,k,bi,bj)))))*maskw(i,j,k,bi,bj) |
16442 |
adkppviscaz(i,j,k,bi,bj) = adkppviscaz(i,j,k,bi,bj)+0.5* |
16443 |
$adkapparu(i,j,k)*(0.5-sign(0.5d0,kapparu(i,j,k)-(kapparu(i,j,k)- |
16444 |
$viscar+maskw(i,j,k,bi,bj)*0.5*(kppviscaz(i,j,k,bi,bj)+kppviscaz(i- |
16445 |
$1,j,k,bi,bj)))))*maskw(i,j,k,bi,bj) |
16446 |
adkapparu(i,j,k) = adkapparu(i,j,k)*(0.5+0.5-sign(0.5d0, |
16447 |
$kapparu(i,j,k)-(kapparu(i,j,k)-viscar+maskw(i,j,k,bi,bj)*0.5* |
16448 |
$(kppviscaz(i,j,k,bi,bj)+kppviscaz(i-1,j,k,bi,bj))))+sign(0.5d0, |
16449 |
$kapparu(i,j,k)-(kapparu(i,j,k)-viscar+maskw(i,j,k,bi,bj)*0.5* |
16450 |
$(kppviscaz(i,j,k,bi,bj)+kppviscaz(i-1,j,k,bi,bj))))) |
16451 |
end do |
16452 |
end do |
16453 |
do j = jmin, jmax |
16454 |
do i = imin, imax |
16455 |
adkppdiffkzs(i,j,k,bi,bj) = adkppdiffkzs(i,j,k,bi,bj)+ |
16456 |
$adkappars(i,j,k)*maskup(i,j) |
16457 |
end do |
16458 |
end do |
16459 |
do j = jmin, jmax |
16460 |
do i = imin, imax |
16461 |
adkppdiffkzt(i,j,k,bi,bj) = adkppdiffkzt(i,j,k,bi,bj)+ |
16462 |
$adkappart(i,j,k)*maskup(i,j) |
16463 |
end do |
16464 |
end do |
16465 |
|
16466 |
end |
16467 |
|
16468 |
|
16469 |
subroutine adkpp_calc_dummy( bi, bj ) |
16470 |
C*************************************************************** |
16471 |
C*************************************************************** |
16472 |
C** This routine was generated by the ** |
16473 |
C** Tangent linear and Adjoint Model Compiler, TAMC 5.2.14 ** |
16474 |
C*************************************************************** |
16475 |
C*************************************************************** |
16476 |
C============================================== |
16477 |
C all entries are defined explicitly |
16478 |
C============================================== |
16479 |
implicit none |
16480 |
|
16481 |
C============================================== |
16482 |
C define parameters |
16483 |
C============================================== |
16484 |
integer nr |
16485 |
parameter ( nr = 15 ) |
16486 |
integer nsx |
16487 |
parameter ( nsx = 1 ) |
16488 |
integer nsy |
16489 |
parameter ( nsy = 1 ) |
16490 |
integer olx |
16491 |
parameter ( olx = 3 ) |
16492 |
integer oly |
16493 |
parameter ( oly = 3 ) |
16494 |
integer snx |
16495 |
parameter ( snx = 20 ) |
16496 |
integer sny |
16497 |
parameter ( sny = 40 ) |
16498 |
|
16499 |
C============================================== |
16500 |
C define common blocks |
16501 |
C============================================== |
16502 |
common /adkpp/ adkppviscaz, adkppdiffkzt, adkppdiffkzs, adkppghat, |
16503 |
$ adkpphbl |
16504 |
double precision adkppdiffkzs(1-olx:snx+olx,1-oly:sny+oly,nr,nsx, |
16505 |
$nsy) |
16506 |
double precision adkppdiffkzt(1-olx:snx+olx,1-oly:sny+oly,nr,nsx, |
16507 |
$nsy) |
16508 |
double precision adkppghat(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
16509 |
double precision adkpphbl(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
16510 |
double precision adkppviscaz(1-olx:snx+olx,1-oly:sny+oly,nr,nsx, |
16511 |
$nsy) |
16512 |
|
16513 |
common /adkpp_short/ adkppfrac |
16514 |
double precision adkppfrac(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
16515 |
|
16516 |
C============================================== |
16517 |
C define arguments |
16518 |
C============================================== |
16519 |
integer bi |
16520 |
integer bj |
16521 |
|
16522 |
C============================================== |
16523 |
C define local variables |
16524 |
C============================================== |
16525 |
integer i |
16526 |
integer j |
16527 |
integer k |
16528 |
|
16529 |
C---------------------------------------------- |
16530 |
C ROUTINE BODY |
16531 |
C---------------------------------------------- |
16532 |
do j = 1-oly, sny+oly |
16533 |
do i = 1-olx, snx+olx |
16534 |
do k = 1, nr |
16535 |
adkppdiffkzs(i,j,k,bi,bj) = 0.d0 |
16536 |
adkppdiffkzt(i,j,k,bi,bj) = 0.d0 |
16537 |
adkppviscaz(i,j,k,bi,bj) = 0.d0 |
16538 |
adkppghat(i,j,k,bi,bj) = 0.d0 |
16539 |
end do |
16540 |
adkppfrac(i,j,bi,bj) = 0.d0 |
16541 |
end do |
16542 |
end do |
16543 |
|
16544 |
end |
16545 |
|
16546 |
|
16547 |
subroutine adkpp_smooth_horiz( k, bi, bj, adfld ) |
16548 |
C*************************************************************** |
16549 |
C*************************************************************** |
16550 |
C** This routine was generated by the ** |
16551 |
C** Tangent linear and Adjoint Model Compiler, TAMC 5.2.14 ** |
16552 |
C*************************************************************** |
16553 |
C*************************************************************** |
16554 |
C============================================== |
16555 |
C all entries are defined explicitly |
16556 |
C============================================== |
16557 |
implicit none |
16558 |
|
16559 |
C============================================== |
16560 |
C define parameters |
16561 |
C============================================== |
16562 |
integer olx |
16563 |
parameter ( olx = 3 ) |
16564 |
integer ibot |
16565 |
parameter ( ibot = 1-olx ) |
16566 |
integer snx |
16567 |
parameter ( snx = 20 ) |
16568 |
integer itop |
16569 |
parameter ( itop = snx+olx ) |
16570 |
integer imax |
16571 |
parameter ( imax = itop-1 ) |
16572 |
integer imin |
16573 |
parameter ( imin = ibot+1 ) |
16574 |
integer oly |
16575 |
parameter ( oly = 3 ) |
16576 |
integer jbot |
16577 |
parameter ( jbot = 1-oly ) |
16578 |
integer sny |
16579 |
parameter ( sny = 40 ) |
16580 |
integer jtop |
16581 |
parameter ( jtop = sny+oly ) |
16582 |
integer jmax |
16583 |
parameter ( jmax = jtop-1 ) |
16584 |
integer jmin |
16585 |
parameter ( jmin = jbot+1 ) |
16586 |
integer nr |
16587 |
parameter ( nr = 15 ) |
16588 |
integer nsx |
16589 |
parameter ( nsx = 1 ) |
16590 |
integer nsy |
16591 |
parameter ( nsy = 1 ) |
16592 |
double precision p0625 |
16593 |
parameter ( p0625 = 0.0625 ) |
16594 |
double precision p125 |
16595 |
parameter ( p125 = 0.125 ) |
16596 |
double precision p25 |
16597 |
parameter ( p25 = 0.25 ) |
16598 |
|
16599 |
C============================================== |
16600 |
C define common blocks |
16601 |
C============================================== |
16602 |
common /kpp_r1/ pmask, zgrid, hwide |
16603 |
double precision hwide(0:nr+1) |
16604 |
double precision pmask(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
16605 |
double precision zgrid(0:nr+1) |
16606 |
|
16607 |
C============================================== |
16608 |
C define arguments |
16609 |
C============================================== |
16610 |
double precision adfld(ibot:itop,jbot:jtop) |
16611 |
integer bi |
16612 |
integer bj |
16613 |
integer k |
16614 |
|
16615 |
C============================================== |
16616 |
C define local variables |
16617 |
C============================================== |
16618 |
double precision adfld_tmp(ibot:itop,jbot:jtop) |
16619 |
integer i |
16620 |
integer im1 |
16621 |
integer ip1 |
16622 |
integer ip2 |
16623 |
integer ip3 |
16624 |
integer j |
16625 |
integer jm1 |
16626 |
integer jp1 |
16627 |
double precision tempvar |
16628 |
|
16629 |
C---------------------------------------------- |
16630 |
C RESET LOCAL ADJOINT VARIABLES |
16631 |
C---------------------------------------------- |
16632 |
do ip3 = jbot, jtop |
16633 |
do ip2 = ibot, itop |
16634 |
adfld_tmp(ip2,ip3) = 0.d0 |
16635 |
end do |
16636 |
end do |
16637 |
|
16638 |
C---------------------------------------------- |
16639 |
C ROUTINE BODY |
16640 |
C---------------------------------------------- |
16641 |
do j = jmin, jmax |
16642 |
do i = imin, imax |
16643 |
adfld_tmp(i,j) = adfld_tmp(i,j)+adfld(i,j) |
16644 |
adfld(i,j) = 0.d0 |
16645 |
end do |
16646 |
end do |
16647 |
do j = jmin, jmax |
16648 |
jm1 = j-1 |
16649 |
jp1 = j+1 |
16650 |
do i = imin, imax |
16651 |
im1 = i-1 |
16652 |
ip1 = i+1 |
16653 |
tempvar = p25*pmask(i,j,k,bi,bj)+p125*(pmask(im1,j,k,bi,bj)+ |
16654 |
$pmask(ip1,j,k,bi,bj)+pmask(i,jm1,k,bi,bj)+pmask(i,jp1,k,bi,bj))+ |
16655 |
$p0625*(pmask(im1,jm1,k,bi,bj)+pmask(im1,jp1,k,bi,bj)+pmask(ip1, |
16656 |
$jm1,k,bi,bj)+pmask(ip1,jp1,k,bi,bj)) |
16657 |
if (tempvar .ge. p25) then |
16658 |
adfld(i,j) = adfld(i,j)+adfld_tmp(i,j)*(p25*pmask(i,j,k,bi, |
16659 |
$bj)/tempvar) |
16660 |
adfld(im1,j) = adfld(im1,j)+adfld_tmp(i,j)*(p125*pmask(im1, |
16661 |
$j,k,bi,bj)/tempvar) |
16662 |
adfld(ip1,j) = adfld(ip1,j)+adfld_tmp(i,j)*(p125*pmask(ip1, |
16663 |
$j,k,bi,bj)/tempvar) |
16664 |
adfld(i,jm1) = adfld(i,jm1)+adfld_tmp(i,j)*(p125*pmask(i, |
16665 |
$jm1,k,bi,bj)/tempvar) |
16666 |
adfld(im1,jm1) = adfld(im1,jm1)+adfld_tmp(i,j)*(p0625* |
16667 |
$pmask(im1,jm1,k,bi,bj)/tempvar) |
16668 |
adfld(ip1,jm1) = adfld(ip1,jm1)+adfld_tmp(i,j)*(p0625* |
16669 |
$pmask(ip1,jm1,k,bi,bj)/tempvar) |
16670 |
adfld(i,jp1) = adfld(i,jp1)+adfld_tmp(i,j)*(p125*pmask(i, |
16671 |
$jp1,k,bi,bj)/tempvar) |
16672 |
adfld(im1,jp1) = adfld(im1,jp1)+adfld_tmp(i,j)*(p0625* |
16673 |
$pmask(im1,jp1,k,bi,bj)/tempvar) |
16674 |
adfld(ip1,jp1) = adfld(ip1,jp1)+adfld_tmp(i,j)*(p0625* |
16675 |
$pmask(ip1,jp1,k,bi,bj)/tempvar) |
16676 |
adfld_tmp(i,j) = 0.d0 |
16677 |
else |
16678 |
adfld(i,j) = adfld(i,j)+adfld_tmp(i,j) |
16679 |
adfld_tmp(i,j) = 0.d0 |
16680 |
endif |
16681 |
end do |
16682 |
end do |
16683 |
|
16684 |
end |
16685 |
|
16686 |
|
16687 |
subroutine adkpp_transport_s( imin, imax, jmin, jmax, bi, bj, k, |
16688 |
$km1, maskc, kappars, adkappars, addf ) |
16689 |
C*************************************************************** |
16690 |
C*************************************************************** |
16691 |
C** This routine was generated by the ** |
16692 |
C** Tangent linear and Adjoint Model Compiler, TAMC 5.2.14 ** |
16693 |
C*************************************************************** |
16694 |
C*************************************************************** |
16695 |
C============================================== |
16696 |
C all entries are defined explicitly |
16697 |
C============================================== |
16698 |
implicit none |
16699 |
|
16700 |
C============================================== |
16701 |
C define parameters |
16702 |
C============================================== |
16703 |
integer npx |
16704 |
parameter ( npx = 1 ) |
16705 |
integer npy |
16706 |
parameter ( npy = 1 ) |
16707 |
integer nr |
16708 |
parameter ( nr = 15 ) |
16709 |
integer nsx |
16710 |
parameter ( nsx = 1 ) |
16711 |
integer nsy |
16712 |
parameter ( nsy = 1 ) |
16713 |
integer snx |
16714 |
parameter ( snx = 20 ) |
16715 |
integer nx |
16716 |
parameter ( nx = snx*nsx*npx ) |
16717 |
integer sny |
16718 |
parameter ( sny = 40 ) |
16719 |
integer ny |
16720 |
parameter ( ny = sny*nsy*npy ) |
16721 |
integer olx |
16722 |
parameter ( olx = 3 ) |
16723 |
integer oly |
16724 |
parameter ( oly = 3 ) |
16725 |
|
16726 |
C============================================== |
16727 |
C define common blocks |
16728 |
C============================================== |
16729 |
common /adkpp/ adkppviscaz, adkppdiffkzt, adkppdiffkzs, adkppghat, |
16730 |
$ adkpphbl |
16731 |
double precision adkppdiffkzs(1-olx:snx+olx,1-oly:sny+oly,nr,nsx, |
16732 |
$nsy) |
16733 |
double precision adkppdiffkzt(1-olx:snx+olx,1-oly:sny+oly,nr,nsx, |
16734 |
$nsy) |
16735 |
double precision adkppghat(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
16736 |
double precision adkpphbl(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
16737 |
double precision adkppviscaz(1-olx:snx+olx,1-oly:sny+oly,nr,nsx, |
16738 |
$nsy) |
16739 |
|
16740 |
common /adtendency_forcing/ adsurfacetendencyu, |
16741 |
$adsurfacetendencyv, adsurfacetendencyt, adsurfacetendencys |
16742 |
double precision adsurfacetendencys(1-olx:snx+olx,1-oly:sny+oly, |
16743 |
$nsx,nsy) |
16744 |
double precision adsurfacetendencyt(1-olx:snx+olx,1-oly:sny+oly, |
16745 |
$nsx,nsy) |
16746 |
double precision adsurfacetendencyu(1-olx:snx+olx,1-oly:sny+oly, |
16747 |
$nsx,nsy) |
16748 |
double precision adsurfacetendencyv(1-olx:snx+olx,1-oly:sny+oly, |
16749 |
$nsx,nsy) |
16750 |
|
16751 |
common /grid_r/ dxc, dxf, dxg, dxv, dyc, dyf, dyg, dyu, drc, drf, |
16752 |
$h, hfacc, hfacw, hfacs, depthink, recip_dxc, recip_dxf, recip_dxg, |
16753 |
$ recip_dxv, recip_dyc, recip_dyf, recip_dyg, recip_dyu, recip_drc, |
16754 |
$ recip_drf, recip_h, recip_hfacc, recip_hfacw, recip_hfacs, rkfac, |
16755 |
$ recip_rkfac, safac, xc, yc, ra, raw, ras, raz, rc, rf, yc0, xc0, |
16756 |
$xg, yg, maskw, masks, recip_ra, recip_raw, recip_ras, recip_raz, |
16757 |
$tanphiatu, tanphiatv |
16758 |
double precision depthink(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
16759 |
double precision drc(1:nr) |
16760 |
double precision drf(1:nr) |
16761 |
double precision dxc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
16762 |
double precision dxf(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
16763 |
double precision dxg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
16764 |
double precision dxv(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
16765 |
double precision dyc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
16766 |
double precision dyf(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
16767 |
double precision dyg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
16768 |
double precision dyu(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
16769 |
double precision h(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
16770 |
double precision hfacc(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) |
16771 |
double precision hfacs(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) |
16772 |
double precision hfacw(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) |
16773 |
double precision masks(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) |
16774 |
double precision maskw(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) |
16775 |
double precision ra(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
16776 |
double precision ras(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
16777 |
double precision raw(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
16778 |
double precision raz(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
16779 |
double precision rc(1:nr) |
16780 |
double precision recip_drc(1:nr) |
16781 |
double precision recip_drf(1:nr) |
16782 |
double precision recip_dxc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
16783 |
double precision recip_dxf(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
16784 |
double precision recip_dxg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
16785 |
double precision recip_dxv(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
16786 |
double precision recip_dyc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
16787 |
double precision recip_dyf(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
16788 |
double precision recip_dyg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
16789 |
double precision recip_dyu(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
16790 |
double precision recip_h(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
16791 |
double precision recip_hfacc(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx, |
16792 |
$nsy) |
16793 |
double precision recip_hfacs(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx, |
16794 |
$nsy) |
16795 |
double precision recip_hfacw(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx, |
16796 |
$nsy) |
16797 |
double precision recip_ra(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
16798 |
double precision recip_ras(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
16799 |
double precision recip_raw(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
16800 |
double precision recip_raz(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
16801 |
double precision recip_rkfac |
16802 |
double precision rf(1:nr+1) |
16803 |
double precision rkfac |
16804 |
double precision safac(1:nr) |
16805 |
double precision tanphiatu(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
16806 |
double precision tanphiatv(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
16807 |
double precision xc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
16808 |
double precision xc0 |
16809 |
double precision xg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
16810 |
double precision yc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
16811 |
double precision yc0 |
16812 |
double precision yg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
16813 |
|
16814 |
common /kpp/ kppviscaz, kppdiffkzt, kppdiffkzs, kppghat, kpphbl |
16815 |
double precision kppdiffkzs(1-olx:snx+olx,1-oly:sny+oly,nr,nsx, |
16816 |
$nsy) |
16817 |
double precision kppdiffkzt(1-olx:snx+olx,1-oly:sny+oly,nr,nsx, |
16818 |
$nsy) |
16819 |
double precision kppghat(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
16820 |
double precision kpphbl(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
16821 |
double precision kppviscaz(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
16822 |
|
16823 |
common /parm_r/ cg2dtargetresidual, cg2dpcoffdfac, |
16824 |
$cg3dtargetresidual, delp, delz, delr, delx, dely, deltat, |
16825 |
$deltatmom, deltattracer, deltatclock, abeps, starttime, phimin, |
16826 |
$thetamin, rsphere, recip_rsphere, f0, fcori, beta, viscah, viscaz, |
16827 |
$ visca4, viscar, diffkht, diffkzt, diffk4t, diffkrt, diffkhs, |
16828 |
$diffkzs, diffk4s, diffkrs, delt, taucd, rcd, freesurffac, |
16829 |
$implicsurfpress, implicdiv2dflow, hfacmin, hfacmindz, gravity, |
16830 |
$recip_gravity, gbaro, rhonil, recip_rhonil, recip_rhoconst, |
16831 |
$rhoconst, tref, sref, endtime, chkptfreq, pchkptfreq, dumpfreq, |
16832 |
$tavefreq, affacmom, vffacmom, pffacmom, cffacmom, fofacmom, |
16833 |
$mtfacmom, cospower, cadjfreq, omega, tauthetaclimrelax, |
16834 |
$lambdathetaclimrelax, tausaltclimrelax, lambdasaltclimrelax, |
16835 |
$externforcingcycle, externforcingperiod, viscap, diffkpt, diffkps, |
16836 |
$ hfacmindr, hfacmindp, theta_s, specvol_s, horivertratio, |
16837 |
$recip_horivertratio, latfftfiltlo, ivdc_kappa, ro_sealevel, |
16838 |
$zonal_filt_lat, bottomdraglinear, bottomdragquadratic |
16839 |
double precision abeps |
16840 |
double precision affacmom |
16841 |
double precision beta |
16842 |
double precision bottomdraglinear |
16843 |
double precision bottomdragquadratic |
16844 |
double precision cadjfreq |
16845 |
double precision cffacmom |
16846 |
double precision cg2dpcoffdfac |
16847 |
double precision cg2dtargetresidual |
16848 |
double precision cg3dtargetresidual |
16849 |
double precision chkptfreq |
16850 |
double precision cospower |
16851 |
double precision delp(nr) |
16852 |
double precision delr(nr) |
16853 |
double precision delt |
16854 |
double precision deltat |
16855 |
double precision deltatclock |
16856 |
double precision deltatmom |
16857 |
double precision deltattracer |
16858 |
double precision delx(nx) |
16859 |
double precision dely(ny) |
16860 |
double precision delz(nr) |
16861 |
double precision diffk4s |
16862 |
double precision diffk4t |
16863 |
double precision diffkhs |
16864 |
double precision diffkht |
16865 |
double precision diffkps |
16866 |
double precision diffkpt |
16867 |
double precision diffkrs |
16868 |
double precision diffkrt |
16869 |
double precision diffkzs |
16870 |
double precision diffkzt |
16871 |
double precision dumpfreq |
16872 |
double precision endtime |
16873 |
double precision externforcingcycle |
16874 |
double precision externforcingperiod |
16875 |
double precision f0 |
16876 |
double precision fcori(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
16877 |
double precision fofacmom |
16878 |
double precision freesurffac |
16879 |
double precision gbaro |
16880 |
double precision gravity |
16881 |
double precision hfacmin |
16882 |
double precision hfacmindp |
16883 |
double precision hfacmindr |
16884 |
double precision hfacmindz |
16885 |
double precision horivertratio |
16886 |
double precision implicdiv2dflow |
16887 |
double precision implicsurfpress |
16888 |
double precision ivdc_kappa |
16889 |
double precision lambdasaltclimrelax |
16890 |
double precision lambdathetaclimrelax |
16891 |
double precision latfftfiltlo |
16892 |
double precision mtfacmom |
16893 |
double precision omega |
16894 |
double precision pchkptfreq |
16895 |
double precision pffacmom |
16896 |
double precision phimin |
16897 |
double precision rcd |
16898 |
double precision recip_gravity |
16899 |
double precision recip_horivertratio |
16900 |
double precision recip_rhoconst |
16901 |
double precision recip_rhonil |
16902 |
double precision recip_rsphere |
16903 |
double precision rhoconst |
16904 |
double precision rhonil |
16905 |
double precision ro_sealevel |
16906 |
double precision rsphere |
16907 |
double precision specvol_s(nr) |
16908 |
double precision sref(nr) |
16909 |
double precision starttime |
16910 |
double precision taucd |
16911 |
double precision tausaltclimrelax |
16912 |
double precision tauthetaclimrelax |
16913 |
double precision tavefreq |
16914 |
double precision theta_s(nr) |
16915 |
double precision thetamin |
16916 |
double precision tref(nr) |
16917 |
double precision vffacmom |
16918 |
double precision visca4 |
16919 |
double precision viscah |
16920 |
double precision viscap |
16921 |
double precision viscar |
16922 |
double precision viscaz |
16923 |
double precision zonal_filt_lat |
16924 |
|
16925 |
common /tendency_forcing/ surfacetendencyu, surfacetendencyv, |
16926 |
$surfacetendencyt, surfacetendencys, tempqsw |
16927 |
double precision surfacetendencys(1-olx:snx+olx,1-oly:sny+oly,nsx, |
16928 |
$nsy) |
16929 |
double precision surfacetendencyt(1-olx:snx+olx,1-oly:sny+oly,nsx, |
16930 |
$nsy) |
16931 |
double precision surfacetendencyu(1-olx:snx+olx,1-oly:sny+oly,nsx, |
16932 |
$nsy) |
16933 |
double precision surfacetendencyv(1-olx:snx+olx,1-oly:sny+oly,nsx, |
16934 |
$nsy) |
16935 |
double precision tempqsw(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
16936 |
|
16937 |
C============================================== |
16938 |
C define arguments |
16939 |
C============================================== |
16940 |
double precision addf(1-olx:snx+olx,1-oly:sny+oly) |
16941 |
double precision adkappars(1-olx:snx+olx,1-oly:sny+oly,nr) |
16942 |
integer bi |
16943 |
integer bj |
16944 |
integer imax |
16945 |
integer imin |
16946 |
integer jmax |
16947 |
integer jmin |
16948 |
integer k |
16949 |
double precision kappars(1-olx:snx+olx,1-oly:sny+oly,nr) |
16950 |
integer km1 |
16951 |
double precision maskc(1-olx:snx+olx,1-oly:sny+oly) |
16952 |
|
16953 |
C============================================== |
16954 |
C define local variables |
16955 |
C============================================== |
16956 |
integer i |
16957 |
integer j |
16958 |
|
16959 |
C---------------------------------------------- |
16960 |
C ROUTINE BODY |
16961 |
C---------------------------------------------- |
16962 |
do j = jmin, jmax |
16963 |
do i = imin, imax |
16964 |
adkappars(i,j,k) = adkappars(i,j,k)-addf(i,j)*ra(i,j,bi,bj)* |
16965 |
$maskc(i,j)*kppghat(i,j,km1,bi,bj)*delz(1)*surfacetendencys(i,j,bi, |
16966 |
$bj) |
16967 |
adkppghat(i,j,km1,bi,bj) = adkppghat(i,j,km1,bi,bj)-addf(i,j)* |
16968 |
$ra(i,j,bi,bj)*maskc(i,j)*kappars(i,j,k)*delz(1)* |
16969 |
$surfacetendencys(i,j,bi,bj) |
16970 |
adsurfacetendencys(i,j,bi,bj) = adsurfacetendencys(i,j,bi,bj)- |
16971 |
$addf(i,j)*ra(i,j,bi,bj)*maskc(i,j)*kappars(i,j,k)*kppghat(i,j,km1, |
16972 |
$bi,bj)*delz(1) |
16973 |
end do |
16974 |
end do |
16975 |
|
16976 |
end |
16977 |
|
16978 |
|
16979 |
subroutine adkpp_transport_t( imin, imax, jmin, jmax, bi, bj, k, |
16980 |
$km1, maskc, kappart, adkappart, addf ) |
16981 |
C*************************************************************** |
16982 |
C*************************************************************** |
16983 |
C** This routine was generated by the ** |
16984 |
C** Tangent linear and Adjoint Model Compiler, TAMC 5.2.14 ** |
16985 |
C*************************************************************** |
16986 |
C*************************************************************** |
16987 |
C============================================== |
16988 |
C all entries are defined explicitly |
16989 |
C============================================== |
16990 |
implicit none |
16991 |
|
16992 |
C============================================== |
16993 |
C define parameters |
16994 |
C============================================== |
16995 |
integer npx |
16996 |
parameter ( npx = 1 ) |
16997 |
integer npy |
16998 |
parameter ( npy = 1 ) |
16999 |
integer nr |
17000 |
parameter ( nr = 15 ) |
17001 |
integer nsx |
17002 |
parameter ( nsx = 1 ) |
17003 |
integer nsy |
17004 |
parameter ( nsy = 1 ) |
17005 |
integer snx |
17006 |
parameter ( snx = 20 ) |
17007 |
integer nx |
17008 |
parameter ( nx = snx*nsx*npx ) |
17009 |
integer sny |
17010 |
parameter ( sny = 40 ) |
17011 |
integer ny |
17012 |
parameter ( ny = sny*nsy*npy ) |
17013 |
integer olx |
17014 |
parameter ( olx = 3 ) |
17015 |
integer oly |
17016 |
parameter ( oly = 3 ) |
17017 |
|
17018 |
C============================================== |
17019 |
C define common blocks |
17020 |
C============================================== |
17021 |
common /adkpp/ adkppviscaz, adkppdiffkzt, adkppdiffkzs, adkppghat, |
17022 |
$ adkpphbl |
17023 |
double precision adkppdiffkzs(1-olx:snx+olx,1-oly:sny+oly,nr,nsx, |
17024 |
$nsy) |
17025 |
double precision adkppdiffkzt(1-olx:snx+olx,1-oly:sny+oly,nr,nsx, |
17026 |
$nsy) |
17027 |
double precision adkppghat(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
17028 |
double precision adkpphbl(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
17029 |
double precision adkppviscaz(1-olx:snx+olx,1-oly:sny+oly,nr,nsx, |
17030 |
$nsy) |
17031 |
|
17032 |
common /adkpp_short/ adkppfrac |
17033 |
double precision adkppfrac(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
17034 |
|
17035 |
common /adtendency_forcing/ adsurfacetendencyu, |
17036 |
$adsurfacetendencyv, adsurfacetendencyt, adsurfacetendencys |
17037 |
double precision adsurfacetendencys(1-olx:snx+olx,1-oly:sny+oly, |
17038 |
$nsx,nsy) |
17039 |
double precision adsurfacetendencyt(1-olx:snx+olx,1-oly:sny+oly, |
17040 |
$nsx,nsy) |
17041 |
double precision adsurfacetendencyu(1-olx:snx+olx,1-oly:sny+oly, |
17042 |
$nsx,nsy) |
17043 |
double precision adsurfacetendencyv(1-olx:snx+olx,1-oly:sny+oly, |
17044 |
$nsx,nsy) |
17045 |
|
17046 |
common /ffields/ fu, fv, qnet, empmr, sst, sss, qsw |
17047 |
double precision empmr(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
17048 |
double precision fu(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
17049 |
double precision fv(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
17050 |
double precision qnet(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
17051 |
double precision qsw(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
17052 |
double precision sss(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
17053 |
double precision sst(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
17054 |
|
17055 |
common /grid_r/ dxc, dxf, dxg, dxv, dyc, dyf, dyg, dyu, drc, drf, |
17056 |
$h, hfacc, hfacw, hfacs, depthink, recip_dxc, recip_dxf, recip_dxg, |
17057 |
$ recip_dxv, recip_dyc, recip_dyf, recip_dyg, recip_dyu, recip_drc, |
17058 |
$ recip_drf, recip_h, recip_hfacc, recip_hfacw, recip_hfacs, rkfac, |
17059 |
$ recip_rkfac, safac, xc, yc, ra, raw, ras, raz, rc, rf, yc0, xc0, |
17060 |
$xg, yg, maskw, masks, recip_ra, recip_raw, recip_ras, recip_raz, |
17061 |
$tanphiatu, tanphiatv |
17062 |
double precision depthink(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
17063 |
double precision drc(1:nr) |
17064 |
double precision drf(1:nr) |
17065 |
double precision dxc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
17066 |
double precision dxf(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
17067 |
double precision dxg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
17068 |
double precision dxv(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
17069 |
double precision dyc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
17070 |
double precision dyf(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
17071 |
double precision dyg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
17072 |
double precision dyu(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
17073 |
double precision h(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
17074 |
double precision hfacc(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) |
17075 |
double precision hfacs(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) |
17076 |
double precision hfacw(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) |
17077 |
double precision masks(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) |
17078 |
double precision maskw(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) |
17079 |
double precision ra(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
17080 |
double precision ras(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
17081 |
double precision raw(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
17082 |
double precision raz(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
17083 |
double precision rc(1:nr) |
17084 |
double precision recip_drc(1:nr) |
17085 |
double precision recip_drf(1:nr) |
17086 |
double precision recip_dxc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
17087 |
double precision recip_dxf(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
17088 |
double precision recip_dxg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
17089 |
double precision recip_dxv(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
17090 |
double precision recip_dyc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
17091 |
double precision recip_dyf(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
17092 |
double precision recip_dyg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
17093 |
double precision recip_dyu(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
17094 |
double precision recip_h(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
17095 |
double precision recip_hfacc(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx, |
17096 |
$nsy) |
17097 |
double precision recip_hfacs(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx, |
17098 |
$nsy) |
17099 |
double precision recip_hfacw(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx, |
17100 |
$nsy) |
17101 |
double precision recip_ra(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
17102 |
double precision recip_ras(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
17103 |
double precision recip_raw(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
17104 |
double precision recip_raz(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
17105 |
double precision recip_rkfac |
17106 |
double precision rf(1:nr+1) |
17107 |
double precision rkfac |
17108 |
double precision safac(1:nr) |
17109 |
double precision tanphiatu(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
17110 |
double precision tanphiatv(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
17111 |
double precision xc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
17112 |
double precision xc0 |
17113 |
double precision xg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
17114 |
double precision yc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
17115 |
double precision yc0 |
17116 |
double precision yg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
17117 |
|
17118 |
common /kpp/ kppviscaz, kppdiffkzt, kppdiffkzs, kppghat, kpphbl |
17119 |
double precision kppdiffkzs(1-olx:snx+olx,1-oly:sny+oly,nr,nsx, |
17120 |
$nsy) |
17121 |
double precision kppdiffkzt(1-olx:snx+olx,1-oly:sny+oly,nr,nsx, |
17122 |
$nsy) |
17123 |
double precision kppghat(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
17124 |
double precision kpphbl(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
17125 |
double precision kppviscaz(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
17126 |
|
17127 |
common /kpp_short/ kppfrac |
17128 |
double precision kppfrac(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
17129 |
|
17130 |
common /parm_a/ heatcapacity_cp, recip_cp, lamba_theta |
17131 |
double precision heatcapacity_cp |
17132 |
double precision lamba_theta |
17133 |
double precision recip_cp |
17134 |
|
17135 |
common /parm_r/ cg2dtargetresidual, cg2dpcoffdfac, |
17136 |
$cg3dtargetresidual, delp, delz, delr, delx, dely, deltat, |
17137 |
$deltatmom, deltattracer, deltatclock, abeps, starttime, phimin, |
17138 |
$thetamin, rsphere, recip_rsphere, f0, fcori, beta, viscah, viscaz, |
17139 |
$ visca4, viscar, diffkht, diffkzt, diffk4t, diffkrt, diffkhs, |
17140 |
$diffkzs, diffk4s, diffkrs, delt, taucd, rcd, freesurffac, |
17141 |
$implicsurfpress, implicdiv2dflow, hfacmin, hfacmindz, gravity, |
17142 |
$recip_gravity, gbaro, rhonil, recip_rhonil, recip_rhoconst, |
17143 |
$rhoconst, tref, sref, endtime, chkptfreq, pchkptfreq, dumpfreq, |
17144 |
$tavefreq, affacmom, vffacmom, pffacmom, cffacmom, fofacmom, |
17145 |
$mtfacmom, cospower, cadjfreq, omega, tauthetaclimrelax, |
17146 |
$lambdathetaclimrelax, tausaltclimrelax, lambdasaltclimrelax, |
17147 |
$externforcingcycle, externforcingperiod, viscap, diffkpt, diffkps, |
17148 |
$ hfacmindr, hfacmindp, theta_s, specvol_s, horivertratio, |
17149 |
$recip_horivertratio, latfftfiltlo, ivdc_kappa, ro_sealevel, |
17150 |
$zonal_filt_lat, bottomdraglinear, bottomdragquadratic |
17151 |
double precision abeps |
17152 |
double precision affacmom |
17153 |
double precision beta |
17154 |
double precision bottomdraglinear |
17155 |
double precision bottomdragquadratic |
17156 |
double precision cadjfreq |
17157 |
double precision cffacmom |
17158 |
double precision cg2dpcoffdfac |
17159 |
double precision cg2dtargetresidual |
17160 |
double precision cg3dtargetresidual |
17161 |
double precision chkptfreq |
17162 |
double precision cospower |
17163 |
double precision delp(nr) |
17164 |
double precision delr(nr) |
17165 |
double precision delt |
17166 |
double precision deltat |
17167 |
double precision deltatclock |
17168 |
double precision deltatmom |
17169 |
double precision deltattracer |
17170 |
double precision delx(nx) |
17171 |
double precision dely(ny) |
17172 |
double precision delz(nr) |
17173 |
double precision diffk4s |
17174 |
double precision diffk4t |
17175 |
double precision diffkhs |
17176 |
double precision diffkht |
17177 |
double precision diffkps |
17178 |
double precision diffkpt |
17179 |
double precision diffkrs |
17180 |
double precision diffkrt |
17181 |
double precision diffkzs |
17182 |
double precision diffkzt |
17183 |
double precision dumpfreq |
17184 |
double precision endtime |
17185 |
double precision externforcingcycle |
17186 |
double precision externforcingperiod |
17187 |
double precision f0 |
17188 |
double precision fcori(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
17189 |
double precision fofacmom |
17190 |
double precision freesurffac |
17191 |
double precision gbaro |
17192 |
double precision gravity |
17193 |
double precision hfacmin |
17194 |
double precision hfacmindp |
17195 |
double precision hfacmindr |
17196 |
double precision hfacmindz |
17197 |
double precision horivertratio |
17198 |
double precision implicdiv2dflow |
17199 |
double precision implicsurfpress |
17200 |
double precision ivdc_kappa |
17201 |
double precision lambdasaltclimrelax |
17202 |
double precision lambdathetaclimrelax |
17203 |
double precision latfftfiltlo |
17204 |
double precision mtfacmom |
17205 |
double precision omega |
17206 |
double precision pchkptfreq |
17207 |
double precision pffacmom |
17208 |
double precision phimin |
17209 |
double precision rcd |
17210 |
double precision recip_gravity |
17211 |
double precision recip_horivertratio |
17212 |
double precision recip_rhoconst |
17213 |
double precision recip_rhonil |
17214 |
double precision recip_rsphere |
17215 |
double precision rhoconst |
17216 |
double precision rhonil |
17217 |
double precision ro_sealevel |
17218 |
double precision rsphere |
17219 |
double precision specvol_s(nr) |
17220 |
double precision sref(nr) |
17221 |
double precision starttime |
17222 |
double precision taucd |
17223 |
double precision tausaltclimrelax |
17224 |
double precision tauthetaclimrelax |
17225 |
double precision tavefreq |
17226 |
double precision theta_s(nr) |
17227 |
double precision thetamin |
17228 |
double precision tref(nr) |
17229 |
double precision vffacmom |
17230 |
double precision visca4 |
17231 |
double precision viscah |
17232 |
double precision viscap |
17233 |
double precision viscar |
17234 |
double precision viscaz |
17235 |
double precision zonal_filt_lat |
17236 |
|
17237 |
common /tendency_forcing/ surfacetendencyu, surfacetendencyv, |
17238 |
$surfacetendencyt, surfacetendencys, tempqsw |
17239 |
double precision surfacetendencys(1-olx:snx+olx,1-oly:sny+oly,nsx, |
17240 |
$nsy) |
17241 |
double precision surfacetendencyt(1-olx:snx+olx,1-oly:sny+oly,nsx, |
17242 |
$nsy) |
17243 |
double precision surfacetendencyu(1-olx:snx+olx,1-oly:sny+oly,nsx, |
17244 |
$nsy) |
17245 |
double precision surfacetendencyv(1-olx:snx+olx,1-oly:sny+oly,nsx, |
17246 |
$nsy) |
17247 |
double precision tempqsw(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
17248 |
|
17249 |
C============================================== |
17250 |
C define arguments |
17251 |
C============================================== |
17252 |
double precision addf(1-olx:snx+olx,1-oly:sny+oly) |
17253 |
double precision adkappart(1-olx:snx+olx,1-oly:sny+oly,nr) |
17254 |
integer bi |
17255 |
integer bj |
17256 |
integer imax |
17257 |
integer imin |
17258 |
integer jmax |
17259 |
integer jmin |
17260 |
integer k |
17261 |
double precision kappart(1-olx:snx+olx,1-oly:sny+oly,nr) |
17262 |
integer km1 |
17263 |
double precision maskc(1-olx:snx+olx,1-oly:sny+oly) |
17264 |
|
17265 |
C============================================== |
17266 |
C define local variables |
17267 |
C============================================== |
17268 |
integer i |
17269 |
integer j |
17270 |
|
17271 |
C---------------------------------------------- |
17272 |
C ROUTINE BODY |
17273 |
C---------------------------------------------- |
17274 |
do j = jmin, jmax |
17275 |
do i = imin, imax |
17276 |
adkappart(i,j,k) = adkappart(i,j,k)-addf(i,j)*ra(i,j,bi,bj)* |
17277 |
$maskc(i,j)*kppghat(i,j,km1,bi,bj)*delz(1)*(surfacetendencyt(i,j, |
17278 |
$bi,bj)-qsw(i,j,bi,bj)*recip_cp*recip_rhonil*recip_drf(1)*(1.- |
17279 |
$kppfrac(i,j,bi,bj))) |
17280 |
adkppfrac(i,j,bi,bj) = adkppfrac(i,j,bi,bj)-addf(i,j)*ra(i,j, |
17281 |
$bi,bj)*maskc(i,j)*kappart(i,j,k)*kppghat(i,j,km1,bi,bj)*delz(1)* |
17282 |
$qsw(i,j,bi,bj)*recip_cp*recip_rhonil*recip_drf(1) |
17283 |
adkppghat(i,j,km1,bi,bj) = adkppghat(i,j,km1,bi,bj)-addf(i,j)* |
17284 |
$ra(i,j,bi,bj)*maskc(i,j)*kappart(i,j,k)*delz(1)* |
17285 |
$(surfacetendencyt(i,j,bi,bj)-qsw(i,j,bi,bj)*recip_cp*recip_rhonil* |
17286 |
$recip_drf(1)*(1.-kppfrac(i,j,bi,bj))) |
17287 |
adsurfacetendencyt(i,j,bi,bj) = adsurfacetendencyt(i,j,bi,bj)- |
17288 |
$addf(i,j)*ra(i,j,bi,bj)*maskc(i,j)*kappart(i,j,k)*kppghat(i,j,km1, |
17289 |
$bi,bj)*delz(1) |
17290 |
end do |
17291 |
end do |
17292 |
|
17293 |
end |
17294 |
|
17295 |
|
17296 |
subroutine mdkppmix( mytime, mythid, kmtj, shsq, dvsq, ustar, bo, |
17297 |
$bosol, dbloc, ritop, coriol, ikey, diffus, ghat, hbl ) |
17298 |
C*************************************************************** |
17299 |
C*************************************************************** |
17300 |
C** This routine was generated by the ** |
17301 |
C** Tangent linear and Adjoint Model Compiler, TAMC 5.2.14 ** |
17302 |
C*************************************************************** |
17303 |
C*************************************************************** |
17304 |
C============================================== |
17305 |
C all entries are defined explicitly |
17306 |
C============================================== |
17307 |
implicit none |
17308 |
|
17309 |
C============================================== |
17310 |
C define parameters |
17311 |
C============================================== |
17312 |
integer olx |
17313 |
parameter ( olx = 3 ) |
17314 |
integer oly |
17315 |
parameter ( oly = 3 ) |
17316 |
integer snx |
17317 |
parameter ( snx = 20 ) |
17318 |
integer sny |
17319 |
parameter ( sny = 40 ) |
17320 |
integer imt |
17321 |
parameter ( imt = (snx+2*olx)*(sny+2*oly) ) |
17322 |
integer mdiff |
17323 |
parameter ( mdiff = 3 ) |
17324 |
integer nr |
17325 |
parameter ( nr = 15 ) |
17326 |
integer nrp1 |
17327 |
parameter ( nrp1 = nr+1 ) |
17328 |
|
17329 |
C============================================== |
17330 |
C define common blocks |
17331 |
C============================================== |
17332 |
common /cadbfsfc/ bfsfch |
17333 |
double precision bfsfch(imt,36) |
17334 |
|
17335 |
common /cadblmc/ blmch |
17336 |
double precision blmch(imt,nr,mdiff,36) |
17337 |
|
17338 |
common /cadcasea/ caseah |
17339 |
double precision caseah(imt,36) |
17340 |
|
17341 |
common /caddkm1/ dkm1h |
17342 |
double precision dkm1h(imt,mdiff,36) |
17343 |
|
17344 |
common /cadghat/ ghath |
17345 |
double precision ghath(imt,nr,36) |
17346 |
|
17347 |
common /cadghau/ ghati |
17348 |
double precision ghati(imt,nr,36) |
17349 |
|
17350 |
common /cadhbl/ hblh |
17351 |
double precision hblh(imt,36) |
17352 |
|
17353 |
common /cadkbl/ kblh |
17354 |
integer kblh(imt,36) |
17355 |
|
17356 |
common /cadstable/ stableh |
17357 |
double precision stableh(imt,36) |
17358 |
|
17359 |
C============================================== |
17360 |
C define arguments |
17361 |
C============================================== |
17362 |
double precision bo(imt) |
17363 |
double precision bosol(imt) |
17364 |
double precision coriol(imt) |
17365 |
double precision dbloc(imt,nr) |
17366 |
double precision diffus(imt,0:nrp1,mdiff) |
17367 |
double precision dvsq(imt,nr) |
17368 |
double precision ghat(imt,nr) |
17369 |
double precision hbl(imt) |
17370 |
integer ikey |
17371 |
integer kmtj(imt) |
17372 |
integer mythid |
17373 |
double precision mytime |
17374 |
double precision ritop(imt,nr) |
17375 |
double precision shsq(imt,nr) |
17376 |
double precision ustar(imt) |
17377 |
|
17378 |
C============================================== |
17379 |
C define local variables |
17380 |
C============================================== |
17381 |
double precision bfsfc(imt) |
17382 |
double precision blmc(imt,nr,mdiff) |
17383 |
double precision casea(imt) |
17384 |
double precision dkm1(imt,mdiff) |
17385 |
integer i |
17386 |
integer ip1 |
17387 |
integer ip2 |
17388 |
integer ip3 |
17389 |
integer k |
17390 |
integer kbl(imt) |
17391 |
integer md |
17392 |
double precision rib(imt,nr) |
17393 |
double precision sigma(imt) |
17394 |
double precision stable(imt) |
17395 |
|
17396 |
C********************************************** |
17397 |
C executable statements of routine |
17398 |
C********************************************** |
17399 |
do ip2 = 1, nr |
17400 |
do ip1 = 1, imt |
17401 |
ghati(ip1,ip2,ikey) = ghat(ip1,ip2) |
17402 |
end do |
17403 |
end do |
17404 |
call ri_iwmix( kmtj,shsq,dbloc,ghat,ikey,diffus ) |
17405 |
do md = 1, mdiff |
17406 |
do i = 1, imt |
17407 |
do k = kmtj(i), nrp1 |
17408 |
diffus(i,k,md) = 0. |
17409 |
end do |
17410 |
end do |
17411 |
end do |
17412 |
call mdbldepth( mytime,mythid,kmtj,dvsq,dbloc,ritop,ustar,bo, |
17413 |
$bosol,coriol,ikey,hbl,bfsfc,stable,casea,kbl,rib,sigma ) |
17414 |
do ip1 = 1, imt |
17415 |
hblh(ip1,ikey) = hbl(ip1) |
17416 |
end do |
17417 |
do ip1 = 1, imt |
17418 |
bfsfch(ip1,ikey) = bfsfc(ip1) |
17419 |
end do |
17420 |
do ip1 = 1, imt |
17421 |
stableh(ip1,ikey) = stable(ip1) |
17422 |
end do |
17423 |
do ip1 = 1, imt |
17424 |
caseah(ip1,ikey) = casea(ip1) |
17425 |
end do |
17426 |
do ip1 = 1, imt |
17427 |
kblh(ip1,ikey) = kbl(ip1) |
17428 |
end do |
17429 |
call mdblmix( ustar,bfsfc,hbl,stable,casea,diffus,kbl,dkm1,blmc, |
17430 |
$ghat,sigma,ikey ) |
17431 |
do ip2 = 1, mdiff |
17432 |
do ip1 = 1, imt |
17433 |
dkm1h(ip1,ip2,ikey) = dkm1(ip1,ip2) |
17434 |
end do |
17435 |
end do |
17436 |
do ip3 = 1, mdiff |
17437 |
do ip2 = 1, nr |
17438 |
do ip1 = 1, imt |
17439 |
blmch(ip1,ip2,ip3,ikey) = blmc(ip1,ip2,ip3) |
17440 |
end do |
17441 |
end do |
17442 |
end do |
17443 |
do ip2 = 1, nr |
17444 |
do ip1 = 1, imt |
17445 |
ghath(ip1,ip2,ikey) = ghat(ip1,ip2) |
17446 |
end do |
17447 |
end do |
17448 |
call enhance( dkm1,hbl,kbl,diffus,casea,ghat,blmc ) |
17449 |
do k = 1, nr |
17450 |
do i = 1, imt |
17451 |
if (k .lt. kbl(i)) then |
17452 |
do md = 1, mdiff |
17453 |
diffus(i,k,md) = blmc(i,k,md) |
17454 |
end do |
17455 |
else |
17456 |
ghat(i,k) = 0. |
17457 |
endif |
17458 |
end do |
17459 |
end do |
17460 |
end |
17461 |
|
17462 |
|
17463 |
subroutine adkppmix( kmtj, shsq, dvsq, ustar, bo, bosol, dbloc, |
17464 |
$ritop, coriol, ikey, adshsq, addvsq, adustar, adbo, adbosol, |
17465 |
$addbloc, adritop, adcoriol, addiffus, adghat, adhbl ) |
17466 |
C*************************************************************** |
17467 |
C*************************************************************** |
17468 |
C** This routine was generated by the ** |
17469 |
C** Tangent linear and Adjoint Model Compiler, TAMC 5.2.14 ** |
17470 |
C*************************************************************** |
17471 |
C*************************************************************** |
17472 |
C============================================== |
17473 |
C all entries are defined explicitly |
17474 |
C============================================== |
17475 |
implicit none |
17476 |
|
17477 |
C============================================== |
17478 |
C define parameters |
17479 |
C============================================== |
17480 |
integer olx |
17481 |
parameter ( olx = 3 ) |
17482 |
integer oly |
17483 |
parameter ( oly = 3 ) |
17484 |
integer snx |
17485 |
parameter ( snx = 20 ) |
17486 |
integer sny |
17487 |
parameter ( sny = 40 ) |
17488 |
integer imt |
17489 |
parameter ( imt = (snx+2*olx)*(sny+2*oly) ) |
17490 |
integer mdiff |
17491 |
parameter ( mdiff = 3 ) |
17492 |
integer nr |
17493 |
parameter ( nr = 15 ) |
17494 |
integer nrp1 |
17495 |
parameter ( nrp1 = nr+1 ) |
17496 |
|
17497 |
C============================================== |
17498 |
C define common blocks |
17499 |
C============================================== |
17500 |
common /cadbfsfc/ bfsfch |
17501 |
double precision bfsfch(imt,36) |
17502 |
|
17503 |
common /cadblmc/ blmch |
17504 |
double precision blmch(imt,nr,mdiff,36) |
17505 |
|
17506 |
common /cadcasea/ caseah |
17507 |
double precision caseah(imt,36) |
17508 |
|
17509 |
common /caddkm1/ dkm1h |
17510 |
double precision dkm1h(imt,mdiff,36) |
17511 |
|
17512 |
common /cadghat/ ghath |
17513 |
double precision ghath(imt,nr,36) |
17514 |
|
17515 |
common /cadghau/ ghati |
17516 |
double precision ghati(imt,nr,36) |
17517 |
|
17518 |
common /cadhbl/ hblh |
17519 |
double precision hblh(imt,36) |
17520 |
|
17521 |
common /cadkbl/ kblh |
17522 |
integer kblh(imt,36) |
17523 |
|
17524 |
common /cadstable/ stableh |
17525 |
double precision stableh(imt,36) |
17526 |
|
17527 |
C============================================== |
17528 |
C define arguments |
17529 |
C============================================== |
17530 |
double precision adbo(imt) |
17531 |
double precision adbosol(imt) |
17532 |
double precision adcoriol(imt) |
17533 |
double precision addbloc(imt,nr) |
17534 |
double precision addiffus(imt,0:nrp1,mdiff) |
17535 |
double precision addvsq(imt,nr) |
17536 |
double precision adghat(imt,nr) |
17537 |
double precision adhbl(imt) |
17538 |
double precision adritop(imt,nr) |
17539 |
double precision adshsq(imt,nr) |
17540 |
double precision adustar(imt) |
17541 |
double precision bo(imt) |
17542 |
double precision bosol(imt) |
17543 |
double precision coriol(imt) |
17544 |
double precision dbloc(imt,nr) |
17545 |
double precision dvsq(imt,nr) |
17546 |
integer ikey |
17547 |
integer kmtj(imt) |
17548 |
double precision ritop(imt,nr) |
17549 |
double precision shsq(imt,nr) |
17550 |
double precision ustar(imt) |
17551 |
|
17552 |
C============================================== |
17553 |
C define local variables |
17554 |
C============================================== |
17555 |
double precision adbfsfc(imt) |
17556 |
double precision adblmc(imt,nr,mdiff) |
17557 |
double precision adcasea(imt) |
17558 |
double precision addkm1(imt,mdiff) |
17559 |
double precision adrib(imt,nr) |
17560 |
double precision adsigma(imt) |
17561 |
double precision adstable(imt) |
17562 |
double precision bfsfc(imt) |
17563 |
double precision blmc(imt,nr,mdiff) |
17564 |
double precision casea(imt) |
17565 |
double precision diffus(imt,0:nrp1,mdiff) |
17566 |
double precision dkm1(imt,mdiff) |
17567 |
double precision ghat(imt,nr) |
17568 |
double precision hbl(imt) |
17569 |
integer i |
17570 |
integer ip1 |
17571 |
integer ip2 |
17572 |
integer ip3 |
17573 |
integer k |
17574 |
integer kbl(imt) |
17575 |
integer md |
17576 |
double precision stable(imt) |
17577 |
|
17578 |
C---------------------------------------------- |
17579 |
C RESET LOCAL ADJOINT VARIABLES |
17580 |
C---------------------------------------------- |
17581 |
do ip1 = 1, imt |
17582 |
adbfsfc(ip1) = 0.d0 |
17583 |
end do |
17584 |
do ip3 = 1, mdiff |
17585 |
do ip2 = 1, nr |
17586 |
do ip1 = 1, imt |
17587 |
adblmc(ip1,ip2,ip3) = 0.d0 |
17588 |
end do |
17589 |
end do |
17590 |
end do |
17591 |
do ip1 = 1, imt |
17592 |
adcasea(ip1) = 0.d0 |
17593 |
end do |
17594 |
do ip2 = 1, mdiff |
17595 |
do ip1 = 1, imt |
17596 |
addkm1(ip1,ip2) = 0.d0 |
17597 |
end do |
17598 |
end do |
17599 |
do ip2 = 1, nr |
17600 |
do ip1 = 1, imt |
17601 |
adrib(ip1,ip2) = 0.d0 |
17602 |
end do |
17603 |
end do |
17604 |
do ip1 = 1, imt |
17605 |
adsigma(ip1) = 0.d0 |
17606 |
end do |
17607 |
do ip1 = 1, imt |
17608 |
adstable(ip1) = 0.d0 |
17609 |
end do |
17610 |
|
17611 |
C---------------------------------------------- |
17612 |
C ROUTINE BODY |
17613 |
C---------------------------------------------- |
17614 |
do ip2 = 1, nr |
17615 |
do ip1 = 1, imt |
17616 |
ghat(ip1,ip2) = ghati(ip1,ip2,ikey) |
17617 |
end do |
17618 |
end do |
17619 |
call ri_iwmix( kmtj,shsq,dbloc,ghat,ikey,diffus ) |
17620 |
do md = 1, mdiff |
17621 |
do i = 1, imt |
17622 |
do k = kmtj(i), nrp1 |
17623 |
diffus(i,k,md) = 0. |
17624 |
end do |
17625 |
end do |
17626 |
end do |
17627 |
do ip1 = 1, imt |
17628 |
hbl(ip1) = hblh(ip1,ikey) |
17629 |
end do |
17630 |
do ip1 = 1, imt |
17631 |
bfsfc(ip1) = bfsfch(ip1,ikey) |
17632 |
end do |
17633 |
do ip1 = 1, imt |
17634 |
stable(ip1) = stableh(ip1,ikey) |
17635 |
end do |
17636 |
do ip1 = 1, imt |
17637 |
casea(ip1) = caseah(ip1,ikey) |
17638 |
end do |
17639 |
do ip1 = 1, imt |
17640 |
kbl(ip1) = kblh(ip1,ikey) |
17641 |
end do |
17642 |
do ip2 = 1, mdiff |
17643 |
do ip1 = 1, imt |
17644 |
dkm1(ip1,ip2) = dkm1h(ip1,ip2,ikey) |
17645 |
end do |
17646 |
end do |
17647 |
do ip3 = 1, mdiff |
17648 |
do ip2 = 1, nr |
17649 |
do ip1 = 1, imt |
17650 |
blmc(ip1,ip2,ip3) = blmch(ip1,ip2,ip3,ikey) |
17651 |
end do |
17652 |
end do |
17653 |
end do |
17654 |
do ip2 = 1, nr |
17655 |
do ip1 = 1, imt |
17656 |
ghat(ip1,ip2) = ghath(ip1,ip2,ikey) |
17657 |
end do |
17658 |
end do |
17659 |
do k = 1, nr |
17660 |
do i = 1, imt |
17661 |
if (k .lt. kbl(i)) then |
17662 |
do md = 1, mdiff |
17663 |
adblmc(i,k,md) = adblmc(i,k,md)+addiffus(i,k,md) |
17664 |
addiffus(i,k,md) = 0.d0 |
17665 |
end do |
17666 |
else |
17667 |
adghat(i,k) = 0.d0 |
17668 |
endif |
17669 |
end do |
17670 |
end do |
17671 |
call adenhance( dkm1,hbl,kbl,diffus,casea,ghat,blmc,addkm1,adhbl, |
17672 |
$addiffus,adcasea,adghat,adblmc ) |
17673 |
call adblmix( ustar,bfsfc,hbl,stable,casea,diffus,kbl,ikey, |
17674 |
$adustar,adbfsfc,adhbl,adstable,adcasea,addiffus,addkm1,adblmc, |
17675 |
$adghat,adsigma ) |
17676 |
call adbldepth( kmtj,dvsq,dbloc,ritop,ustar,bo,bosol,coriol,ikey, |
17677 |
$addvsq,addbloc,adritop,adustar,adbo,adbosol,adcoriol,adhbl, |
17678 |
$adbfsfc,adstable,adcasea,adrib,adsigma ) |
17679 |
do md = 1, mdiff |
17680 |
do i = 1, imt |
17681 |
do k = kmtj(i), nrp1 |
17682 |
addiffus(i,k,md) = 0.d0 |
17683 |
end do |
17684 |
end do |
17685 |
end do |
17686 |
do ip2 = 1, nr |
17687 |
do ip1 = 1, imt |
17688 |
ghat(ip1,ip2) = ghati(ip1,ip2,ikey) |
17689 |
end do |
17690 |
end do |
17691 |
call adri_iwmix( kmtj,shsq,dbloc,ghat,adshsq,addbloc,adghat, |
17692 |
$addiffus ) |
17693 |
|
17694 |
end |
17695 |
|
17696 |
|
17697 |
subroutine adpackages_init_variables( mythid ) |
17698 |
C*************************************************************** |
17699 |
C*************************************************************** |
17700 |
C** This routine was generated by the ** |
17701 |
C** Tangent linear and Adjoint Model Compiler, TAMC 5.2.14 ** |
17702 |
C*************************************************************** |
17703 |
C*************************************************************** |
17704 |
C============================================== |
17705 |
C all entries are defined explicitly |
17706 |
C============================================== |
17707 |
implicit none |
17708 |
|
17709 |
C============================================== |
17710 |
C define parameters |
17711 |
C============================================== |
17712 |
integer nsx |
17713 |
parameter ( nsx = 1 ) |
17714 |
integer nsy |
17715 |
parameter ( nsy = 1 ) |
17716 |
integer olx |
17717 |
parameter ( olx = 3 ) |
17718 |
integer oly |
17719 |
parameter ( oly = 3 ) |
17720 |
integer snx |
17721 |
parameter ( snx = 20 ) |
17722 |
integer sny |
17723 |
parameter ( sny = 40 ) |
17724 |
|
17725 |
C============================================== |
17726 |
C define common blocks |
17727 |
C============================================== |
17728 |
common /adcost_r/ adcost_r1, adcost_r14 |
17729 |
double precision adcost_r1 |
17730 |
double precision adcost_r14(nsx,nsy) |
17731 |
|
17732 |
common /adffields/ adffields1, adffields2, adffields3, adffields4 |
17733 |
double precision adffields1(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
17734 |
double precision adffields2(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
17735 |
double precision adffields3(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
17736 |
double precision adffields4(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
17737 |
|
17738 |
C============================================== |
17739 |
C define arguments |
17740 |
C============================================== |
17741 |
integer mythid |
17742 |
|
17743 |
C============================================== |
17744 |
C define local variables |
17745 |
C============================================== |
17746 |
integer ip1 |
17747 |
integer ip2 |
17748 |
integer ip3 |
17749 |
integer ip4 |
17750 |
|
17751 |
C---------------------------------------------- |
17752 |
C ROUTINE BODY |
17753 |
C---------------------------------------------- |
17754 |
call barrier( mythid ) |
17755 |
do ip4 = 1, nsy |
17756 |
do ip3 = 1, nsx |
17757 |
do ip2 = 1-oly, sny+oly |
17758 |
do ip1 = 1-olx, snx+olx |
17759 |
adffields1(ip1,ip2,ip3,ip4) = 0.d0 |
17760 |
end do |
17761 |
end do |
17762 |
end do |
17763 |
end do |
17764 |
do ip4 = 1, nsy |
17765 |
do ip3 = 1, nsx |
17766 |
do ip2 = 1-oly, sny+oly |
17767 |
do ip1 = 1-olx, snx+olx |
17768 |
adffields2(ip1,ip2,ip3,ip4) = 0.d0 |
17769 |
end do |
17770 |
end do |
17771 |
end do |
17772 |
end do |
17773 |
do ip4 = 1, nsy |
17774 |
do ip3 = 1, nsx |
17775 |
do ip2 = 1-oly, sny+oly |
17776 |
do ip1 = 1-olx, snx+olx |
17777 |
adffields3(ip1,ip2,ip3,ip4) = 0.d0 |
17778 |
end do |
17779 |
end do |
17780 |
end do |
17781 |
end do |
17782 |
do ip4 = 1, nsy |
17783 |
do ip3 = 1, nsx |
17784 |
do ip2 = 1-oly, sny+oly |
17785 |
do ip1 = 1-olx, snx+olx |
17786 |
adffields4(ip1,ip2,ip3,ip4) = 0.d0 |
17787 |
end do |
17788 |
end do |
17789 |
end do |
17790 |
end do |
17791 |
call barrier( mythid ) |
17792 |
adcost_r1 = 0.d0 |
17793 |
call barrier( mythid ) |
17794 |
call adctrl_map_ini( mythid ) |
17795 |
|
17796 |
end |
17797 |
|
17798 |
|
17799 |
subroutine adri_iwmix( kmtj, shsq, dbloc, dblocsm, adshsq, |
17800 |
$addbloc, addblocsm, addiffus ) |
17801 |
C*************************************************************** |
17802 |
C*************************************************************** |
17803 |
C** This routine was generated by the ** |
17804 |
C** Tangent linear and Adjoint Model Compiler, TAMC 5.2.14 ** |
17805 |
C*************************************************************** |
17806 |
C*************************************************************** |
17807 |
C============================================== |
17808 |
C all entries are defined explicitly |
17809 |
C============================================== |
17810 |
implicit none |
17811 |
|
17812 |
C============================================== |
17813 |
C define parameters |
17814 |
C============================================== |
17815 |
integer olx |
17816 |
parameter ( olx = 3 ) |
17817 |
integer oly |
17818 |
parameter ( oly = 3 ) |
17819 |
integer snx |
17820 |
parameter ( snx = 20 ) |
17821 |
integer sny |
17822 |
parameter ( sny = 40 ) |
17823 |
integer imt |
17824 |
parameter ( imt = (snx+2*olx)*(sny+2*oly) ) |
17825 |
integer nr |
17826 |
parameter ( nr = 15 ) |
17827 |
integer nrp1 |
17828 |
parameter ( nrp1 = nr+1 ) |
17829 |
integer nsx |
17830 |
parameter ( nsx = 1 ) |
17831 |
integer nsy |
17832 |
parameter ( nsy = 1 ) |
17833 |
|
17834 |
C============================================== |
17835 |
C define common blocks |
17836 |
C============================================== |
17837 |
common /kmixcom/ epsln, phepsi, epsilon, vonk, db_dz, conc1, |
17838 |
$conam, concm, conc2, zetam, conas, concs, conc3, zetas |
17839 |
double precision conam |
17840 |
double precision conas |
17841 |
double precision conc1 |
17842 |
double precision conc2 |
17843 |
double precision conc3 |
17844 |
double precision concm |
17845 |
double precision concs |
17846 |
double precision db_dz |
17847 |
double precision epsilon |
17848 |
double precision epsln |
17849 |
double precision phepsi |
17850 |
double precision vonk |
17851 |
double precision zetam |
17852 |
double precision zetas |
17853 |
|
17854 |
common /kmixcri_r/ riinfty, bvsqcon, difm0, difs0, dift0, difmcon, |
17855 |
$ difscon, diftcon |
17856 |
double precision bvsqcon |
17857 |
double precision difm0 |
17858 |
double precision difmcon |
17859 |
double precision difs0 |
17860 |
double precision difscon |
17861 |
double precision dift0 |
17862 |
double precision diftcon |
17863 |
double precision riinfty |
17864 |
|
17865 |
common /kpp_r1/ pmask, zgrid, hwide |
17866 |
double precision hwide(0:nr+1) |
17867 |
double precision pmask(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
17868 |
double precision zgrid(0:nr+1) |
17869 |
|
17870 |
C============================================== |
17871 |
C define arguments |
17872 |
C============================================== |
17873 |
double precision addbloc(imt,nr) |
17874 |
double precision addblocsm(imt,nr) |
17875 |
double precision addiffus(imt,0:nrp1,3) |
17876 |
double precision adshsq(imt,nr) |
17877 |
double precision dbloc(imt,nr) |
17878 |
double precision dblocsm(imt,nr) |
17879 |
integer kmtj(imt) |
17880 |
double precision shsq(imt,nr) |
17881 |
|
17882 |
C============================================== |
17883 |
C define local variables |
17884 |
C============================================== |
17885 |
double precision adfcon |
17886 |
double precision adfri |
17887 |
double precision adratio |
17888 |
double precision adrig |
17889 |
double precision c0 |
17890 |
double precision c1 |
17891 |
double precision diffus(imt,0:nrp1,3) |
17892 |
double precision fcon |
17893 |
double precision fri |
17894 |
integer i |
17895 |
integer ki |
17896 |
double precision ratio |
17897 |
double precision rig |
17898 |
|
17899 |
C---------------------------------------------- |
17900 |
C RESET LOCAL ADJOINT VARIABLES |
17901 |
C---------------------------------------------- |
17902 |
adfcon = 0.d0 |
17903 |
adfri = 0.d0 |
17904 |
adratio = 0.d0 |
17905 |
adrig = 0.d0 |
17906 |
|
17907 |
C---------------------------------------------- |
17908 |
C ROUTINE BODY |
17909 |
C---------------------------------------------- |
17910 |
c1 = 1. |
17911 |
c0 = 0. |
17912 |
diffus(1,1,1) = 0. |
17913 |
do ki = 1, nr |
17914 |
do i = 1, imt |
17915 |
if (kmtj(i) .eq. 0) then |
17916 |
diffus(i,ki,1) = 0. |
17917 |
diffus(i,ki,2) = 0. |
17918 |
else if (ki .ge. kmtj(i)) then |
17919 |
diffus(i,ki,1) = diffus(i,ki-1,1) |
17920 |
diffus(i,ki,2) = diffus(i,ki-1,2) |
17921 |
else |
17922 |
diffus(i,ki,1) = dblocsm(i,ki)*(zgrid(ki)-zgrid(ki+1))/ |
17923 |
$max(shsq(i,ki),phepsi) |
17924 |
diffus(i,ki,2) = dbloc(i,ki)/(zgrid(ki)-zgrid(ki+1)) |
17925 |
endif |
17926 |
end do |
17927 |
end do |
17928 |
do i = 1, imt |
17929 |
addiffus(i,0,3) = 0.d0 |
17930 |
addiffus(i,0,2) = 0.d0 |
17931 |
addiffus(i,0,1) = 0.d0 |
17932 |
end do |
17933 |
do ki = 1, nr |
17934 |
adfcon = 0.d0 |
17935 |
adfri = 0.d0 |
17936 |
adratio = 0.d0 |
17937 |
adrig = 0.d0 |
17938 |
do i = 1, imt |
17939 |
adfcon = 0.d0 |
17940 |
adfri = 0.d0 |
17941 |
adratio = 0.d0 |
17942 |
adrig = 0.d0 |
17943 |
rig = max(diffus(i,ki,2),bvsqcon) |
17944 |
ratio = min((bvsqcon-rig)/bvsqcon,c1) |
17945 |
fcon = c1-ratio*ratio |
17946 |
rig = max(diffus(i,ki,1),c0) |
17947 |
ratio = min(rig/riinfty,c1) |
17948 |
fri = c1-ratio*ratio |
17949 |
adfcon = adfcon+addiffus(i,ki,3)*difscon |
17950 |
adfri = adfri+addiffus(i,ki,3)*difs0 |
17951 |
addiffus(i,ki,3) = 0.d0 |
17952 |
adfcon = adfcon+addiffus(i,ki,2)*difscon |
17953 |
adfri = adfri+addiffus(i,ki,2)*difs0 |
17954 |
addiffus(i,ki,2) = 0.d0 |
17955 |
adfcon = adfcon+addiffus(i,ki,1)*difmcon |
17956 |
adfri = adfri+addiffus(i,ki,1)*difm0 |
17957 |
addiffus(i,ki,1) = 0.d0 |
17958 |
adfri = 3*adfri*fri*fri |
17959 |
adratio = adratio-2*adfri*ratio |
17960 |
adfri = 0.d0 |
17961 |
adrig = adrig+adratio*((0.5+sign(0.5d0,c1-rig/riinfty))/ |
17962 |
$riinfty) |
17963 |
adratio = 0.d0 |
17964 |
addiffus(i,ki,1) = addiffus(i,ki,1)+adrig*(0.5+sign(0.5d0, |
17965 |
$diffus(i,ki,1)-c0)) |
17966 |
adrig = 0.d0 |
17967 |
adfcon = 3*adfcon*fcon*fcon |
17968 |
rig = max(diffus(i,ki,2),bvsqcon) |
17969 |
ratio = min((bvsqcon-rig)/bvsqcon,c1) |
17970 |
adratio = adratio-2*adfcon*ratio |
17971 |
adfcon = 0.d0 |
17972 |
rig = max(diffus(i,ki,2),bvsqcon) |
17973 |
adrig = adrig-adratio*((0.5+sign(0.5d0,c1-(bvsqcon-rig)/ |
17974 |
$bvsqcon))/bvsqcon) |
17975 |
adratio = 0.d0 |
17976 |
addiffus(i,ki,2) = addiffus(i,ki,2)+adrig*(0.5+sign(0.5d0, |
17977 |
$diffus(i,ki,2)-bvsqcon)) |
17978 |
adrig = 0.d0 |
17979 |
end do |
17980 |
end do |
17981 |
do ki = nr, 1, -1 |
17982 |
do i = 1, imt |
17983 |
if (kmtj(i) .eq. 0) then |
17984 |
addiffus(i,ki,2) = 0.d0 |
17985 |
addiffus(i,ki,1) = 0.d0 |
17986 |
else if (ki .ge. kmtj(i)) then |
17987 |
addiffus(i,ki-1,2) = addiffus(i,ki-1,2)+addiffus(i,ki,2) |
17988 |
addiffus(i,ki,2) = 0.d0 |
17989 |
addiffus(i,ki-1,1) = addiffus(i,ki-1,1)+addiffus(i,ki,1) |
17990 |
addiffus(i,ki,1) = 0.d0 |
17991 |
else |
17992 |
addbloc(i,ki) = addbloc(i,ki)+addiffus(i,ki,2)/(zgrid(ki)- |
17993 |
$zgrid(ki+1)) |
17994 |
addiffus(i,ki,2) = 0.d0 |
17995 |
addblocsm(i,ki) = addblocsm(i,ki)+addiffus(i,ki,1)* |
17996 |
$((zgrid(ki)-zgrid(ki+1))/max(shsq(i,ki),phepsi)) |
17997 |
adshsq(i,ki) = adshsq(i,ki)-addiffus(i,ki,1)*(dblocsm(i,ki)* |
17998 |
$(zgrid(ki)-zgrid(ki+1))*(0.5+sign(0.5d0,shsq(i,ki)-phepsi))/ |
17999 |
$(max(shsq(i,ki),phepsi)*max(shsq(i,ki),phepsi))) |
18000 |
addiffus(i,ki,1) = 0.d0 |
18001 |
endif |
18002 |
end do |
18003 |
end do |
18004 |
addiffus(1,1,1) = 0.d0 |
18005 |
|
18006 |
end |
18007 |
|
18008 |
|
18009 |
subroutine adsolve_for_pressure( mythid ) |
18010 |
C*************************************************************** |
18011 |
C*************************************************************** |
18012 |
C** This routine was generated by the ** |
18013 |
C** Tangent linear and Adjoint Model Compiler, TAMC 5.2.14 ** |
18014 |
C*************************************************************** |
18015 |
C*************************************************************** |
18016 |
C============================================== |
18017 |
C all entries are defined explicitly |
18018 |
C============================================== |
18019 |
implicit none |
18020 |
|
18021 |
C============================================== |
18022 |
C define parameters |
18023 |
C============================================== |
18024 |
integer max_no_threads |
18025 |
parameter ( max_no_threads = 32 ) |
18026 |
integer npx |
18027 |
parameter ( npx = 1 ) |
18028 |
integer npy |
18029 |
parameter ( npy = 1 ) |
18030 |
integer nr |
18031 |
parameter ( nr = 15 ) |
18032 |
integer nsx |
18033 |
parameter ( nsx = 1 ) |
18034 |
integer nsy |
18035 |
parameter ( nsy = 1 ) |
18036 |
integer snx |
18037 |
parameter ( snx = 20 ) |
18038 |
integer nx |
18039 |
parameter ( nx = snx*nsx*npx ) |
18040 |
integer sny |
18041 |
parameter ( sny = 40 ) |
18042 |
integer ny |
18043 |
parameter ( ny = sny*nsy*npy ) |
18044 |
integer olx |
18045 |
parameter ( olx = 3 ) |
18046 |
integer oly |
18047 |
parameter ( oly = 3 ) |
18048 |
|
18049 |
C============================================== |
18050 |
C define common blocks |
18051 |
C============================================== |
18052 |
common /addynvars_cd/ aduveld, advveld, adetanm1, adunm1, advnm1, |
18053 |
$adgucd, adgvcd |
18054 |
double precision adetanm1(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
18055 |
double precision adgucd(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
18056 |
double precision adgvcd(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
18057 |
double precision adunm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
18058 |
double precision aduveld(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
18059 |
double precision advnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
18060 |
double precision advveld(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
18061 |
|
18062 |
common /addynvars_r/ adetan, aduvel, advvel, adwvel, adtheta, |
18063 |
$adsalt, adgu, adgv, adgt, adgs, adgunm1, adgvnm1, adgtnm1, adgsnm1 |
18064 |
double precision adetan(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
18065 |
double precision adgs(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
18066 |
double precision adgsnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
18067 |
double precision adgt(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
18068 |
double precision adgtnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
18069 |
double precision adgu(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
18070 |
double precision adgunm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
18071 |
double precision adgv(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
18072 |
double precision adgvnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
18073 |
double precision adsalt(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
18074 |
double precision adtheta(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
18075 |
double precision aduvel(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
18076 |
double precision advvel(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
18077 |
double precision adwvel(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
18078 |
|
18079 |
common /eeparams_i/ errormessageunit, standardmessageunit, |
18080 |
$scrunit1, scrunit2, eedataunit, modeldataunit, numberofprocs, |
18081 |
$pidio, myprocid, mypx, mypy, myxgloballo, myygloballo, nthreads, |
18082 |
$mybxlo, mybxhi, mybylo, mybyhi, ntx, nty, ioerrorcount |
18083 |
integer eedataunit |
18084 |
integer errormessageunit |
18085 |
integer ioerrorcount(max_no_threads) |
18086 |
integer modeldataunit |
18087 |
integer mybxhi(max_no_threads) |
18088 |
integer mybxlo(max_no_threads) |
18089 |
integer mybyhi(max_no_threads) |
18090 |
integer mybylo(max_no_threads) |
18091 |
integer myprocid |
18092 |
integer mypx |
18093 |
integer mypy |
18094 |
integer myxgloballo |
18095 |
integer myygloballo |
18096 |
integer nthreads |
18097 |
integer ntx |
18098 |
integer nty |
18099 |
integer numberofprocs |
18100 |
integer pidio |
18101 |
integer scrunit1 |
18102 |
integer scrunit2 |
18103 |
integer standardmessageunit |
18104 |
|
18105 |
common /grid_r/ dxc, dxf, dxg, dxv, dyc, dyf, dyg, dyu, drc, drf, |
18106 |
$h, hfacc, hfacw, hfacs, depthink, recip_dxc, recip_dxf, recip_dxg, |
18107 |
$ recip_dxv, recip_dyc, recip_dyf, recip_dyg, recip_dyu, recip_drc, |
18108 |
$ recip_drf, recip_h, recip_hfacc, recip_hfacw, recip_hfacs, rkfac, |
18109 |
$ recip_rkfac, safac, xc, yc, ra, raw, ras, raz, rc, rf, yc0, xc0, |
18110 |
$xg, yg, maskw, masks, recip_ra, recip_raw, recip_ras, recip_raz, |
18111 |
$tanphiatu, tanphiatv |
18112 |
double precision depthink(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
18113 |
double precision drc(1:nr) |
18114 |
double precision drf(1:nr) |
18115 |
double precision dxc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
18116 |
double precision dxf(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
18117 |
double precision dxg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
18118 |
double precision dxv(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
18119 |
double precision dyc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
18120 |
double precision dyf(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
18121 |
double precision dyg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
18122 |
double precision dyu(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
18123 |
double precision h(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
18124 |
double precision hfacc(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) |
18125 |
double precision hfacs(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) |
18126 |
double precision hfacw(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) |
18127 |
double precision masks(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) |
18128 |
double precision maskw(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) |
18129 |
double precision ra(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
18130 |
double precision ras(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
18131 |
double precision raw(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
18132 |
double precision raz(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
18133 |
double precision rc(1:nr) |
18134 |
double precision recip_drc(1:nr) |
18135 |
double precision recip_drf(1:nr) |
18136 |
double precision recip_dxc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
18137 |
double precision recip_dxf(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
18138 |
double precision recip_dxg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
18139 |
double precision recip_dxv(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
18140 |
double precision recip_dyc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
18141 |
double precision recip_dyf(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
18142 |
double precision recip_dyg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
18143 |
double precision recip_dyu(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
18144 |
double precision recip_h(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
18145 |
double precision recip_hfacc(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx, |
18146 |
$nsy) |
18147 |
double precision recip_hfacs(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx, |
18148 |
$nsy) |
18149 |
double precision recip_hfacw(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx, |
18150 |
$nsy) |
18151 |
double precision recip_ra(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
18152 |
double precision recip_ras(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
18153 |
double precision recip_raw(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
18154 |
double precision recip_raz(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
18155 |
double precision recip_rkfac |
18156 |
double precision rf(1:nr+1) |
18157 |
double precision rkfac |
18158 |
double precision safac(1:nr) |
18159 |
double precision tanphiatu(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
18160 |
double precision tanphiatv(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
18161 |
double precision xc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
18162 |
double precision xc0 |
18163 |
double precision xg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
18164 |
double precision yc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
18165 |
double precision yc0 |
18166 |
double precision yg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
18167 |
|
18168 |
common /parm_r/ cg2dtargetresidual, cg2dpcoffdfac, |
18169 |
$cg3dtargetresidual, delp, delz, delr, delx, dely, deltat, |
18170 |
$deltatmom, deltattracer, deltatclock, abeps, starttime, phimin, |
18171 |
$thetamin, rsphere, recip_rsphere, f0, fcori, beta, viscah, viscaz, |
18172 |
$ visca4, viscar, diffkht, diffkzt, diffk4t, diffkrt, diffkhs, |
18173 |
$diffkzs, diffk4s, diffkrs, delt, taucd, rcd, freesurffac, |
18174 |
$implicsurfpress, implicdiv2dflow, hfacmin, hfacmindz, gravity, |
18175 |
$recip_gravity, gbaro, rhonil, recip_rhonil, recip_rhoconst, |
18176 |
$rhoconst, tref, sref, endtime, chkptfreq, pchkptfreq, dumpfreq, |
18177 |
$tavefreq, affacmom, vffacmom, pffacmom, cffacmom, fofacmom, |
18178 |
$mtfacmom, cospower, cadjfreq, omega, tauthetaclimrelax, |
18179 |
$lambdathetaclimrelax, tausaltclimrelax, lambdasaltclimrelax, |
18180 |
$externforcingcycle, externforcingperiod, viscap, diffkpt, diffkps, |
18181 |
$ hfacmindr, hfacmindp, theta_s, specvol_s, horivertratio, |
18182 |
$recip_horivertratio, latfftfiltlo, ivdc_kappa, ro_sealevel, |
18183 |
$zonal_filt_lat, bottomdraglinear, bottomdragquadratic |
18184 |
double precision abeps |
18185 |
double precision affacmom |
18186 |
double precision beta |
18187 |
double precision bottomdraglinear |
18188 |
double precision bottomdragquadratic |
18189 |
double precision cadjfreq |
18190 |
double precision cffacmom |
18191 |
double precision cg2dpcoffdfac |
18192 |
double precision cg2dtargetresidual |
18193 |
double precision cg3dtargetresidual |
18194 |
double precision chkptfreq |
18195 |
double precision cospower |
18196 |
double precision delp(nr) |
18197 |
double precision delr(nr) |
18198 |
double precision delt |
18199 |
double precision deltat |
18200 |
double precision deltatclock |
18201 |
double precision deltatmom |
18202 |
double precision deltattracer |
18203 |
double precision delx(nx) |
18204 |
double precision dely(ny) |
18205 |
double precision delz(nr) |
18206 |
double precision diffk4s |
18207 |
double precision diffk4t |
18208 |
double precision diffkhs |
18209 |
double precision diffkht |
18210 |
double precision diffkps |
18211 |
double precision diffkpt |
18212 |
double precision diffkrs |
18213 |
double precision diffkrt |
18214 |
double precision diffkzs |
18215 |
double precision diffkzt |
18216 |
double precision dumpfreq |
18217 |
double precision endtime |
18218 |
double precision externforcingcycle |
18219 |
double precision externforcingperiod |
18220 |
double precision f0 |
18221 |
double precision fcori(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
18222 |
double precision fofacmom |
18223 |
double precision freesurffac |
18224 |
double precision gbaro |
18225 |
double precision gravity |
18226 |
double precision hfacmin |
18227 |
double precision hfacmindp |
18228 |
double precision hfacmindr |
18229 |
double precision hfacmindz |
18230 |
double precision horivertratio |
18231 |
double precision implicdiv2dflow |
18232 |
double precision implicsurfpress |
18233 |
double precision ivdc_kappa |
18234 |
double precision lambdasaltclimrelax |
18235 |
double precision lambdathetaclimrelax |
18236 |
double precision latfftfiltlo |
18237 |
double precision mtfacmom |
18238 |
double precision omega |
18239 |
double precision pchkptfreq |
18240 |
double precision pffacmom |
18241 |
double precision phimin |
18242 |
double precision rcd |
18243 |
double precision recip_gravity |
18244 |
double precision recip_horivertratio |
18245 |
double precision recip_rhoconst |
18246 |
double precision recip_rhonil |
18247 |
double precision recip_rsphere |
18248 |
double precision rhoconst |
18249 |
double precision rhonil |
18250 |
double precision ro_sealevel |
18251 |
double precision rsphere |
18252 |
double precision specvol_s(nr) |
18253 |
double precision sref(nr) |
18254 |
double precision starttime |
18255 |
double precision taucd |
18256 |
double precision tausaltclimrelax |
18257 |
double precision tauthetaclimrelax |
18258 |
double precision tavefreq |
18259 |
double precision theta_s(nr) |
18260 |
double precision thetamin |
18261 |
double precision tref(nr) |
18262 |
double precision vffacmom |
18263 |
double precision visca4 |
18264 |
double precision viscah |
18265 |
double precision viscap |
18266 |
double precision viscar |
18267 |
double precision viscaz |
18268 |
double precision zonal_filt_lat |
18269 |
|
18270 |
common /solve_barot/ bo_surf, recip_bo |
18271 |
double precision bo_surf(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
18272 |
double precision recip_bo(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
18273 |
|
18274 |
C============================================== |
18275 |
C define arguments |
18276 |
C============================================== |
18277 |
integer mythid |
18278 |
|
18279 |
C============================================== |
18280 |
C define local variables |
18281 |
C============================================== |
18282 |
double precision adcg2d_b(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
18283 |
double precision adcg2d_x(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
18284 |
integer bi |
18285 |
integer bj |
18286 |
integer i |
18287 |
integer ip1 |
18288 |
integer ip2 |
18289 |
integer ip3 |
18290 |
integer ip4 |
18291 |
integer j |
18292 |
integer k |
18293 |
integer numiters |
18294 |
double precision residual |
18295 |
double precision tolerance |
18296 |
double precision uf(1-olx:snx+olx,1-oly:sny+oly) |
18297 |
double precision vf(1-olx:snx+olx,1-oly:sny+oly) |
18298 |
|
18299 |
C---------------------------------------------- |
18300 |
C RESET LOCAL ADJOINT VARIABLES |
18301 |
C---------------------------------------------- |
18302 |
do ip4 = 1, nsy |
18303 |
do ip3 = 1, nsx |
18304 |
do ip2 = 1-oly, sny+oly |
18305 |
do ip1 = 1-olx, snx+olx |
18306 |
adcg2d_b(ip1,ip2,ip3,ip4) = 0.d0 |
18307 |
end do |
18308 |
end do |
18309 |
end do |
18310 |
end do |
18311 |
do ip4 = 1, nsy |
18312 |
do ip3 = 1, nsx |
18313 |
do ip2 = 1-oly, sny+oly |
18314 |
do ip1 = 1-olx, snx+olx |
18315 |
adcg2d_x(ip1,ip2,ip3,ip4) = 0.d0 |
18316 |
end do |
18317 |
end do |
18318 |
end do |
18319 |
end do |
18320 |
|
18321 |
C---------------------------------------------- |
18322 |
C ROUTINE BODY |
18323 |
C---------------------------------------------- |
18324 |
tolerance = cg2dtargetresidual |
18325 |
do bj = mybylo(mythid), mybyhi(mythid) |
18326 |
do bi = mybxlo(mythid), mybxhi(mythid) |
18327 |
do j = 1-oly, sny+oly |
18328 |
do i = 1-olx, snx+olx |
18329 |
adcg2d_x(i,j,bi,bj) = adcg2d_x(i,j,bi,bj)+adetan(i,j,bi, |
18330 |
$bj)*recip_bo(i,j,bi,bj) |
18331 |
adetan(i,j,bi,bj) = 0.d0 |
18332 |
end do |
18333 |
end do |
18334 |
end do |
18335 |
end do |
18336 |
call adexch_xy_r8( mythid,adcg2d_x ) |
18337 |
call cg2d( adcg2d_x,adcg2d_b,tolerance,residual,numiters,mythid ) |
18338 |
do ip4 = 1, nsy |
18339 |
do ip3 = 1, nsx |
18340 |
do ip2 = 1-oly, sny+oly |
18341 |
do ip1 = 1-olx, snx+olx |
18342 |
adcg2d_x(ip1,ip2,ip3,ip4) = 0.d0 |
18343 |
end do |
18344 |
end do |
18345 |
end do |
18346 |
end do |
18347 |
do bj = mybylo(mythid), mybyhi(mythid) |
18348 |
do bi = mybxlo(mythid), mybxhi(mythid) |
18349 |
do j = 1, sny |
18350 |
do i = 1, snx |
18351 |
adetan(i,j,bi,bj) = adetan(i,j,bi,bj)-adcg2d_b(i,j,bi,bj)* |
18352 |
$(freesurffac*ra(i,j,bi,bj)/deltatmom/deltatmom) |
18353 |
end do |
18354 |
end do |
18355 |
end do |
18356 |
end do |
18357 |
do bj = mybyhi(mythid), mybylo(mythid), -1 |
18358 |
do bi = mybxhi(mythid), mybxlo(mythid), -1 |
18359 |
do k = 1, nr |
18360 |
do j = 1, sny+1 |
18361 |
do i = 1, snx+1 |
18362 |
uf(i,j) = dyg(i,j,bi,bj)*drf(k)*hfacw(i,j,k,bi,bj) |
18363 |
vf(i,j) = dxg(i,j,bi,bj)*drf(k)*hfacs(i,j,k,bi,bj) |
18364 |
end do |
18365 |
end do |
18366 |
call adcalc_div_ghat( bi,bj,k,uf,vf,adcg2d_b ) |
18367 |
end do |
18368 |
end do |
18369 |
end do |
18370 |
do bj = mybylo(mythid), mybyhi(mythid) |
18371 |
do bi = mybxlo(mythid), mybxhi(mythid) |
18372 |
do j = 1-oly, sny+oly |
18373 |
do i = 1-olx, snx+olx |
18374 |
adetan(i,j,bi,bj) = adetan(i,j,bi,bj)+adcg2d_x(i,j,bi,bj)* |
18375 |
$bo_surf(i,j,bi,bj) |
18376 |
adcg2d_x(i,j,bi,bj) = 0.d0 |
18377 |
adetan(i,j,bi,bj) = adetan(i,j,bi,bj)+adetanm1(i,j,bi,bj) |
18378 |
adetanm1(i,j,bi,bj) = 0.d0 |
18379 |
end do |
18380 |
end do |
18381 |
end do |
18382 |
end do |
18383 |
|
18384 |
end |
18385 |
|
18386 |
|
18387 |
subroutine adstatekpp( bi, bj, adrho1, addbloc, addbsfc, |
18388 |
$adttalpha, adssbeta ) |
18389 |
C*************************************************************** |
18390 |
C*************************************************************** |
18391 |
C** This routine was generated by the ** |
18392 |
C** Tangent linear and Adjoint Model Compiler, TAMC 5.2.14 ** |
18393 |
C*************************************************************** |
18394 |
C*************************************************************** |
18395 |
C============================================== |
18396 |
C all entries are defined explicitly |
18397 |
C============================================== |
18398 |
implicit none |
18399 |
|
18400 |
C============================================== |
18401 |
C define parameters |
18402 |
C============================================== |
18403 |
integer olx |
18404 |
parameter ( olx = 3 ) |
18405 |
integer ibot |
18406 |
parameter ( ibot = 1-olx ) |
18407 |
integer snx |
18408 |
parameter ( snx = 20 ) |
18409 |
integer itop |
18410 |
parameter ( itop = snx+olx ) |
18411 |
integer oly |
18412 |
parameter ( oly = 3 ) |
18413 |
integer jbot |
18414 |
parameter ( jbot = 1-oly ) |
18415 |
integer sny |
18416 |
parameter ( sny = 40 ) |
18417 |
integer jtop |
18418 |
parameter ( jtop = sny+oly ) |
18419 |
integer npx |
18420 |
parameter ( npx = 1 ) |
18421 |
integer npy |
18422 |
parameter ( npy = 1 ) |
18423 |
integer nr |
18424 |
parameter ( nr = 15 ) |
18425 |
integer nrp1 |
18426 |
parameter ( nrp1 = nr+1 ) |
18427 |
integer nsx |
18428 |
parameter ( nsx = 1 ) |
18429 |
integer nsy |
18430 |
parameter ( nsy = 1 ) |
18431 |
integer nx |
18432 |
parameter ( nx = snx*nsx*npx ) |
18433 |
integer ny |
18434 |
parameter ( ny = sny*nsy*npy ) |
18435 |
|
18436 |
C============================================== |
18437 |
C define common blocks |
18438 |
C============================================== |
18439 |
common /addynvars_r/ adetan, aduvel, advvel, adwvel, adtheta, |
18440 |
$adsalt, adgu, adgv, adgt, adgs, adgunm1, adgvnm1, adgtnm1, adgsnm1 |
18441 |
double precision adetan(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
18442 |
double precision adgs(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
18443 |
double precision adgsnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
18444 |
double precision adgt(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
18445 |
double precision adgtnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
18446 |
double precision adgu(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
18447 |
double precision adgunm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
18448 |
double precision adgv(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
18449 |
double precision adgvnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
18450 |
double precision adsalt(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
18451 |
double precision adtheta(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
18452 |
double precision aduvel(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
18453 |
double precision advvel(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
18454 |
double precision adwvel(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
18455 |
|
18456 |
common /dynvars_r/ etan, uvel, vvel, wvel, theta, salt, gu, gv, |
18457 |
$gt, gs, gunm1, gvnm1, gtnm1, gsnm1 |
18458 |
double precision etan(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
18459 |
double precision gs(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
18460 |
double precision gsnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
18461 |
double precision gt(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
18462 |
double precision gtnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
18463 |
double precision gu(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
18464 |
double precision gunm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
18465 |
double precision gv(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
18466 |
double precision gvnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
18467 |
double precision salt(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
18468 |
double precision theta(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
18469 |
double precision uvel(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
18470 |
double precision vvel(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
18471 |
double precision wvel(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
18472 |
|
18473 |
common /parm_eos_lin/ talpha, sbeta, eostype |
18474 |
character*(6) eostype |
18475 |
double precision sbeta |
18476 |
double precision talpha |
18477 |
|
18478 |
common /parm_r/ cg2dtargetresidual, cg2dpcoffdfac, |
18479 |
$cg3dtargetresidual, delp, delz, delr, delx, dely, deltat, |
18480 |
$deltatmom, deltattracer, deltatclock, abeps, starttime, phimin, |
18481 |
$thetamin, rsphere, recip_rsphere, f0, fcori, beta, viscah, viscaz, |
18482 |
$ visca4, viscar, diffkht, diffkzt, diffk4t, diffkrt, diffkhs, |
18483 |
$diffkzs, diffk4s, diffkrs, delt, taucd, rcd, freesurffac, |
18484 |
$implicsurfpress, implicdiv2dflow, hfacmin, hfacmindz, gravity, |
18485 |
$recip_gravity, gbaro, rhonil, recip_rhonil, recip_rhoconst, |
18486 |
$rhoconst, tref, sref, endtime, chkptfreq, pchkptfreq, dumpfreq, |
18487 |
$tavefreq, affacmom, vffacmom, pffacmom, cffacmom, fofacmom, |
18488 |
$mtfacmom, cospower, cadjfreq, omega, tauthetaclimrelax, |
18489 |
$lambdathetaclimrelax, tausaltclimrelax, lambdasaltclimrelax, |
18490 |
$externforcingcycle, externforcingperiod, viscap, diffkpt, diffkps, |
18491 |
$ hfacmindr, hfacmindp, theta_s, specvol_s, horivertratio, |
18492 |
$recip_horivertratio, latfftfiltlo, ivdc_kappa, ro_sealevel, |
18493 |
$zonal_filt_lat, bottomdraglinear, bottomdragquadratic |
18494 |
double precision abeps |
18495 |
double precision affacmom |
18496 |
double precision beta |
18497 |
double precision bottomdraglinear |
18498 |
double precision bottomdragquadratic |
18499 |
double precision cadjfreq |
18500 |
double precision cffacmom |
18501 |
double precision cg2dpcoffdfac |
18502 |
double precision cg2dtargetresidual |
18503 |
double precision cg3dtargetresidual |
18504 |
double precision chkptfreq |
18505 |
double precision cospower |
18506 |
double precision delp(nr) |
18507 |
double precision delr(nr) |
18508 |
double precision delt |
18509 |
double precision deltat |
18510 |
double precision deltatclock |
18511 |
double precision deltatmom |
18512 |
double precision deltattracer |
18513 |
double precision delx(nx) |
18514 |
double precision dely(ny) |
18515 |
double precision delz(nr) |
18516 |
double precision diffk4s |
18517 |
double precision diffk4t |
18518 |
double precision diffkhs |
18519 |
double precision diffkht |
18520 |
double precision diffkps |
18521 |
double precision diffkpt |
18522 |
double precision diffkrs |
18523 |
double precision diffkrt |
18524 |
double precision diffkzs |
18525 |
double precision diffkzt |
18526 |
double precision dumpfreq |
18527 |
double precision endtime |
18528 |
double precision externforcingcycle |
18529 |
double precision externforcingperiod |
18530 |
double precision f0 |
18531 |
double precision fcori(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
18532 |
double precision fofacmom |
18533 |
double precision freesurffac |
18534 |
double precision gbaro |
18535 |
double precision gravity |
18536 |
double precision hfacmin |
18537 |
double precision hfacmindp |
18538 |
double precision hfacmindr |
18539 |
double precision hfacmindz |
18540 |
double precision horivertratio |
18541 |
double precision implicdiv2dflow |
18542 |
double precision implicsurfpress |
18543 |
double precision ivdc_kappa |
18544 |
double precision lambdasaltclimrelax |
18545 |
double precision lambdathetaclimrelax |
18546 |
double precision latfftfiltlo |
18547 |
double precision mtfacmom |
18548 |
double precision omega |
18549 |
double precision pchkptfreq |
18550 |
double precision pffacmom |
18551 |
double precision phimin |
18552 |
double precision rcd |
18553 |
double precision recip_gravity |
18554 |
double precision recip_horivertratio |
18555 |
double precision recip_rhoconst |
18556 |
double precision recip_rhonil |
18557 |
double precision recip_rsphere |
18558 |
double precision rhoconst |
18559 |
double precision rhonil |
18560 |
double precision ro_sealevel |
18561 |
double precision rsphere |
18562 |
double precision specvol_s(nr) |
18563 |
double precision sref(nr) |
18564 |
double precision starttime |
18565 |
double precision taucd |
18566 |
double precision tausaltclimrelax |
18567 |
double precision tauthetaclimrelax |
18568 |
double precision tavefreq |
18569 |
double precision theta_s(nr) |
18570 |
double precision thetamin |
18571 |
double precision tref(nr) |
18572 |
double precision vffacmom |
18573 |
double precision visca4 |
18574 |
double precision viscah |
18575 |
double precision viscap |
18576 |
double precision viscar |
18577 |
double precision viscaz |
18578 |
double precision zonal_filt_lat |
18579 |
|
18580 |
C============================================== |
18581 |
C define arguments |
18582 |
C============================================== |
18583 |
double precision addbloc(ibot:itop,jbot:jtop,nr) |
18584 |
double precision addbsfc(ibot:itop,jbot:jtop,nr) |
18585 |
double precision adrho1(ibot:itop,jbot:jtop) |
18586 |
double precision adssbeta(ibot:itop,jbot:jtop,nrp1) |
18587 |
double precision adttalpha(ibot:itop,jbot:jtop,nrp1) |
18588 |
integer bi |
18589 |
integer bj |
18590 |
|
18591 |
C============================================== |
18592 |
C define local variables |
18593 |
C============================================== |
18594 |
double precision adrho1k(1-olx:snx+olx,1-oly:sny+oly) |
18595 |
double precision adrhok(1-olx:snx+olx,1-oly:sny+oly) |
18596 |
double precision adrhokm1(1-olx:snx+olx,1-oly:sny+oly) |
18597 |
double precision adwork1(1-olx:snx+olx,1-oly:sny+oly) |
18598 |
double precision adwork2(1-olx:snx+olx,1-oly:sny+oly) |
18599 |
double precision adwork3(1-olx:snx+olx,1-oly:sny+oly) |
18600 |
integer help_h |
18601 |
integer i |
18602 |
integer ip1 |
18603 |
integer ip2 |
18604 |
integer j |
18605 |
integer k |
18606 |
integer mythid |
18607 |
double precision rho1k(1-olx:snx+olx,1-oly:sny+oly) |
18608 |
double precision rhok(1-olx:snx+olx,1-oly:sny+oly) |
18609 |
double precision rhokm1(1-olx:snx+olx,1-oly:sny+oly) |
18610 |
|
18611 |
C---------------------------------------------- |
18612 |
C RESET LOCAL ADJOINT VARIABLES |
18613 |
C---------------------------------------------- |
18614 |
do ip2 = 1-oly, sny+oly |
18615 |
do ip1 = 1-olx, snx+olx |
18616 |
adrho1k(ip1,ip2) = 0.d0 |
18617 |
end do |
18618 |
end do |
18619 |
do ip2 = 1-oly, sny+oly |
18620 |
do ip1 = 1-olx, snx+olx |
18621 |
adrhok(ip1,ip2) = 0.d0 |
18622 |
end do |
18623 |
end do |
18624 |
do ip2 = 1-oly, sny+oly |
18625 |
do ip1 = 1-olx, snx+olx |
18626 |
adrhokm1(ip1,ip2) = 0.d0 |
18627 |
end do |
18628 |
end do |
18629 |
do ip2 = 1-oly, sny+oly |
18630 |
do ip1 = 1-olx, snx+olx |
18631 |
adwork1(ip1,ip2) = 0.d0 |
18632 |
end do |
18633 |
end do |
18634 |
do ip2 = 1-oly, sny+oly |
18635 |
do ip1 = 1-olx, snx+olx |
18636 |
adwork2(ip1,ip2) = 0.d0 |
18637 |
end do |
18638 |
end do |
18639 |
do ip2 = 1-oly, sny+oly |
18640 |
do ip1 = 1-olx, snx+olx |
18641 |
adwork3(ip1,ip2) = 0.d0 |
18642 |
end do |
18643 |
end do |
18644 |
|
18645 |
C---------------------------------------------- |
18646 |
C ROUTINE BODY |
18647 |
C---------------------------------------------- |
18648 |
do j = jbot, jtop |
18649 |
do i = ibot, itop |
18650 |
addbloc(i,j,nr) = 0.d0 |
18651 |
adssbeta(i,j,nr) = adssbeta(i,j,nr)+adssbeta(i,j,nrp1) |
18652 |
adssbeta(i,j,nrp1) = 0.d0 |
18653 |
adttalpha(i,j,nr) = adttalpha(i,j,nr)+adttalpha(i,j,nrp1) |
18654 |
adttalpha(i,j,nrp1) = 0.d0 |
18655 |
end do |
18656 |
end do |
18657 |
do k = 2, nr |
18658 |
do ip2 = 1-oly, sny+oly |
18659 |
do ip1 = 1-olx, snx+olx |
18660 |
adrho1k(ip1,ip2) = 0.d0 |
18661 |
end do |
18662 |
end do |
18663 |
do ip2 = 1-oly, sny+oly |
18664 |
do ip1 = 1-olx, snx+olx |
18665 |
adrhok(ip1,ip2) = 0.d0 |
18666 |
end do |
18667 |
end do |
18668 |
do ip2 = 1-oly, sny+oly |
18669 |
do ip1 = 1-olx, snx+olx |
18670 |
adrhokm1(ip1,ip2) = 0.d0 |
18671 |
end do |
18672 |
end do |
18673 |
do ip2 = 1-oly, sny+oly |
18674 |
do ip1 = 1-olx, snx+olx |
18675 |
adwork1(ip1,ip2) = 0.d0 |
18676 |
end do |
18677 |
end do |
18678 |
do ip2 = 1-oly, sny+oly |
18679 |
do ip1 = 1-olx, snx+olx |
18680 |
adwork2(ip1,ip2) = 0.d0 |
18681 |
end do |
18682 |
end do |
18683 |
call find_rho( bi,bj,ibot,itop,jbot,jtop,k,k,eostype,theta,salt, |
18684 |
$rhok,mythid ) |
18685 |
help_h = k-1 |
18686 |
call find_rho( bi,bj,ibot,itop,jbot,jtop,help_h,k,eostype,theta, |
18687 |
$salt,rhokm1,mythid ) |
18688 |
call find_rho( bi,bj,ibot,itop,jbot,jtop,1,k,eostype,theta,salt, |
18689 |
$rho1k,mythid ) |
18690 |
do j = jbot, jtop |
18691 |
do i = ibot, itop |
18692 |
adrho1k(i,j) = adrho1k(i,j)-addbsfc(i,j,k)*(gravity/(rhok(i, |
18693 |
$j)+rhonil)) |
18694 |
adrhok(i,j) = adrhok(i,j)+addbsfc(i,j,k)*(gravity/(rhok(i,j) |
18695 |
$+rhonil)-gravity*(rhok(i,j)-rho1k(i,j))/((rhok(i,j)+rhonil)* |
18696 |
$(rhok(i,j)+rhonil))) |
18697 |
addbsfc(i,j,k) = 0.d0 |
18698 |
adrhok(i,j) = adrhok(i,j)+addbloc(i,j,k-1)*(gravity/(rhok(i, |
18699 |
$j)+rhonil)-gravity*(rhok(i,j)-rhokm1(i,j))/((rhok(i,j)+rhonil)* |
18700 |
$(rhok(i,j)+rhonil))) |
18701 |
adrhokm1(i,j) = adrhokm1(i,j)-addbloc(i,j,k-1)*(gravity/ |
18702 |
$(rhok(i,j)+rhonil)) |
18703 |
addbloc(i,j,k-1) = 0.d0 |
18704 |
adwork2(i,j) = adwork2(i,j)+adssbeta(i,j,k) |
18705 |
adssbeta(i,j,k) = 0.d0 |
18706 |
adwork1(i,j) = adwork1(i,j)+adttalpha(i,j,k) |
18707 |
adttalpha(i,j,k) = 0.d0 |
18708 |
end do |
18709 |
end do |
18710 |
call adfind_beta( bi,bj,ibot,itop,jbot,jtop,k,k,eostype,adwork2 |
18711 |
$) |
18712 |
call adfind_alpha( bi,bj,ibot,itop,jbot,jtop,k,k,eostype, |
18713 |
$adwork1 ) |
18714 |
call adfind_rho( bi,bj,ibot,itop,jbot,jtop,1,k,eostype,theta, |
18715 |
$salt,adtheta,adsalt,adrho1k ) |
18716 |
call adfind_rho( bi,bj,ibot,itop,jbot,jtop,help_h,k,eostype, |
18717 |
$theta,salt,adtheta,adsalt,adrhokm1 ) |
18718 |
call adfind_rho( bi,bj,ibot,itop,jbot,jtop,k,k,eostype,theta, |
18719 |
$salt,adtheta,adsalt,adrhok ) |
18720 |
end do |
18721 |
do j = jbot, jtop |
18722 |
do i = ibot, itop |
18723 |
adwork3(i,j) = adwork3(i,j)+adssbeta(i,j,1) |
18724 |
adssbeta(i,j,1) = 0.d0 |
18725 |
adwork2(i,j) = adwork2(i,j)+adttalpha(i,j,1) |
18726 |
adttalpha(i,j,1) = 0.d0 |
18727 |
adwork1(i,j) = adwork1(i,j)+adrho1(i,j) |
18728 |
adrho1(i,j) = 0.d0 |
18729 |
end do |
18730 |
end do |
18731 |
call adfind_beta( bi,bj,ibot,itop,jbot,jtop,1,1,eostype,adwork3 ) |
18732 |
call adfind_alpha( bi,bj,ibot,itop,jbot,jtop,1,1,eostype,adwork2 ) |
18733 |
call adfind_rho( bi,bj,ibot,itop,jbot,jtop,1,1,eostype,theta,salt, |
18734 |
$adtheta,adsalt,adwork1 ) |
18735 |
|
18736 |
end |
18737 |
|
18738 |
|
18739 |
subroutine adswfrac( imax, fact, swdk, adswdk ) |
18740 |
C*************************************************************** |
18741 |
C*************************************************************** |
18742 |
C** This routine was generated by the ** |
18743 |
C** Tangent linear and Adjoint Model Compiler, TAMC 5.2.14 ** |
18744 |
C*************************************************************** |
18745 |
C*************************************************************** |
18746 |
C============================================== |
18747 |
C all entries are defined explicitly |
18748 |
C============================================== |
18749 |
implicit none |
18750 |
|
18751 |
C============================================== |
18752 |
C define parameters |
18753 |
C============================================== |
18754 |
integer nwtype |
18755 |
parameter ( nwtype = 5 ) |
18756 |
|
18757 |
C============================================== |
18758 |
C define common blocks |
18759 |
C============================================== |
18760 |
C============================================== |
18761 |
C define arguments |
18762 |
C============================================== |
18763 |
integer imax |
18764 |
double precision adswdk(imax) |
18765 |
double precision fact |
18766 |
double precision swdk(imax) |
18767 |
|
18768 |
C============================================== |
18769 |
C define local variables |
18770 |
C============================================== |
18771 |
double precision a1(nwtype) |
18772 |
double precision a2(nwtype) |
18773 |
double precision adfacz |
18774 |
double precision facz |
18775 |
integer i |
18776 |
integer jwtype |
18777 |
double precision rfac(nwtype) |
18778 |
|
18779 |
C============================================== |
18780 |
C define data |
18781 |
C============================================== |
18782 |
data rfac/0.58,0.62,0.67,0.77,0.78/ |
18783 |
data a1/0.35,0.6,1.0,1.5,1.4/ |
18784 |
data a2/23.0,20.0,17.0,14.0,7.9/ |
18785 |
|
18786 |
C---------------------------------------------- |
18787 |
C RESET LOCAL ADJOINT VARIABLES |
18788 |
C---------------------------------------------- |
18789 |
adfacz = 0.d0 |
18790 |
|
18791 |
C---------------------------------------------- |
18792 |
C ROUTINE BODY |
18793 |
C---------------------------------------------- |
18794 |
jwtype = 2 |
18795 |
do i = 1, imax |
18796 |
adfacz = 0.d0 |
18797 |
facz = fact*swdk(i) |
18798 |
if (facz .lt. (-200.)) then |
18799 |
adswdk(i) = 0.d0 |
18800 |
else |
18801 |
adfacz = adfacz+adswdk(i)*(rfac(jwtype)/a1(jwtype)*exp(facz/ |
18802 |
$a1(jwtype))+(1.-rfac(jwtype))/a2(jwtype)*exp(facz/a2(jwtype))) |
18803 |
adswdk(i) = 0.d0 |
18804 |
endif |
18805 |
adswdk(i) = adswdk(i)+adfacz*fact |
18806 |
adfacz = 0.d0 |
18807 |
end do |
18808 |
|
18809 |
end |
18810 |
|
18811 |
|
18812 |
subroutine mdthe_correction_step( mytime, myiter, mythid ) |
18813 |
C*************************************************************** |
18814 |
C*************************************************************** |
18815 |
C** This routine was generated by the ** |
18816 |
C** Tangent linear and Adjoint Model Compiler, TAMC 5.2.14 ** |
18817 |
C*************************************************************** |
18818 |
C*************************************************************** |
18819 |
C============================================== |
18820 |
C all entries are defined explicitly |
18821 |
C============================================== |
18822 |
implicit none |
18823 |
|
18824 |
C============================================== |
18825 |
C define parameters |
18826 |
C============================================== |
18827 |
integer max_no_threads |
18828 |
parameter ( max_no_threads = 32 ) |
18829 |
integer nr |
18830 |
parameter ( nr = 15 ) |
18831 |
integer nsx |
18832 |
parameter ( nsx = 1 ) |
18833 |
integer nsy |
18834 |
parameter ( nsy = 1 ) |
18835 |
integer olx |
18836 |
parameter ( olx = 3 ) |
18837 |
integer oly |
18838 |
parameter ( oly = 3 ) |
18839 |
integer snx |
18840 |
parameter ( snx = 20 ) |
18841 |
integer sny |
18842 |
parameter ( sny = 40 ) |
18843 |
|
18844 |
C============================================== |
18845 |
C define common blocks |
18846 |
C============================================== |
18847 |
common /dynvars_r/ etan, uvel, vvel, wvel, theta, salt, gu, gv, |
18848 |
$gt, gs, gunm1, gvnm1, gtnm1, gsnm1 |
18849 |
double precision etan(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
18850 |
double precision gs(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
18851 |
double precision gsnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
18852 |
double precision gt(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
18853 |
double precision gtnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
18854 |
double precision gu(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
18855 |
double precision gunm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
18856 |
double precision gv(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
18857 |
double precision gvnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
18858 |
double precision salt(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
18859 |
double precision theta(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
18860 |
double precision uvel(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
18861 |
double precision vvel(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
18862 |
double precision wvel(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
18863 |
|
18864 |
common /eeparams_i/ errormessageunit, standardmessageunit, |
18865 |
$scrunit1, scrunit2, eedataunit, modeldataunit, numberofprocs, |
18866 |
$pidio, myprocid, mypx, mypy, myxgloballo, myygloballo, nthreads, |
18867 |
$mybxlo, mybxhi, mybylo, mybyhi, ntx, nty, ioerrorcount |
18868 |
integer eedataunit |
18869 |
integer errormessageunit |
18870 |
integer ioerrorcount(max_no_threads) |
18871 |
integer modeldataunit |
18872 |
integer mybxhi(max_no_threads) |
18873 |
integer mybxlo(max_no_threads) |
18874 |
integer mybyhi(max_no_threads) |
18875 |
integer mybylo(max_no_threads) |
18876 |
integer myprocid |
18877 |
integer mypx |
18878 |
integer mypy |
18879 |
integer myxgloballo |
18880 |
integer myygloballo |
18881 |
integer nthreads |
18882 |
integer ntx |
18883 |
integer nty |
18884 |
integer numberofprocs |
18885 |
integer pidio |
18886 |
integer scrunit1 |
18887 |
integer scrunit2 |
18888 |
integer standardmessageunit |
18889 |
|
18890 |
common /parm_l/ usingcartesiangrid, usingsphericalpolargrid, |
18891 |
$no_slip_sides, no_slip_bottom, staggertimestep, momviscosity, |
18892 |
$momadvection, momforcing, usecoriolis, mompressureforcing, |
18893 |
$tempdiffusion, tempadvection, tempforcing, saltdiffusion, |
18894 |
$saltadvection, saltforcing, implicitfreesurface, rigidlid, |
18895 |
$momstepping, tempstepping, saltstepping, metricterms, |
18896 |
$usingsphericalpolarmterms, useconstantf, usebetaplanef, |
18897 |
$usespheref, implicitdiffusion, implicitviscosity, |
18898 |
$dothetaclimrelax, dosaltclimrelax, periodicexternalforcing, |
18899 |
$usingpcoords, usingzcoords, nonhydrostatic, globalfiles, |
18900 |
$allowfreezing, groundatk1, usepickupbeforec35 |
18901 |
logical allowfreezing |
18902 |
logical dosaltclimrelax |
18903 |
logical dothetaclimrelax |
18904 |
logical globalfiles |
18905 |
logical groundatk1 |
18906 |
logical implicitdiffusion |
18907 |
logical implicitfreesurface |
18908 |
logical implicitviscosity |
18909 |
logical metricterms |
18910 |
logical momadvection |
18911 |
logical momforcing |
18912 |
logical mompressureforcing |
18913 |
logical momstepping |
18914 |
logical momviscosity |
18915 |
logical no_slip_bottom |
18916 |
logical no_slip_sides |
18917 |
logical nonhydrostatic |
18918 |
logical periodicexternalforcing |
18919 |
logical rigidlid |
18920 |
logical saltadvection |
18921 |
logical saltdiffusion |
18922 |
logical saltforcing |
18923 |
logical saltstepping |
18924 |
logical staggertimestep |
18925 |
logical tempadvection |
18926 |
logical tempdiffusion |
18927 |
logical tempforcing |
18928 |
logical tempstepping |
18929 |
logical usebetaplanef |
18930 |
logical useconstantf |
18931 |
logical usecoriolis |
18932 |
logical usepickupbeforec35 |
18933 |
logical usespheref |
18934 |
logical usingcartesiangrid |
18935 |
logical usingpcoords |
18936 |
logical usingsphericalpolargrid |
18937 |
logical usingsphericalpolarmterms |
18938 |
logical usingzcoords |
18939 |
|
18940 |
C============================================== |
18941 |
C define arguments |
18942 |
C============================================== |
18943 |
integer myiter |
18944 |
integer mythid |
18945 |
double precision mytime |
18946 |
|
18947 |
C============================================== |
18948 |
C define local variables |
18949 |
C============================================== |
18950 |
integer bi |
18951 |
integer bj |
18952 |
integer imax |
18953 |
integer imin |
18954 |
integer jmax |
18955 |
integer jmin |
18956 |
integer k |
18957 |
double precision phisurfx(1-olx:snx+olx,1-oly:sny+oly) |
18958 |
double precision phisurfy(1-olx:snx+olx,1-oly:sny+oly) |
18959 |
|
18960 |
C********************************************** |
18961 |
C executable statements of routine |
18962 |
C********************************************** |
18963 |
do bj = mybylo(mythid), mybyhi(mythid) |
18964 |
do bi = mybxlo(mythid), mybxhi(mythid) |
18965 |
imin = 1-olx+1 |
18966 |
imax = snx+olx |
18967 |
jmin = 1-oly+1 |
18968 |
jmax = sny+oly |
18969 |
call calc_grad_phi_surf( bi,bj,imin,imax,jmin,jmax,etan, |
18970 |
$phisurfx,phisurfy,mythid ) |
18971 |
do k = 1, nr |
18972 |
if (momstepping) then |
18973 |
call correction_step( bi,bj,imin,imax,jmin,jmax,k, |
18974 |
$phisurfx,phisurfy,mytime,mythid ) |
18975 |
endif |
18976 |
if (tempstepping) then |
18977 |
call cycle_tracer( bi,bj,imin,imax,jmin,jmax,k,theta,gt, |
18978 |
$gtnm1,mytime,mythid ) |
18979 |
endif |
18980 |
if (saltstepping) then |
18981 |
call cycle_tracer( bi,bj,imin,imax,jmin,jmax,k,salt,gs, |
18982 |
$gsnm1,mytime,mythid ) |
18983 |
endif |
18984 |
end do |
18985 |
call mdconvective_adjustment( bi,bj,imin,imax,jmin,jmax, |
18986 |
$mytime,myiter,mythid ) |
18987 |
end do |
18988 |
end do |
18989 |
end |
18990 |
|
18991 |
|
18992 |
subroutine adthe_correction_step( mytime, mythid ) |
18993 |
C*************************************************************** |
18994 |
C*************************************************************** |
18995 |
C** This routine was generated by the ** |
18996 |
C** Tangent linear and Adjoint Model Compiler, TAMC 5.2.14 ** |
18997 |
C*************************************************************** |
18998 |
C*************************************************************** |
18999 |
C============================================== |
19000 |
C all entries are defined explicitly |
19001 |
C============================================== |
19002 |
implicit none |
19003 |
|
19004 |
C============================================== |
19005 |
C define parameters |
19006 |
C============================================== |
19007 |
integer max_no_threads |
19008 |
parameter ( max_no_threads = 32 ) |
19009 |
integer nr |
19010 |
parameter ( nr = 15 ) |
19011 |
integer nsx |
19012 |
parameter ( nsx = 1 ) |
19013 |
integer nsy |
19014 |
parameter ( nsy = 1 ) |
19015 |
integer olx |
19016 |
parameter ( olx = 3 ) |
19017 |
integer oly |
19018 |
parameter ( oly = 3 ) |
19019 |
integer snx |
19020 |
parameter ( snx = 20 ) |
19021 |
integer sny |
19022 |
parameter ( sny = 40 ) |
19023 |
|
19024 |
C============================================== |
19025 |
C define common blocks |
19026 |
C============================================== |
19027 |
common /addynvars_r/ adetan, aduvel, advvel, adwvel, adtheta, |
19028 |
$adsalt, adgu, adgv, adgt, adgs, adgunm1, adgvnm1, adgtnm1, adgsnm1 |
19029 |
double precision adetan(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
19030 |
double precision adgs(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
19031 |
double precision adgsnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
19032 |
double precision adgt(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
19033 |
double precision adgtnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
19034 |
double precision adgu(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
19035 |
double precision adgunm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
19036 |
double precision adgv(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
19037 |
double precision adgvnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
19038 |
double precision adsalt(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
19039 |
double precision adtheta(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
19040 |
double precision aduvel(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
19041 |
double precision advvel(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
19042 |
double precision adwvel(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
19043 |
|
19044 |
common /eeparams_i/ errormessageunit, standardmessageunit, |
19045 |
$scrunit1, scrunit2, eedataunit, modeldataunit, numberofprocs, |
19046 |
$pidio, myprocid, mypx, mypy, myxgloballo, myygloballo, nthreads, |
19047 |
$mybxlo, mybxhi, mybylo, mybyhi, ntx, nty, ioerrorcount |
19048 |
integer eedataunit |
19049 |
integer errormessageunit |
19050 |
integer ioerrorcount(max_no_threads) |
19051 |
integer modeldataunit |
19052 |
integer mybxhi(max_no_threads) |
19053 |
integer mybxlo(max_no_threads) |
19054 |
integer mybyhi(max_no_threads) |
19055 |
integer mybylo(max_no_threads) |
19056 |
integer myprocid |
19057 |
integer mypx |
19058 |
integer mypy |
19059 |
integer myxgloballo |
19060 |
integer myygloballo |
19061 |
integer nthreads |
19062 |
integer ntx |
19063 |
integer nty |
19064 |
integer numberofprocs |
19065 |
integer pidio |
19066 |
integer scrunit1 |
19067 |
integer scrunit2 |
19068 |
integer standardmessageunit |
19069 |
|
19070 |
common /parm_l/ usingcartesiangrid, usingsphericalpolargrid, |
19071 |
$no_slip_sides, no_slip_bottom, staggertimestep, momviscosity, |
19072 |
$momadvection, momforcing, usecoriolis, mompressureforcing, |
19073 |
$tempdiffusion, tempadvection, tempforcing, saltdiffusion, |
19074 |
$saltadvection, saltforcing, implicitfreesurface, rigidlid, |
19075 |
$momstepping, tempstepping, saltstepping, metricterms, |
19076 |
$usingsphericalpolarmterms, useconstantf, usebetaplanef, |
19077 |
$usespheref, implicitdiffusion, implicitviscosity, |
19078 |
$dothetaclimrelax, dosaltclimrelax, periodicexternalforcing, |
19079 |
$usingpcoords, usingzcoords, nonhydrostatic, globalfiles, |
19080 |
$allowfreezing, groundatk1, usepickupbeforec35 |
19081 |
logical allowfreezing |
19082 |
logical dosaltclimrelax |
19083 |
logical dothetaclimrelax |
19084 |
logical globalfiles |
19085 |
logical groundatk1 |
19086 |
logical implicitdiffusion |
19087 |
logical implicitfreesurface |
19088 |
logical implicitviscosity |
19089 |
logical metricterms |
19090 |
logical momadvection |
19091 |
logical momforcing |
19092 |
logical mompressureforcing |
19093 |
logical momstepping |
19094 |
logical momviscosity |
19095 |
logical no_slip_bottom |
19096 |
logical no_slip_sides |
19097 |
logical nonhydrostatic |
19098 |
logical periodicexternalforcing |
19099 |
logical rigidlid |
19100 |
logical saltadvection |
19101 |
logical saltdiffusion |
19102 |
logical saltforcing |
19103 |
logical saltstepping |
19104 |
logical staggertimestep |
19105 |
logical tempadvection |
19106 |
logical tempdiffusion |
19107 |
logical tempforcing |
19108 |
logical tempstepping |
19109 |
logical usebetaplanef |
19110 |
logical useconstantf |
19111 |
logical usecoriolis |
19112 |
logical usepickupbeforec35 |
19113 |
logical usespheref |
19114 |
logical usingcartesiangrid |
19115 |
logical usingpcoords |
19116 |
logical usingsphericalpolargrid |
19117 |
logical usingsphericalpolarmterms |
19118 |
logical usingzcoords |
19119 |
|
19120 |
C============================================== |
19121 |
C define arguments |
19122 |
C============================================== |
19123 |
integer mythid |
19124 |
double precision mytime |
19125 |
|
19126 |
C============================================== |
19127 |
C define local variables |
19128 |
C============================================== |
19129 |
double precision adphisurfx(1-olx:snx+olx,1-oly:sny+oly) |
19130 |
double precision adphisurfy(1-olx:snx+olx,1-oly:sny+oly) |
19131 |
integer bi |
19132 |
integer bj |
19133 |
integer imax |
19134 |
integer imin |
19135 |
integer ip1 |
19136 |
integer ip2 |
19137 |
integer jmax |
19138 |
integer jmin |
19139 |
integer k |
19140 |
|
19141 |
C---------------------------------------------- |
19142 |
C RESET LOCAL ADJOINT VARIABLES |
19143 |
C---------------------------------------------- |
19144 |
do ip2 = 1-oly, sny+oly |
19145 |
do ip1 = 1-olx, snx+olx |
19146 |
adphisurfx(ip1,ip2) = 0.d0 |
19147 |
end do |
19148 |
end do |
19149 |
do ip2 = 1-oly, sny+oly |
19150 |
do ip1 = 1-olx, snx+olx |
19151 |
adphisurfy(ip1,ip2) = 0.d0 |
19152 |
end do |
19153 |
end do |
19154 |
|
19155 |
C---------------------------------------------- |
19156 |
C ROUTINE BODY |
19157 |
C---------------------------------------------- |
19158 |
do bj = mybyhi(mythid), mybylo(mythid), -1 |
19159 |
do bi = mybxhi(mythid), mybxlo(mythid), -1 |
19160 |
imin = 1-olx+1 |
19161 |
imax = snx+olx |
19162 |
jmin = 1-oly+1 |
19163 |
jmax = sny+oly |
19164 |
call adconvective_adjustment( bi,bj,imin,imax,jmin,jmax, |
19165 |
$mytime,mythid ) |
19166 |
do k = nr, 1, -1 |
19167 |
if (saltstepping) then |
19168 |
call adcycle_tracer( bi,bj,imin,imax,jmin,jmax,k,adsalt, |
19169 |
$adgs,adgsnm1 ) |
19170 |
endif |
19171 |
if (tempstepping) then |
19172 |
call adcycle_tracer( bi,bj,imin,imax,jmin,jmax,k,adtheta, |
19173 |
$adgt,adgtnm1 ) |
19174 |
endif |
19175 |
if (momstepping) then |
19176 |
call adcorrection_step( bi,bj,imin,imax,jmin,jmax,k, |
19177 |
$adphisurfx,adphisurfy ) |
19178 |
endif |
19179 |
end do |
19180 |
call adcalc_grad_phi_surf( bi,bj,imin,imax,jmin,jmax,adetan, |
19181 |
$adphisurfx,adphisurfy ) |
19182 |
end do |
19183 |
end do |
19184 |
|
19185 |
end |
19186 |
|
19187 |
|
19188 |
subroutine adthe_main_loop( mythid ) |
19189 |
C*************************************************************** |
19190 |
C*************************************************************** |
19191 |
C** This routine was generated by the ** |
19192 |
C** Tangent linear and Adjoint Model Compiler, TAMC 5.2.14 ** |
19193 |
C*************************************************************** |
19194 |
C*************************************************************** |
19195 |
C============================================== |
19196 |
C all entries are defined explicitly |
19197 |
C============================================== |
19198 |
implicit none |
19199 |
|
19200 |
C============================================== |
19201 |
C define parameters |
19202 |
C============================================== |
19203 |
integer nchklev_1 |
19204 |
parameter ( nchklev_1 = 36 ) |
19205 |
integer nchklev_2 |
19206 |
parameter ( nchklev_2 = 30 ) |
19207 |
integer nchklev_3 |
19208 |
parameter ( nchklev_3 = 60 ) |
19209 |
integer npx |
19210 |
parameter ( npx = 1 ) |
19211 |
integer npy |
19212 |
parameter ( npy = 1 ) |
19213 |
integer nr |
19214 |
parameter ( nr = 15 ) |
19215 |
integer nsx |
19216 |
parameter ( nsx = 1 ) |
19217 |
integer nsy |
19218 |
parameter ( nsy = 1 ) |
19219 |
integer snx |
19220 |
parameter ( snx = 20 ) |
19221 |
integer nx |
19222 |
parameter ( nx = snx*nsx*npx ) |
19223 |
integer sny |
19224 |
parameter ( sny = 40 ) |
19225 |
integer ny |
19226 |
parameter ( ny = sny*nsy*npy ) |
19227 |
integer olx |
19228 |
parameter ( olx = 3 ) |
19229 |
integer oly |
19230 |
parameter ( oly = 3 ) |
19231 |
|
19232 |
C============================================== |
19233 |
C define common blocks |
19234 |
C============================================== |
19235 |
common /cost_r/ fc, objf_hflux, objf_sflux, objf_tauu, objf_tauv, |
19236 |
$objf_hmean, objf_h, objf_temp, objf_salt, objf_sst, objf_atl, |
19237 |
$objf_ctdt, objf_ctds, objf_test |
19238 |
double precision fc |
19239 |
double precision objf_atl(nsx,nsy) |
19240 |
double precision objf_ctds(nsx,nsy) |
19241 |
double precision objf_ctdt(nsx,nsy) |
19242 |
double precision objf_h(nsx,nsy) |
19243 |
double precision objf_hflux(nsx,nsy) |
19244 |
double precision objf_hmean |
19245 |
double precision objf_salt(nsx,nsy) |
19246 |
double precision objf_sflux(nsx,nsy) |
19247 |
double precision objf_sst(nsx,nsy) |
19248 |
double precision objf_tauu(nsx,nsy) |
19249 |
double precision objf_tauv(nsx,nsy) |
19250 |
double precision objf_temp(nsx,nsy) |
19251 |
double precision objf_test(nsx,nsy) |
19252 |
|
19253 |
common /dynvars_cd/ uveld, vveld, etanm1, unm1, vnm1, gucd, gvcd |
19254 |
double precision etanm1(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
19255 |
double precision gucd(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
19256 |
double precision gvcd(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
19257 |
double precision unm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
19258 |
double precision uveld(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
19259 |
double precision vnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
19260 |
double precision vveld(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
19261 |
|
19262 |
common /dynvars_r/ etan, uvel, vvel, wvel, theta, salt, gu, gv, |
19263 |
$gt, gs, gunm1, gvnm1, gtnm1, gsnm1 |
19264 |
double precision etan(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
19265 |
double precision gs(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
19266 |
double precision gsnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
19267 |
double precision gt(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
19268 |
double precision gtnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
19269 |
double precision gu(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
19270 |
double precision gunm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
19271 |
double precision gv(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
19272 |
double precision gvnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
19273 |
double precision salt(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
19274 |
double precision theta(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
19275 |
double precision uvel(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
19276 |
double precision vvel(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
19277 |
double precision wvel(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
19278 |
|
19279 |
common /parm_i/ cg2dmaxiters, cg2dchkresfreq, cg3dmaxiters, |
19280 |
$cg3dchkresfreq, niter0, ntimesteps, nenditer, numstepsperpickup, |
19281 |
$writestateprec, nchecklev, writebinaryprec, readbinaryprec, nshap, |
19282 |
$ zonal_filt_sinpow, zonal_filt_cospow |
19283 |
integer cg2dchkresfreq |
19284 |
integer cg2dmaxiters |
19285 |
integer cg3dchkresfreq |
19286 |
integer cg3dmaxiters |
19287 |
integer nchecklev |
19288 |
integer nenditer |
19289 |
integer niter0 |
19290 |
integer nshap |
19291 |
integer ntimesteps |
19292 |
integer numstepsperpickup |
19293 |
integer readbinaryprec |
19294 |
integer writebinaryprec |
19295 |
integer writestateprec |
19296 |
integer zonal_filt_cospow |
19297 |
integer zonal_filt_sinpow |
19298 |
|
19299 |
common /parm_r/ cg2dtargetresidual, cg2dpcoffdfac, |
19300 |
$cg3dtargetresidual, delp, delz, delr, delx, dely, deltat, |
19301 |
$deltatmom, deltattracer, deltatclock, abeps, starttime, phimin, |
19302 |
$thetamin, rsphere, recip_rsphere, f0, fcori, beta, viscah, viscaz, |
19303 |
$ visca4, viscar, diffkht, diffkzt, diffk4t, diffkrt, diffkhs, |
19304 |
$diffkzs, diffk4s, diffkrs, delt, taucd, rcd, freesurffac, |
19305 |
$implicsurfpress, implicdiv2dflow, hfacmin, hfacmindz, gravity, |
19306 |
$recip_gravity, gbaro, rhonil, recip_rhonil, recip_rhoconst, |
19307 |
$rhoconst, tref, sref, endtime, chkptfreq, pchkptfreq, dumpfreq, |
19308 |
$tavefreq, affacmom, vffacmom, pffacmom, cffacmom, fofacmom, |
19309 |
$mtfacmom, cospower, cadjfreq, omega, tauthetaclimrelax, |
19310 |
$lambdathetaclimrelax, tausaltclimrelax, lambdasaltclimrelax, |
19311 |
$externforcingcycle, externforcingperiod, viscap, diffkpt, diffkps, |
19312 |
$ hfacmindr, hfacmindp, theta_s, specvol_s, horivertratio, |
19313 |
$recip_horivertratio, latfftfiltlo, ivdc_kappa, ro_sealevel, |
19314 |
$zonal_filt_lat, bottomdraglinear, bottomdragquadratic |
19315 |
double precision abeps |
19316 |
double precision affacmom |
19317 |
double precision beta |
19318 |
double precision bottomdraglinear |
19319 |
double precision bottomdragquadratic |
19320 |
double precision cadjfreq |
19321 |
double precision cffacmom |
19322 |
double precision cg2dpcoffdfac |
19323 |
double precision cg2dtargetresidual |
19324 |
double precision cg3dtargetresidual |
19325 |
double precision chkptfreq |
19326 |
double precision cospower |
19327 |
double precision delp(nr) |
19328 |
double precision delr(nr) |
19329 |
double precision delt |
19330 |
double precision deltat |
19331 |
double precision deltatclock |
19332 |
double precision deltatmom |
19333 |
double precision deltattracer |
19334 |
double precision delx(nx) |
19335 |
double precision dely(ny) |
19336 |
double precision delz(nr) |
19337 |
double precision diffk4s |
19338 |
double precision diffk4t |
19339 |
double precision diffkhs |
19340 |
double precision diffkht |
19341 |
double precision diffkps |
19342 |
double precision diffkpt |
19343 |
double precision diffkrs |
19344 |
double precision diffkrt |
19345 |
double precision diffkzs |
19346 |
double precision diffkzt |
19347 |
double precision dumpfreq |
19348 |
double precision endtime |
19349 |
double precision externforcingcycle |
19350 |
double precision externforcingperiod |
19351 |
double precision f0 |
19352 |
double precision fcori(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
19353 |
double precision fofacmom |
19354 |
double precision freesurffac |
19355 |
double precision gbaro |
19356 |
double precision gravity |
19357 |
double precision hfacmin |
19358 |
double precision hfacmindp |
19359 |
double precision hfacmindr |
19360 |
double precision hfacmindz |
19361 |
double precision horivertratio |
19362 |
double precision implicdiv2dflow |
19363 |
double precision implicsurfpress |
19364 |
double precision ivdc_kappa |
19365 |
double precision lambdasaltclimrelax |
19366 |
double precision lambdathetaclimrelax |
19367 |
double precision latfftfiltlo |
19368 |
double precision mtfacmom |
19369 |
double precision omega |
19370 |
double precision pchkptfreq |
19371 |
double precision pffacmom |
19372 |
double precision phimin |
19373 |
double precision rcd |
19374 |
double precision recip_gravity |
19375 |
double precision recip_horivertratio |
19376 |
double precision recip_rhoconst |
19377 |
double precision recip_rhonil |
19378 |
double precision recip_rsphere |
19379 |
double precision rhoconst |
19380 |
double precision rhonil |
19381 |
double precision ro_sealevel |
19382 |
double precision rsphere |
19383 |
double precision specvol_s(nr) |
19384 |
double precision sref(nr) |
19385 |
double precision starttime |
19386 |
double precision taucd |
19387 |
double precision tausaltclimrelax |
19388 |
double precision tauthetaclimrelax |
19389 |
double precision tavefreq |
19390 |
double precision theta_s(nr) |
19391 |
double precision thetamin |
19392 |
double precision tref(nr) |
19393 |
double precision vffacmom |
19394 |
double precision visca4 |
19395 |
double precision viscah |
19396 |
double precision viscap |
19397 |
double precision viscar |
19398 |
double precision viscaz |
19399 |
double precision zonal_filt_lat |
19400 |
|
19401 |
common /tamc_keys_i/ ikey_dynamics, ikey_yearly, ikey_daily_1, |
19402 |
$ikey_daily_2, iloop_daily |
19403 |
integer ikey_daily_1 |
19404 |
integer ikey_daily_2 |
19405 |
integer ikey_dynamics |
19406 |
integer ikey_yearly |
19407 |
integer iloop_daily |
19408 |
|
19409 |
C============================================== |
19410 |
C define arguments |
19411 |
C============================================== |
19412 |
integer mythid |
19413 |
|
19414 |
C============================================== |
19415 |
C define local variables |
19416 |
C============================================== |
19417 |
double precision fch |
19418 |
integer ilev_1 |
19419 |
integer ilev_2 |
19420 |
integer ilev_3 |
19421 |
integer iloop |
19422 |
integer max_lev2 |
19423 |
integer max_lev3 |
19424 |
integer myiter |
19425 |
double precision mytime |
19426 |
|
19427 |
C---------------------------------------------- |
19428 |
C RESET GLOBAL ADJOINT VARIABLES |
19429 |
C---------------------------------------------- |
19430 |
call adzero |
19431 |
|
19432 |
C---------------------------------------------- |
19433 |
C ROUTINE BODY |
19434 |
C---------------------------------------------- |
19435 |
C---------------------------------------------- |
19436 |
C OPEN FILES OF TAPE: tapelev3 |
19437 |
C---------------------------------------------- |
19438 |
call adopen( 'tapelev3_1_the_main_loop_gsnm1',30,9,1,8,17940 ) |
19439 |
call adopen( 'tapelev3_2_the_main_loop_gtnm1',30,9,2,8,17940 ) |
19440 |
call adopen( 'tapelev3_3_the_main_loop_gunm1',30,9,3,8,17940 ) |
19441 |
call adopen( 'tapelev3_4_the_main_loop_gvnm1',30,9,4,8,17940 ) |
19442 |
call adopen( 'tapelev3_5_the_main_loop_theta',30,9,5,8,17940 ) |
19443 |
call adopen( 'tapelev3_6_the_main_loop_salt',29,9,6,8,17940 ) |
19444 |
call adopen( 'tapelev3_7_the_main_loop_uvel',29,9,7,8,17940 ) |
19445 |
call adopen( 'tapelev3_8_the_main_loop_vvel',29,9,8,8,17940 ) |
19446 |
call adopen( 'tapelev3_9_the_main_loop_wvel',29,9,9,8,17940 ) |
19447 |
call adopen( 'tapelev3_10_the_main_loop_etan',30,9,10,8,1196 ) |
19448 |
call adopen( 'tapelev3_11_the_main_loop_etanm1',32,9,11,8,1196 ) |
19449 |
call adopen( 'tapelev3_12_the_main_loop_uveld',31,9,12,8,17940 ) |
19450 |
call adopen( 'tapelev3_13_the_main_loop_vveld',31,9,13,8,17940 ) |
19451 |
call adopen( 'tapelev3_14_the_main_loop_unm1',30,9,14,8,17940 ) |
19452 |
call adopen( 'tapelev3_15_the_main_loop_vnm1',30,9,15,8,17940 ) |
19453 |
|
19454 |
C---------------------------------------------- |
19455 |
C FUNCTION AND TAPE COMPUTATIONS |
19456 |
C---------------------------------------------- |
19457 |
ikey_dynamics = 1 |
19458 |
call initialise_varia( mythid ) |
19459 |
call ctrl_map_forcing( mythid ) |
19460 |
call barrier( mythid ) |
19461 |
max_lev3 = ntimesteps/(nchklev_1*nchklev_2)+1 |
19462 |
max_lev2 = ntimesteps/nchklev_1+1 |
19463 |
do ilev_3 = 1, nchklev_3 |
19464 |
if (ilev_3 .le. max_lev3) then |
19465 |
call adwrite( 'tapelev3_1_the_main_loop_gsnm1',30,9,1,gsnm1,8, |
19466 |
$(1+snx+olx-(1-olx))*(1+sny+oly-(1-oly))*nr*nsx*nsy,ilev_3 ) |
19467 |
call adwrite( 'tapelev3_2_the_main_loop_gtnm1',30,9,2,gtnm1,8, |
19468 |
$(1+snx+olx-(1-olx))*(1+sny+oly-(1-oly))*nr*nsx*nsy,ilev_3 ) |
19469 |
call adwrite( 'tapelev3_3_the_main_loop_gunm1',30,9,3,gunm1,8, |
19470 |
$(1+snx+olx-(1-olx))*(1+sny+oly-(1-oly))*nr*nsx*nsy,ilev_3 ) |
19471 |
call adwrite( 'tapelev3_4_the_main_loop_gvnm1',30,9,4,gvnm1,8, |
19472 |
$(1+snx+olx-(1-olx))*(1+sny+oly-(1-oly))*nr*nsx*nsy,ilev_3 ) |
19473 |
call adwrite( 'tapelev3_5_the_main_loop_theta',30,9,5,theta,8, |
19474 |
$(1+snx+olx-(1-olx))*(1+sny+oly-(1-oly))*nr*nsx*nsy,ilev_3 ) |
19475 |
call adwrite( 'tapelev3_6_the_main_loop_salt',29,9,6,salt,8, |
19476 |
$(1+snx+olx-(1-olx))*(1+sny+oly-(1-oly))*nr*nsx*nsy,ilev_3 ) |
19477 |
call adwrite( 'tapelev3_7_the_main_loop_uvel',29,9,7,uvel,8, |
19478 |
$(1+snx+olx-(1-olx))*(1+sny+oly-(1-oly))*nr*nsx*nsy,ilev_3 ) |
19479 |
call adwrite( 'tapelev3_8_the_main_loop_vvel',29,9,8,vvel,8, |
19480 |
$(1+snx+olx-(1-olx))*(1+sny+oly-(1-oly))*nr*nsx*nsy,ilev_3 ) |
19481 |
call adwrite( 'tapelev3_9_the_main_loop_wvel',29,9,9,wvel,8, |
19482 |
$(1+snx+olx-(1-olx))*(1+sny+oly-(1-oly))*nr*nsx*nsy,ilev_3 ) |
19483 |
call adwrite( 'tapelev3_10_the_main_loop_etan',30,9,10,etan,8, |
19484 |
$(1+snx+olx-(1-olx))*(1+sny+oly-(1-oly))*nsx*nsy,ilev_3 ) |
19485 |
call adwrite( 'tapelev3_11_the_main_loop_etanm1',32,9,11, |
19486 |
$etanm1,8,(1+snx+olx-(1-olx))*(1+sny+oly-(1-oly))*nsx*nsy,ilev_3 ) |
19487 |
call adwrite( 'tapelev3_12_the_main_loop_uveld',31,9,12,uveld, |
19488 |
$8,(1+snx+olx-(1-olx))*(1+sny+oly-(1-oly))*nr*nsx*nsy,ilev_3 ) |
19489 |
call adwrite( 'tapelev3_13_the_main_loop_vveld',31,9,13,vveld, |
19490 |
$8,(1+snx+olx-(1-olx))*(1+sny+oly-(1-oly))*nr*nsx*nsy,ilev_3 ) |
19491 |
call adwrite( 'tapelev3_14_the_main_loop_unm1',30,9,14,unm1,8, |
19492 |
$(1+snx+olx-(1-olx))*(1+sny+oly-(1-oly))*nr*nsx*nsy,ilev_3 ) |
19493 |
call adwrite( 'tapelev3_15_the_main_loop_vnm1',30,9,15,vnm1,8, |
19494 |
$(1+snx+olx-(1-olx))*(1+sny+oly-(1-oly))*nr*nsx*nsy,ilev_3 ) |
19495 |
do ilev_2 = 1, nchklev_2 |
19496 |
if (ilev_2 .le. max_lev2) then |
19497 |
do ilev_1 = 1, nchklev_1 |
19498 |
iloop = (ilev_3-1)*nchklev_2*nchklev_1+(ilev_2-1)* |
19499 |
$nchklev_1+ilev_1 |
19500 |
if (iloop .le. ntimesteps) then |
19501 |
myiter = niter0+iloop-1 |
19502 |
mytime = starttime+float(iloop-1)*deltatclock |
19503 |
ikey_dynamics = ilev_1 |
19504 |
call dynamics( mytime,myiter,mythid ) |
19505 |
call solve_for_pressure( mythid ) |
19506 |
call dummy_in_stepping( mytime,myiter,mythid ) |
19507 |
mytime = starttime+deltatclock*float(iloop) |
19508 |
call the_correction_step( mytime,myiter,mythid ) |
19509 |
call do_fields_blocking_exchanges( mythid ) |
19510 |
endif |
19511 |
end do |
19512 |
endif |
19513 |
end do |
19514 |
endif |
19515 |
end do |
19516 |
call barrier( mythid ) |
19517 |
call cost_test( mythid ) |
19518 |
call cost_final( mythid ) |
19519 |
|
19520 |
C---------------------------------------------- |
19521 |
C SAVE DEPENDEND VARIABLES |
19522 |
C---------------------------------------------- |
19523 |
fch = fc |
19524 |
|
19525 |
C---------------------------------------------- |
19526 |
C ADJOINT COMPUTATIONS |
19527 |
C---------------------------------------------- |
19528 |
call barrier( mythid ) |
19529 |
do ilev_3 = 1, nchklev_3 |
19530 |
if (ilev_3 .le. max_lev3) then |
19531 |
do ilev_2 = 1, nchklev_2 |
19532 |
if (ilev_2 .le. max_lev2) then |
19533 |
do ilev_1 = 1, nchklev_1 |
19534 |
iloop = (ilev_3-1)*nchklev_2*nchklev_1+(ilev_2-1)* |
19535 |
$nchklev_1+ilev_1 |
19536 |
if (iloop .le. ntimesteps) then |
19537 |
myiter = niter0+iloop-1 |
19538 |
mytime = starttime+float(iloop-1)*deltatclock |
19539 |
call dummy_in_stepping( mytime,myiter,mythid ) |
19540 |
endif |
19541 |
end do |
19542 |
endif |
19543 |
end do |
19544 |
endif |
19545 |
end do |
19546 |
call barrier( mythid ) |
19547 |
call adcost_final( mythid ) |
19548 |
call adcost_test( mythid ) |
19549 |
call barrier( mythid ) |
19550 |
do ilev_3 = nchklev_3, 1, -1 |
19551 |
if (ilev_3 .le. max_lev3) then |
19552 |
call adread( 'tapelev3_1_the_main_loop_gsnm1',30,9,1,gsnm1,8, |
19553 |
$(1+snx+olx-(1-olx))*(1+sny+oly-(1-oly))*nr*nsx*nsy,ilev_3 ) |
19554 |
call adread( 'tapelev3_2_the_main_loop_gtnm1',30,9,2,gtnm1,8, |
19555 |
$(1+snx+olx-(1-olx))*(1+sny+oly-(1-oly))*nr*nsx*nsy,ilev_3 ) |
19556 |
call adread( 'tapelev3_3_the_main_loop_gunm1',30,9,3,gunm1,8, |
19557 |
$(1+snx+olx-(1-olx))*(1+sny+oly-(1-oly))*nr*nsx*nsy,ilev_3 ) |
19558 |
call adread( 'tapelev3_4_the_main_loop_gvnm1',30,9,4,gvnm1,8, |
19559 |
$(1+snx+olx-(1-olx))*(1+sny+oly-(1-oly))*nr*nsx*nsy,ilev_3 ) |
19560 |
call adread( 'tapelev3_5_the_main_loop_theta',30,9,5,theta,8, |
19561 |
$(1+snx+olx-(1-olx))*(1+sny+oly-(1-oly))*nr*nsx*nsy,ilev_3 ) |
19562 |
call adread( 'tapelev3_6_the_main_loop_salt',29,9,6,salt,8,(1+ |
19563 |
$snx+olx-(1-olx))*(1+sny+oly-(1-oly))*nr*nsx*nsy,ilev_3 ) |
19564 |
call adread( 'tapelev3_7_the_main_loop_uvel',29,9,7,uvel,8,(1+ |
19565 |
$snx+olx-(1-olx))*(1+sny+oly-(1-oly))*nr*nsx*nsy,ilev_3 ) |
19566 |
call adread( 'tapelev3_8_the_main_loop_vvel',29,9,8,vvel,8,(1+ |
19567 |
$snx+olx-(1-olx))*(1+sny+oly-(1-oly))*nr*nsx*nsy,ilev_3 ) |
19568 |
call adread( 'tapelev3_9_the_main_loop_wvel',29,9,9,wvel,8,(1+ |
19569 |
$snx+olx-(1-olx))*(1+sny+oly-(1-oly))*nr*nsx*nsy,ilev_3 ) |
19570 |
call adread( 'tapelev3_10_the_main_loop_etan',30,9,10,etan,8, |
19571 |
$(1+snx+olx-(1-olx))*(1+sny+oly-(1-oly))*nsx*nsy,ilev_3 ) |
19572 |
call adread( 'tapelev3_11_the_main_loop_etanm1',32,9,11, |
19573 |
$etanm1,8,(1+snx+olx-(1-olx))*(1+sny+oly-(1-oly))*nsx*nsy,ilev_3 ) |
19574 |
call adread( 'tapelev3_12_the_main_loop_uveld',31,9,12,uveld, |
19575 |
$8,(1+snx+olx-(1-olx))*(1+sny+oly-(1-oly))*nr*nsx*nsy,ilev_3 ) |
19576 |
call adread( 'tapelev3_13_the_main_loop_vveld',31,9,13,vveld, |
19577 |
$8,(1+snx+olx-(1-olx))*(1+sny+oly-(1-oly))*nr*nsx*nsy,ilev_3 ) |
19578 |
call adread( 'tapelev3_14_the_main_loop_unm1',30,9,14,unm1,8, |
19579 |
$(1+snx+olx-(1-olx))*(1+sny+oly-(1-oly))*nr*nsx*nsy,ilev_3 ) |
19580 |
call adread( 'tapelev3_15_the_main_loop_vnm1',30,9,15,vnm1,8, |
19581 |
$(1+snx+olx-(1-olx))*(1+sny+oly-(1-oly))*nr*nsx*nsy,ilev_3 ) |
19582 |
C---------------------------------------------- |
19583 |
C OPEN FILES OF TAPE: tapelev2 |
19584 |
C---------------------------------------------- |
19585 |
call adopen( 'tapelev2_1_the_main_loop_gsnm1',30,10,1,8,17940 |
19586 |
$) |
19587 |
call adopen( 'tapelev2_2_the_main_loop_gtnm1',30,10,2,8,17940 |
19588 |
$) |
19589 |
call adopen( 'tapelev2_3_the_main_loop_gunm1',30,10,3,8,17940 |
19590 |
$) |
19591 |
call adopen( 'tapelev2_4_the_main_loop_gvnm1',30,10,4,8,17940 |
19592 |
$) |
19593 |
call adopen( 'tapelev2_5_the_main_loop_theta',30,10,5,8,17940 |
19594 |
$) |
19595 |
call adopen( 'tapelev2_6_the_main_loop_salt',29,10,6,8,17940 ) |
19596 |
call adopen( 'tapelev2_7_the_main_loop_uvel',29,10,7,8,17940 ) |
19597 |
call adopen( 'tapelev2_8_the_main_loop_vvel',29,10,8,8,17940 ) |
19598 |
call adopen( 'tapelev2_9_the_main_loop_wvel',29,10,9,8,17940 ) |
19599 |
call adopen( 'tapelev2_10_the_main_loop_etan',30,10,10,8,1196 |
19600 |
$) |
19601 |
call adopen( 'tapelev2_11_the_main_loop_etanm1',32,10,11,8, |
19602 |
$1196 ) |
19603 |
call adopen( 'tapelev2_12_the_main_loop_uveld',31,10,12,8, |
19604 |
$17940 ) |
19605 |
call adopen( 'tapelev2_13_the_main_loop_vveld',31,10,13,8, |
19606 |
$17940 ) |
19607 |
call adopen( 'tapelev2_14_the_main_loop_unm1',30,10,14,8, |
19608 |
$17940 ) |
19609 |
call adopen( 'tapelev2_15_the_main_loop_vnm1',30,10,15,8, |
19610 |
$17940 ) |
19611 |
|
19612 |
C---------------------------------------------- |
19613 |
C TAPE COMPUTATIONS |
19614 |
C---------------------------------------------- |
19615 |
do ilev_2 = 1, nchklev_2-1 |
19616 |
if (ilev_2 .le. max_lev2) then |
19617 |
call adwrite( 'tapelev2_1_the_main_loop_gsnm1',30,10,1, |
19618 |
$gsnm1,8,(1+snx+olx-(1-olx))*(1+sny+oly-(1-oly))*nr*nsx*nsy,ilev_2 |
19619 |
$) |
19620 |
call adwrite( 'tapelev2_2_the_main_loop_gtnm1',30,10,2, |
19621 |
$gtnm1,8,(1+snx+olx-(1-olx))*(1+sny+oly-(1-oly))*nr*nsx*nsy,ilev_2 |
19622 |
$) |
19623 |
call adwrite( 'tapelev2_3_the_main_loop_gunm1',30,10,3, |
19624 |
$gunm1,8,(1+snx+olx-(1-olx))*(1+sny+oly-(1-oly))*nr*nsx*nsy,ilev_2 |
19625 |
$) |
19626 |
call adwrite( 'tapelev2_4_the_main_loop_gvnm1',30,10,4, |
19627 |
$gvnm1,8,(1+snx+olx-(1-olx))*(1+sny+oly-(1-oly))*nr*nsx*nsy,ilev_2 |
19628 |
$) |
19629 |
call adwrite( 'tapelev2_5_the_main_loop_theta',30,10,5, |
19630 |
$theta,8,(1+snx+olx-(1-olx))*(1+sny+oly-(1-oly))*nr*nsx*nsy,ilev_2 |
19631 |
$) |
19632 |
call adwrite( 'tapelev2_6_the_main_loop_salt',29,10,6, |
19633 |
$salt,8,(1+snx+olx-(1-olx))*(1+sny+oly-(1-oly))*nr*nsx*nsy,ilev_2 ) |
19634 |
call adwrite( 'tapelev2_7_the_main_loop_uvel',29,10,7, |
19635 |
$uvel,8,(1+snx+olx-(1-olx))*(1+sny+oly-(1-oly))*nr*nsx*nsy,ilev_2 ) |
19636 |
call adwrite( 'tapelev2_8_the_main_loop_vvel',29,10,8, |
19637 |
$vvel,8,(1+snx+olx-(1-olx))*(1+sny+oly-(1-oly))*nr*nsx*nsy,ilev_2 ) |
19638 |
call adwrite( 'tapelev2_9_the_main_loop_wvel',29,10,9, |
19639 |
$wvel,8,(1+snx+olx-(1-olx))*(1+sny+oly-(1-oly))*nr*nsx*nsy,ilev_2 ) |
19640 |
call adwrite( 'tapelev2_10_the_main_loop_etan',30,10,10, |
19641 |
$etan,8,(1+snx+olx-(1-olx))*(1+sny+oly-(1-oly))*nsx*nsy,ilev_2 ) |
19642 |
call adwrite( 'tapelev2_11_the_main_loop_etanm1',32,10,11, |
19643 |
$etanm1,8,(1+snx+olx-(1-olx))*(1+sny+oly-(1-oly))*nsx*nsy,ilev_2 ) |
19644 |
call adwrite( 'tapelev2_12_the_main_loop_uveld',31,10,12, |
19645 |
$uveld,8,(1+snx+olx-(1-olx))*(1+sny+oly-(1-oly))*nr*nsx*nsy,ilev_2 |
19646 |
$) |
19647 |
call adwrite( 'tapelev2_13_the_main_loop_vveld',31,10,13, |
19648 |
$vveld,8,(1+snx+olx-(1-olx))*(1+sny+oly-(1-oly))*nr*nsx*nsy,ilev_2 |
19649 |
$) |
19650 |
call adwrite( 'tapelev2_14_the_main_loop_unm1',30,10,14, |
19651 |
$unm1,8,(1+snx+olx-(1-olx))*(1+sny+oly-(1-oly))*nr*nsx*nsy,ilev_2 ) |
19652 |
call adwrite( 'tapelev2_15_the_main_loop_vnm1',30,10,15, |
19653 |
$vnm1,8,(1+snx+olx-(1-olx))*(1+sny+oly-(1-oly))*nr*nsx*nsy,ilev_2 ) |
19654 |
do ilev_1 = 1, nchklev_1 |
19655 |
iloop = (ilev_3-1)*nchklev_2*nchklev_1+(ilev_2-1)* |
19656 |
$nchklev_1+ilev_1 |
19657 |
if (iloop .le. ntimesteps) then |
19658 |
myiter = niter0+iloop-1 |
19659 |
mytime = starttime+float(iloop-1)*deltatclock |
19660 |
ikey_dynamics = ilev_1 |
19661 |
call dynamics( mytime,myiter,mythid ) |
19662 |
call solve_for_pressure( mythid ) |
19663 |
call dummy_in_stepping( mytime,myiter,mythid ) |
19664 |
mytime = starttime+deltatclock*float(iloop) |
19665 |
call the_correction_step( mytime,myiter,mythid ) |
19666 |
call do_fields_blocking_exchanges( mythid ) |
19667 |
endif |
19668 |
end do |
19669 |
endif |
19670 |
end do |
19671 |
ilev_2 = nchklev_2 |
19672 |
if (ilev_2 .le. max_lev2) then |
19673 |
call adwrite( 'tapelev2_1_the_main_loop_gsnm1',30,10,1, |
19674 |
$gsnm1,8,(1+snx+olx-(1-olx))*(1+sny+oly-(1-oly))*nr*nsx*nsy,ilev_2 |
19675 |
$) |
19676 |
call adwrite( 'tapelev2_2_the_main_loop_gtnm1',30,10,2, |
19677 |
$gtnm1,8,(1+snx+olx-(1-olx))*(1+sny+oly-(1-oly))*nr*nsx*nsy,ilev_2 |
19678 |
$) |
19679 |
call adwrite( 'tapelev2_3_the_main_loop_gunm1',30,10,3, |
19680 |
$gunm1,8,(1+snx+olx-(1-olx))*(1+sny+oly-(1-oly))*nr*nsx*nsy,ilev_2 |
19681 |
$) |
19682 |
call adwrite( 'tapelev2_4_the_main_loop_gvnm1',30,10,4, |
19683 |
$gvnm1,8,(1+snx+olx-(1-olx))*(1+sny+oly-(1-oly))*nr*nsx*nsy,ilev_2 |
19684 |
$) |
19685 |
call adwrite( 'tapelev2_5_the_main_loop_theta',30,10,5, |
19686 |
$theta,8,(1+snx+olx-(1-olx))*(1+sny+oly-(1-oly))*nr*nsx*nsy,ilev_2 |
19687 |
$) |
19688 |
call adwrite( 'tapelev2_6_the_main_loop_salt',29,10,6,salt, |
19689 |
$8,(1+snx+olx-(1-olx))*(1+sny+oly-(1-oly))*nr*nsx*nsy,ilev_2 ) |
19690 |
call adwrite( 'tapelev2_7_the_main_loop_uvel',29,10,7,uvel, |
19691 |
$8,(1+snx+olx-(1-olx))*(1+sny+oly-(1-oly))*nr*nsx*nsy,ilev_2 ) |
19692 |
call adwrite( 'tapelev2_8_the_main_loop_vvel',29,10,8,vvel, |
19693 |
$8,(1+snx+olx-(1-olx))*(1+sny+oly-(1-oly))*nr*nsx*nsy,ilev_2 ) |
19694 |
call adwrite( 'tapelev2_9_the_main_loop_wvel',29,10,9,wvel, |
19695 |
$8,(1+snx+olx-(1-olx))*(1+sny+oly-(1-oly))*nr*nsx*nsy,ilev_2 ) |
19696 |
call adwrite( 'tapelev2_10_the_main_loop_etan',30,10,10, |
19697 |
$etan,8,(1+snx+olx-(1-olx))*(1+sny+oly-(1-oly))*nsx*nsy,ilev_2 ) |
19698 |
call adwrite( 'tapelev2_11_the_main_loop_etanm1',32,10,11, |
19699 |
$etanm1,8,(1+snx+olx-(1-olx))*(1+sny+oly-(1-oly))*nsx*nsy,ilev_2 ) |
19700 |
call adwrite( 'tapelev2_12_the_main_loop_uveld',31,10,12, |
19701 |
$uveld,8,(1+snx+olx-(1-olx))*(1+sny+oly-(1-oly))*nr*nsx*nsy,ilev_2 |
19702 |
$) |
19703 |
call adwrite( 'tapelev2_13_the_main_loop_vveld',31,10,13, |
19704 |
$vveld,8,(1+snx+olx-(1-olx))*(1+sny+oly-(1-oly))*nr*nsx*nsy,ilev_2 |
19705 |
$) |
19706 |
call adwrite( 'tapelev2_14_the_main_loop_unm1',30,10,14, |
19707 |
$unm1,8,(1+snx+olx-(1-olx))*(1+sny+oly-(1-oly))*nr*nsx*nsy,ilev_2 ) |
19708 |
call adwrite( 'tapelev2_15_the_main_loop_vnm1',30,10,15, |
19709 |
$vnm1,8,(1+snx+olx-(1-olx))*(1+sny+oly-(1-oly))*nr*nsx*nsy,ilev_2 ) |
19710 |
do ilev_1 = 1, nchklev_1 |
19711 |
iloop = (ilev_3-1)*nchklev_2*nchklev_1+(ilev_2-1)* |
19712 |
$nchklev_1+ilev_1 |
19713 |
if (iloop .le. ntimesteps) then |
19714 |
myiter = niter0+iloop-1 |
19715 |
mytime = starttime+float(iloop-1)*deltatclock |
19716 |
call dummy_in_stepping( mytime,myiter,mythid ) |
19717 |
endif |
19718 |
end do |
19719 |
endif |
19720 |
|
19721 |
C---------------------------------------------- |
19722 |
C ADJOINT COMPUTATIONS |
19723 |
C---------------------------------------------- |
19724 |
do ilev_2 = nchklev_2, 1, -1 |
19725 |
if (ilev_2 .le. max_lev2) then |
19726 |
call adread( 'tapelev2_1_the_main_loop_gsnm1',30,10,1, |
19727 |
$gsnm1,8,(1+snx+olx-(1-olx))*(1+sny+oly-(1-oly))*nr*nsx*nsy,ilev_2 |
19728 |
$) |
19729 |
call adread( 'tapelev2_2_the_main_loop_gtnm1',30,10,2, |
19730 |
$gtnm1,8,(1+snx+olx-(1-olx))*(1+sny+oly-(1-oly))*nr*nsx*nsy,ilev_2 |
19731 |
$) |
19732 |
call adread( 'tapelev2_3_the_main_loop_gunm1',30,10,3, |
19733 |
$gunm1,8,(1+snx+olx-(1-olx))*(1+sny+oly-(1-oly))*nr*nsx*nsy,ilev_2 |
19734 |
$) |
19735 |
call adread( 'tapelev2_4_the_main_loop_gvnm1',30,10,4, |
19736 |
$gvnm1,8,(1+snx+olx-(1-olx))*(1+sny+oly-(1-oly))*nr*nsx*nsy,ilev_2 |
19737 |
$) |
19738 |
call adread( 'tapelev2_5_the_main_loop_theta',30,10,5, |
19739 |
$theta,8,(1+snx+olx-(1-olx))*(1+sny+oly-(1-oly))*nr*nsx*nsy,ilev_2 |
19740 |
$) |
19741 |
call adread( 'tapelev2_6_the_main_loop_salt',29,10,6,salt, |
19742 |
$8,(1+snx+olx-(1-olx))*(1+sny+oly-(1-oly))*nr*nsx*nsy,ilev_2 ) |
19743 |
call adread( 'tapelev2_7_the_main_loop_uvel',29,10,7,uvel, |
19744 |
$8,(1+snx+olx-(1-olx))*(1+sny+oly-(1-oly))*nr*nsx*nsy,ilev_2 ) |
19745 |
call adread( 'tapelev2_8_the_main_loop_vvel',29,10,8,vvel, |
19746 |
$8,(1+snx+olx-(1-olx))*(1+sny+oly-(1-oly))*nr*nsx*nsy,ilev_2 ) |
19747 |
call adread( 'tapelev2_9_the_main_loop_wvel',29,10,9,wvel, |
19748 |
$8,(1+snx+olx-(1-olx))*(1+sny+oly-(1-oly))*nr*nsx*nsy,ilev_2 ) |
19749 |
call adread( 'tapelev2_10_the_main_loop_etan',30,10,10, |
19750 |
$etan,8,(1+snx+olx-(1-olx))*(1+sny+oly-(1-oly))*nsx*nsy,ilev_2 ) |
19751 |
call adread( 'tapelev2_11_the_main_loop_etanm1',32,10,11, |
19752 |
$etanm1,8,(1+snx+olx-(1-olx))*(1+sny+oly-(1-oly))*nsx*nsy,ilev_2 ) |
19753 |
call adread( 'tapelev2_12_the_main_loop_uveld',31,10,12, |
19754 |
$uveld,8,(1+snx+olx-(1-olx))*(1+sny+oly-(1-oly))*nr*nsx*nsy,ilev_2 |
19755 |
$) |
19756 |
call adread( 'tapelev2_13_the_main_loop_vveld',31,10,13, |
19757 |
$vveld,8,(1+snx+olx-(1-olx))*(1+sny+oly-(1-oly))*nr*nsx*nsy,ilev_2 |
19758 |
$) |
19759 |
call adread( 'tapelev2_14_the_main_loop_unm1',30,10,14, |
19760 |
$unm1,8,(1+snx+olx-(1-olx))*(1+sny+oly-(1-oly))*nr*nsx*nsy,ilev_2 ) |
19761 |
call adread( 'tapelev2_15_the_main_loop_vnm1',30,10,15, |
19762 |
$vnm1,8,(1+snx+olx-(1-olx))*(1+sny+oly-(1-oly))*nr*nsx*nsy,ilev_2 ) |
19763 |
C---------------------------------------------- |
19764 |
C TAPE COMPUTATIONS |
19765 |
C---------------------------------------------- |
19766 |
do ilev_1 = 1, nchklev_1 |
19767 |
iloop = (ilev_3-1)*nchklev_2*nchklev_1+(ilev_2-1)* |
19768 |
$nchklev_1+ilev_1 |
19769 |
if (iloop .le. ntimesteps) then |
19770 |
myiter = niter0+iloop-1 |
19771 |
mytime = starttime+float(iloop-1)*deltatclock |
19772 |
ikey_dynamics = ilev_1 |
19773 |
call mddynamics( mytime,myiter,mythid ) |
19774 |
call solve_for_pressure( mythid ) |
19775 |
call dummy_in_stepping( mytime,myiter,mythid ) |
19776 |
mytime = starttime+deltatclock*float(iloop) |
19777 |
call mdthe_correction_step( mytime,myiter,mythid ) |
19778 |
call do_fields_blocking_exchanges( mythid ) |
19779 |
endif |
19780 |
end do |
19781 |
|
19782 |
C---------------------------------------------- |
19783 |
C ADJOINT COMPUTATIONS |
19784 |
C---------------------------------------------- |
19785 |
do ilev_1 = nchklev_1, 1, -1 |
19786 |
iloop = (ilev_3-1)*nchklev_2*nchklev_1+(ilev_2-1)* |
19787 |
$nchklev_1+ilev_1 |
19788 |
if (iloop .le. ntimesteps) then |
19789 |
myiter = niter0+iloop-1 |
19790 |
mytime = starttime+float(iloop-1)*deltatclock |
19791 |
ikey_dynamics = ilev_1 |
19792 |
call dummy_in_stepping( mytime,myiter,mythid ) |
19793 |
mytime = starttime+deltatclock*float(iloop) |
19794 |
call addo_fields_blocking_exchanges( mythid ) |
19795 |
call adthe_correction_step( mytime,mythid ) |
19796 |
mytime = starttime+float(iloop-1)*deltatclock |
19797 |
call addummy_in_stepping( mytime,myiter,mythid ) |
19798 |
call adsolve_for_pressure( mythid ) |
19799 |
call addynamics( mytime,mythid ) |
19800 |
endif |
19801 |
end do |
19802 |
|
19803 |
endif |
19804 |
end do |
19805 |
|
19806 |
C---------------------------------------------- |
19807 |
C CLOSE FILES OF TAPE: tapelev2 |
19808 |
C---------------------------------------------- |
19809 |
call adclose( 'tapelev2_1_the_main_loop_gsnm1',30,10,1,8, |
19810 |
$17940 ) |
19811 |
call adclose( 'tapelev2_2_the_main_loop_gtnm1',30,10,2,8, |
19812 |
$17940 ) |
19813 |
call adclose( 'tapelev2_3_the_main_loop_gunm1',30,10,3,8, |
19814 |
$17940 ) |
19815 |
call adclose( 'tapelev2_4_the_main_loop_gvnm1',30,10,4,8, |
19816 |
$17940 ) |
19817 |
call adclose( 'tapelev2_5_the_main_loop_theta',30,10,5,8, |
19818 |
$17940 ) |
19819 |
call adclose( 'tapelev2_6_the_main_loop_salt',29,10,6,8,17940 |
19820 |
$) |
19821 |
call adclose( 'tapelev2_7_the_main_loop_uvel',29,10,7,8,17940 |
19822 |
$) |
19823 |
call adclose( 'tapelev2_8_the_main_loop_vvel',29,10,8,8,17940 |
19824 |
$) |
19825 |
call adclose( 'tapelev2_9_the_main_loop_wvel',29,10,9,8,17940 |
19826 |
$) |
19827 |
call adclose( 'tapelev2_10_the_main_loop_etan',30,10,10,8, |
19828 |
$1196 ) |
19829 |
call adclose( 'tapelev2_11_the_main_loop_etanm1',32,10,11,8, |
19830 |
$1196 ) |
19831 |
call adclose( 'tapelev2_12_the_main_loop_uveld',31,10,12,8, |
19832 |
$17940 ) |
19833 |
call adclose( 'tapelev2_13_the_main_loop_vveld',31,10,13,8, |
19834 |
$17940 ) |
19835 |
call adclose( 'tapelev2_14_the_main_loop_unm1',30,10,14,8, |
19836 |
$17940 ) |
19837 |
call adclose( 'tapelev2_15_the_main_loop_vnm1',30,10,15,8, |
19838 |
$17940 ) |
19839 |
|
19840 |
endif |
19841 |
end do |
19842 |
call barrier( mythid ) |
19843 |
call adctrl_map_forcing( mythid ) |
19844 |
ikey_dynamics = 1 |
19845 |
call adinitialise_varia( mythid ) |
19846 |
|
19847 |
C---------------------------------------------- |
19848 |
C CLOSE FILES OF TAPE: tapelev3 |
19849 |
C---------------------------------------------- |
19850 |
call adclose( 'tapelev3_1_the_main_loop_gsnm1',30,9,1,8,17940 ) |
19851 |
call adclose( 'tapelev3_2_the_main_loop_gtnm1',30,9,2,8,17940 ) |
19852 |
call adclose( 'tapelev3_3_the_main_loop_gunm1',30,9,3,8,17940 ) |
19853 |
call adclose( 'tapelev3_4_the_main_loop_gvnm1',30,9,4,8,17940 ) |
19854 |
call adclose( 'tapelev3_5_the_main_loop_theta',30,9,5,8,17940 ) |
19855 |
call adclose( 'tapelev3_6_the_main_loop_salt',29,9,6,8,17940 ) |
19856 |
call adclose( 'tapelev3_7_the_main_loop_uvel',29,9,7,8,17940 ) |
19857 |
call adclose( 'tapelev3_8_the_main_loop_vvel',29,9,8,8,17940 ) |
19858 |
call adclose( 'tapelev3_9_the_main_loop_wvel',29,9,9,8,17940 ) |
19859 |
call adclose( 'tapelev3_10_the_main_loop_etan',30,9,10,8,1196 ) |
19860 |
call adclose( 'tapelev3_11_the_main_loop_etanm1',32,9,11,8,1196 ) |
19861 |
call adclose( 'tapelev3_12_the_main_loop_uveld',31,9,12,8,17940 ) |
19862 |
call adclose( 'tapelev3_13_the_main_loop_vveld',31,9,13,8,17940 ) |
19863 |
call adclose( 'tapelev3_14_the_main_loop_unm1',30,9,14,8,17940 ) |
19864 |
call adclose( 'tapelev3_15_the_main_loop_vnm1',30,9,15,8,17940 ) |
19865 |
|
19866 |
C---------------------------------------------- |
19867 |
C GET DEPENDEND VARIABLES |
19868 |
C---------------------------------------------- |
19869 |
fc = fch |
19870 |
|
19871 |
|
19872 |
end |
19873 |
|
19874 |
|
19875 |
subroutine adtimestep( bi, bj, imin, imax, jmin, jmax, k, |
19876 |
$adphihyd, adphisurfx, adphisurfy ) |
19877 |
C*************************************************************** |
19878 |
C*************************************************************** |
19879 |
C** This routine was generated by the ** |
19880 |
C** Tangent linear and Adjoint Model Compiler, TAMC 5.2.14 ** |
19881 |
C*************************************************************** |
19882 |
C*************************************************************** |
19883 |
C============================================== |
19884 |
C all entries are defined explicitly |
19885 |
C============================================== |
19886 |
implicit none |
19887 |
|
19888 |
C============================================== |
19889 |
C define parameters |
19890 |
C============================================== |
19891 |
integer npx |
19892 |
parameter ( npx = 1 ) |
19893 |
integer npy |
19894 |
parameter ( npy = 1 ) |
19895 |
integer nr |
19896 |
parameter ( nr = 15 ) |
19897 |
integer nsx |
19898 |
parameter ( nsx = 1 ) |
19899 |
integer nsy |
19900 |
parameter ( nsy = 1 ) |
19901 |
integer snx |
19902 |
parameter ( snx = 20 ) |
19903 |
integer nx |
19904 |
parameter ( nx = snx*nsx*npx ) |
19905 |
integer sny |
19906 |
parameter ( sny = 40 ) |
19907 |
integer ny |
19908 |
parameter ( ny = sny*nsy*npy ) |
19909 |
integer olx |
19910 |
parameter ( olx = 3 ) |
19911 |
integer oly |
19912 |
parameter ( oly = 3 ) |
19913 |
|
19914 |
C============================================== |
19915 |
C define common blocks |
19916 |
C============================================== |
19917 |
common /addynvars_cd/ aduveld, advveld, adetanm1, adunm1, advnm1, |
19918 |
$adgucd, adgvcd |
19919 |
double precision adetanm1(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
19920 |
double precision adgucd(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
19921 |
double precision adgvcd(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
19922 |
double precision adunm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
19923 |
double precision aduveld(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
19924 |
double precision advnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
19925 |
double precision advveld(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
19926 |
|
19927 |
common /addynvars_r/ adetan, aduvel, advvel, adwvel, adtheta, |
19928 |
$adsalt, adgu, adgv, adgt, adgs, adgunm1, adgvnm1, adgtnm1, adgsnm1 |
19929 |
double precision adetan(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
19930 |
double precision adgs(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
19931 |
double precision adgsnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
19932 |
double precision adgt(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
19933 |
double precision adgtnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
19934 |
double precision adgu(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
19935 |
double precision adgunm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
19936 |
double precision adgv(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
19937 |
double precision adgvnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
19938 |
double precision adsalt(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
19939 |
double precision adtheta(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
19940 |
double precision aduvel(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
19941 |
double precision advvel(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
19942 |
double precision adwvel(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
19943 |
|
19944 |
common /grid_r/ dxc, dxf, dxg, dxv, dyc, dyf, dyg, dyu, drc, drf, |
19945 |
$h, hfacc, hfacw, hfacs, depthink, recip_dxc, recip_dxf, recip_dxg, |
19946 |
$ recip_dxv, recip_dyc, recip_dyf, recip_dyg, recip_dyu, recip_drc, |
19947 |
$ recip_drf, recip_h, recip_hfacc, recip_hfacw, recip_hfacs, rkfac, |
19948 |
$ recip_rkfac, safac, xc, yc, ra, raw, ras, raz, rc, rf, yc0, xc0, |
19949 |
$xg, yg, maskw, masks, recip_ra, recip_raw, recip_ras, recip_raz, |
19950 |
$tanphiatu, tanphiatv |
19951 |
double precision depthink(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
19952 |
double precision drc(1:nr) |
19953 |
double precision drf(1:nr) |
19954 |
double precision dxc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
19955 |
double precision dxf(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
19956 |
double precision dxg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
19957 |
double precision dxv(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
19958 |
double precision dyc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
19959 |
double precision dyf(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
19960 |
double precision dyg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
19961 |
double precision dyu(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
19962 |
double precision h(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
19963 |
double precision hfacc(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) |
19964 |
double precision hfacs(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) |
19965 |
double precision hfacw(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) |
19966 |
double precision masks(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) |
19967 |
double precision maskw(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) |
19968 |
double precision ra(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
19969 |
double precision ras(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
19970 |
double precision raw(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
19971 |
double precision raz(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
19972 |
double precision rc(1:nr) |
19973 |
double precision recip_drc(1:nr) |
19974 |
double precision recip_drf(1:nr) |
19975 |
double precision recip_dxc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
19976 |
double precision recip_dxf(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
19977 |
double precision recip_dxg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
19978 |
double precision recip_dxv(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
19979 |
double precision recip_dyc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
19980 |
double precision recip_dyf(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
19981 |
double precision recip_dyg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
19982 |
double precision recip_dyu(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
19983 |
double precision recip_h(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
19984 |
double precision recip_hfacc(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx, |
19985 |
$nsy) |
19986 |
double precision recip_hfacs(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx, |
19987 |
$nsy) |
19988 |
double precision recip_hfacw(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx, |
19989 |
$nsy) |
19990 |
double precision recip_ra(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
19991 |
double precision recip_ras(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
19992 |
double precision recip_raw(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
19993 |
double precision recip_raz(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
19994 |
double precision recip_rkfac |
19995 |
double precision rf(1:nr+1) |
19996 |
double precision rkfac |
19997 |
double precision safac(1:nr) |
19998 |
double precision tanphiatu(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
19999 |
double precision tanphiatv(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
20000 |
double precision xc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
20001 |
double precision xc0 |
20002 |
double precision xg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
20003 |
double precision yc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
20004 |
double precision yc0 |
20005 |
double precision yg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
20006 |
|
20007 |
common /parm_l/ usingcartesiangrid, usingsphericalpolargrid, |
20008 |
$no_slip_sides, no_slip_bottom, staggertimestep, momviscosity, |
20009 |
$momadvection, momforcing, usecoriolis, mompressureforcing, |
20010 |
$tempdiffusion, tempadvection, tempforcing, saltdiffusion, |
20011 |
$saltadvection, saltforcing, implicitfreesurface, rigidlid, |
20012 |
$momstepping, tempstepping, saltstepping, metricterms, |
20013 |
$usingsphericalpolarmterms, useconstantf, usebetaplanef, |
20014 |
$usespheref, implicitdiffusion, implicitviscosity, |
20015 |
$dothetaclimrelax, dosaltclimrelax, periodicexternalforcing, |
20016 |
$usingpcoords, usingzcoords, nonhydrostatic, globalfiles, |
20017 |
$allowfreezing, groundatk1, usepickupbeforec35 |
20018 |
logical allowfreezing |
20019 |
logical dosaltclimrelax |
20020 |
logical dothetaclimrelax |
20021 |
logical globalfiles |
20022 |
logical groundatk1 |
20023 |
logical implicitdiffusion |
20024 |
logical implicitfreesurface |
20025 |
logical implicitviscosity |
20026 |
logical metricterms |
20027 |
logical momadvection |
20028 |
logical momforcing |
20029 |
logical mompressureforcing |
20030 |
logical momstepping |
20031 |
logical momviscosity |
20032 |
logical no_slip_bottom |
20033 |
logical no_slip_sides |
20034 |
logical nonhydrostatic |
20035 |
logical periodicexternalforcing |
20036 |
logical rigidlid |
20037 |
logical saltadvection |
20038 |
logical saltdiffusion |
20039 |
logical saltforcing |
20040 |
logical saltstepping |
20041 |
logical staggertimestep |
20042 |
logical tempadvection |
20043 |
logical tempdiffusion |
20044 |
logical tempforcing |
20045 |
logical tempstepping |
20046 |
logical usebetaplanef |
20047 |
logical useconstantf |
20048 |
logical usecoriolis |
20049 |
logical usepickupbeforec35 |
20050 |
logical usespheref |
20051 |
logical usingcartesiangrid |
20052 |
logical usingpcoords |
20053 |
logical usingsphericalpolargrid |
20054 |
logical usingsphericalpolarmterms |
20055 |
logical usingzcoords |
20056 |
|
20057 |
common /parm_r/ cg2dtargetresidual, cg2dpcoffdfac, |
20058 |
$cg3dtargetresidual, delp, delz, delr, delx, dely, deltat, |
20059 |
$deltatmom, deltattracer, deltatclock, abeps, starttime, phimin, |
20060 |
$thetamin, rsphere, recip_rsphere, f0, fcori, beta, viscah, viscaz, |
20061 |
$ visca4, viscar, diffkht, diffkzt, diffk4t, diffkrt, diffkhs, |
20062 |
$diffkzs, diffk4s, diffkrs, delt, taucd, rcd, freesurffac, |
20063 |
$implicsurfpress, implicdiv2dflow, hfacmin, hfacmindz, gravity, |
20064 |
$recip_gravity, gbaro, rhonil, recip_rhonil, recip_rhoconst, |
20065 |
$rhoconst, tref, sref, endtime, chkptfreq, pchkptfreq, dumpfreq, |
20066 |
$tavefreq, affacmom, vffacmom, pffacmom, cffacmom, fofacmom, |
20067 |
$mtfacmom, cospower, cadjfreq, omega, tauthetaclimrelax, |
20068 |
$lambdathetaclimrelax, tausaltclimrelax, lambdasaltclimrelax, |
20069 |
$externforcingcycle, externforcingperiod, viscap, diffkpt, diffkps, |
20070 |
$ hfacmindr, hfacmindp, theta_s, specvol_s, horivertratio, |
20071 |
$recip_horivertratio, latfftfiltlo, ivdc_kappa, ro_sealevel, |
20072 |
$zonal_filt_lat, bottomdraglinear, bottomdragquadratic |
20073 |
double precision abeps |
20074 |
double precision affacmom |
20075 |
double precision beta |
20076 |
double precision bottomdraglinear |
20077 |
double precision bottomdragquadratic |
20078 |
double precision cadjfreq |
20079 |
double precision cffacmom |
20080 |
double precision cg2dpcoffdfac |
20081 |
double precision cg2dtargetresidual |
20082 |
double precision cg3dtargetresidual |
20083 |
double precision chkptfreq |
20084 |
double precision cospower |
20085 |
double precision delp(nr) |
20086 |
double precision delr(nr) |
20087 |
double precision delt |
20088 |
double precision deltat |
20089 |
double precision deltatclock |
20090 |
double precision deltatmom |
20091 |
double precision deltattracer |
20092 |
double precision delx(nx) |
20093 |
double precision dely(ny) |
20094 |
double precision delz(nr) |
20095 |
double precision diffk4s |
20096 |
double precision diffk4t |
20097 |
double precision diffkhs |
20098 |
double precision diffkht |
20099 |
double precision diffkps |
20100 |
double precision diffkpt |
20101 |
double precision diffkrs |
20102 |
double precision diffkrt |
20103 |
double precision diffkzs |
20104 |
double precision diffkzt |
20105 |
double precision dumpfreq |
20106 |
double precision endtime |
20107 |
double precision externforcingcycle |
20108 |
double precision externforcingperiod |
20109 |
double precision f0 |
20110 |
double precision fcori(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
20111 |
double precision fofacmom |
20112 |
double precision freesurffac |
20113 |
double precision gbaro |
20114 |
double precision gravity |
20115 |
double precision hfacmin |
20116 |
double precision hfacmindp |
20117 |
double precision hfacmindr |
20118 |
double precision hfacmindz |
20119 |
double precision horivertratio |
20120 |
double precision implicdiv2dflow |
20121 |
double precision implicsurfpress |
20122 |
double precision ivdc_kappa |
20123 |
double precision lambdasaltclimrelax |
20124 |
double precision lambdathetaclimrelax |
20125 |
double precision latfftfiltlo |
20126 |
double precision mtfacmom |
20127 |
double precision omega |
20128 |
double precision pchkptfreq |
20129 |
double precision pffacmom |
20130 |
double precision phimin |
20131 |
double precision rcd |
20132 |
double precision recip_gravity |
20133 |
double precision recip_horivertratio |
20134 |
double precision recip_rhoconst |
20135 |
double precision recip_rhonil |
20136 |
double precision recip_rsphere |
20137 |
double precision rhoconst |
20138 |
double precision rhonil |
20139 |
double precision ro_sealevel |
20140 |
double precision rsphere |
20141 |
double precision specvol_s(nr) |
20142 |
double precision sref(nr) |
20143 |
double precision starttime |
20144 |
double precision taucd |
20145 |
double precision tausaltclimrelax |
20146 |
double precision tauthetaclimrelax |
20147 |
double precision tavefreq |
20148 |
double precision theta_s(nr) |
20149 |
double precision thetamin |
20150 |
double precision tref(nr) |
20151 |
double precision vffacmom |
20152 |
double precision visca4 |
20153 |
double precision viscah |
20154 |
double precision viscap |
20155 |
double precision viscar |
20156 |
double precision viscaz |
20157 |
double precision zonal_filt_lat |
20158 |
|
20159 |
C============================================== |
20160 |
C define arguments |
20161 |
C============================================== |
20162 |
double precision adphihyd(1-olx:snx+olx,1-oly:sny+oly,nr) |
20163 |
double precision adphisurfx(1-olx:snx+olx,1-oly:sny+oly) |
20164 |
double precision adphisurfy(1-olx:snx+olx,1-oly:sny+oly) |
20165 |
integer bi |
20166 |
integer bj |
20167 |
integer imax |
20168 |
integer imin |
20169 |
integer jmax |
20170 |
integer jmin |
20171 |
integer k |
20172 |
|
20173 |
C============================================== |
20174 |
C define local variables |
20175 |
C============================================== |
20176 |
double precision ab05 |
20177 |
double precision ab15 |
20178 |
integer i |
20179 |
integer j |
20180 |
double precision phxfac |
20181 |
double precision phyfac |
20182 |
double precision psfac |
20183 |
|
20184 |
C---------------------------------------------- |
20185 |
C ROUTINE BODY |
20186 |
C---------------------------------------------- |
20187 |
ab15 = 1.5+abeps |
20188 |
ab05 = (-0.5)-abeps |
20189 |
psfac = pffacmom*(1.d0-implicsurfpress) |
20190 |
if (staggertimestep) then |
20191 |
phyfac = pffacmom*deltatmom |
20192 |
do j = jmin, jmax |
20193 |
do i = imin, imax |
20194 |
adphihyd(i,j-1,k) = adphihyd(i,j-1,k)+adgvnm1(i,j,k,bi,bj)* |
20195 |
$recip_dyc(i,j,bi,bj)*phyfac*masks(i,j,k,bi,bj) |
20196 |
adphihyd(i,j,k) = adphihyd(i,j,k)-adgvnm1(i,j,k,bi,bj)* |
20197 |
$recip_dyc(i,j,bi,bj)*phyfac*masks(i,j,k,bi,bj) |
20198 |
end do |
20199 |
end do |
20200 |
endif |
20201 |
do j = jmin, jmax |
20202 |
do i = imin, imax |
20203 |
adgv(i,j,k,bi,bj) = adgv(i,j,k,bi,bj)+adgvnm1(i,j,k,bi,bj)* |
20204 |
$deltatmom*ab15*masks(i,j,k,bi,bj) |
20205 |
adgvcd(i,j,k,bi,bj) = adgvcd(i,j,k,bi,bj)+adgvnm1(i,j,k,bi,bj) |
20206 |
$*deltatmom*masks(i,j,k,bi,bj) |
20207 |
adphisurfy(i,j) = adphisurfy(i,j)-adgvnm1(i,j,k,bi,bj)* |
20208 |
$deltatmom*psfac*masks(i,j,k,bi,bj) |
20209 |
advvel(i,j,k,bi,bj) = advvel(i,j,k,bi,bj)+adgvnm1(i,j,k,bi,bj) |
20210 |
adgvnm1(i,j,k,bi,bj) = adgvnm1(i,j,k,bi,bj)*deltatmom*ab05* |
20211 |
$masks(i,j,k,bi,bj) |
20212 |
end do |
20213 |
end do |
20214 |
if (staggertimestep) then |
20215 |
phxfac = pffacmom*deltatmom |
20216 |
do j = jmin, jmax |
20217 |
do i = imin, imax |
20218 |
adphihyd(i-1,j,k) = adphihyd(i-1,j,k)+adgunm1(i,j,k,bi,bj)* |
20219 |
$recip_dxc(i,j,bi,bj)*phxfac*maskw(i,j,k,bi,bj) |
20220 |
adphihyd(i,j,k) = adphihyd(i,j,k)-adgunm1(i,j,k,bi,bj)* |
20221 |
$recip_dxc(i,j,bi,bj)*phxfac*maskw(i,j,k,bi,bj) |
20222 |
end do |
20223 |
end do |
20224 |
endif |
20225 |
psfac = pffacmom*(1.d0-implicsurfpress) |
20226 |
do j = jmin, jmax |
20227 |
do i = imin, imax |
20228 |
adgu(i,j,k,bi,bj) = adgu(i,j,k,bi,bj)+adgunm1(i,j,k,bi,bj)* |
20229 |
$deltatmom*ab15*maskw(i,j,k,bi,bj) |
20230 |
adgucd(i,j,k,bi,bj) = adgucd(i,j,k,bi,bj)+adgunm1(i,j,k,bi,bj) |
20231 |
$*deltatmom*maskw(i,j,k,bi,bj) |
20232 |
adphisurfx(i,j) = adphisurfx(i,j)-adgunm1(i,j,k,bi,bj)* |
20233 |
$deltatmom*psfac*maskw(i,j,k,bi,bj) |
20234 |
aduvel(i,j,k,bi,bj) = aduvel(i,j,k,bi,bj)+adgunm1(i,j,k,bi,bj) |
20235 |
adgunm1(i,j,k,bi,bj) = adgunm1(i,j,k,bi,bj)*deltatmom*ab05* |
20236 |
$maskw(i,j,k,bi,bj) |
20237 |
end do |
20238 |
end do |
20239 |
|
20240 |
end |
20241 |
|
20242 |
|
20243 |
subroutine adtimestep_tracer( bi, bj, imin, imax, jmin, jmax, k, |
20244 |
$adtracer, adgtracer, adgtrnm1 ) |
20245 |
C*************************************************************** |
20246 |
C*************************************************************** |
20247 |
C** This routine was generated by the ** |
20248 |
C** Tangent linear and Adjoint Model Compiler, TAMC 5.2.14 ** |
20249 |
C*************************************************************** |
20250 |
C*************************************************************** |
20251 |
C============================================== |
20252 |
C all entries are defined explicitly |
20253 |
C============================================== |
20254 |
implicit none |
20255 |
|
20256 |
C============================================== |
20257 |
C define parameters |
20258 |
C============================================== |
20259 |
integer npx |
20260 |
parameter ( npx = 1 ) |
20261 |
integer npy |
20262 |
parameter ( npy = 1 ) |
20263 |
integer nr |
20264 |
parameter ( nr = 15 ) |
20265 |
integer nsx |
20266 |
parameter ( nsx = 1 ) |
20267 |
integer nsy |
20268 |
parameter ( nsy = 1 ) |
20269 |
integer snx |
20270 |
parameter ( snx = 20 ) |
20271 |
integer nx |
20272 |
parameter ( nx = snx*nsx*npx ) |
20273 |
integer sny |
20274 |
parameter ( sny = 40 ) |
20275 |
integer ny |
20276 |
parameter ( ny = sny*nsy*npy ) |
20277 |
integer olx |
20278 |
parameter ( olx = 3 ) |
20279 |
integer oly |
20280 |
parameter ( oly = 3 ) |
20281 |
|
20282 |
C============================================== |
20283 |
C define common blocks |
20284 |
C============================================== |
20285 |
common /parm_r/ cg2dtargetresidual, cg2dpcoffdfac, |
20286 |
$cg3dtargetresidual, delp, delz, delr, delx, dely, deltat, |
20287 |
$deltatmom, deltattracer, deltatclock, abeps, starttime, phimin, |
20288 |
$thetamin, rsphere, recip_rsphere, f0, fcori, beta, viscah, viscaz, |
20289 |
$ visca4, viscar, diffkht, diffkzt, diffk4t, diffkrt, diffkhs, |
20290 |
$diffkzs, diffk4s, diffkrs, delt, taucd, rcd, freesurffac, |
20291 |
$implicsurfpress, implicdiv2dflow, hfacmin, hfacmindz, gravity, |
20292 |
$recip_gravity, gbaro, rhonil, recip_rhonil, recip_rhoconst, |
20293 |
$rhoconst, tref, sref, endtime, chkptfreq, pchkptfreq, dumpfreq, |
20294 |
$tavefreq, affacmom, vffacmom, pffacmom, cffacmom, fofacmom, |
20295 |
$mtfacmom, cospower, cadjfreq, omega, tauthetaclimrelax, |
20296 |
$lambdathetaclimrelax, tausaltclimrelax, lambdasaltclimrelax, |
20297 |
$externforcingcycle, externforcingperiod, viscap, diffkpt, diffkps, |
20298 |
$ hfacmindr, hfacmindp, theta_s, specvol_s, horivertratio, |
20299 |
$recip_horivertratio, latfftfiltlo, ivdc_kappa, ro_sealevel, |
20300 |
$zonal_filt_lat, bottomdraglinear, bottomdragquadratic |
20301 |
double precision abeps |
20302 |
double precision affacmom |
20303 |
double precision beta |
20304 |
double precision bottomdraglinear |
20305 |
double precision bottomdragquadratic |
20306 |
double precision cadjfreq |
20307 |
double precision cffacmom |
20308 |
double precision cg2dpcoffdfac |
20309 |
double precision cg2dtargetresidual |
20310 |
double precision cg3dtargetresidual |
20311 |
double precision chkptfreq |
20312 |
double precision cospower |
20313 |
double precision delp(nr) |
20314 |
double precision delr(nr) |
20315 |
double precision delt |
20316 |
double precision deltat |
20317 |
double precision deltatclock |
20318 |
double precision deltatmom |
20319 |
double precision deltattracer |
20320 |
double precision delx(nx) |
20321 |
double precision dely(ny) |
20322 |
double precision delz(nr) |
20323 |
double precision diffk4s |
20324 |
double precision diffk4t |
20325 |
double precision diffkhs |
20326 |
double precision diffkht |
20327 |
double precision diffkps |
20328 |
double precision diffkpt |
20329 |
double precision diffkrs |
20330 |
double precision diffkrt |
20331 |
double precision diffkzs |
20332 |
double precision diffkzt |
20333 |
double precision dumpfreq |
20334 |
double precision endtime |
20335 |
double precision externforcingcycle |
20336 |
double precision externforcingperiod |
20337 |
double precision f0 |
20338 |
double precision fcori(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
20339 |
double precision fofacmom |
20340 |
double precision freesurffac |
20341 |
double precision gbaro |
20342 |
double precision gravity |
20343 |
double precision hfacmin |
20344 |
double precision hfacmindp |
20345 |
double precision hfacmindr |
20346 |
double precision hfacmindz |
20347 |
double precision horivertratio |
20348 |
double precision implicdiv2dflow |
20349 |
double precision implicsurfpress |
20350 |
double precision ivdc_kappa |
20351 |
double precision lambdasaltclimrelax |
20352 |
double precision lambdathetaclimrelax |
20353 |
double precision latfftfiltlo |
20354 |
double precision mtfacmom |
20355 |
double precision omega |
20356 |
double precision pchkptfreq |
20357 |
double precision pffacmom |
20358 |
double precision phimin |
20359 |
double precision rcd |
20360 |
double precision recip_gravity |
20361 |
double precision recip_horivertratio |
20362 |
double precision recip_rhoconst |
20363 |
double precision recip_rhonil |
20364 |
double precision recip_rsphere |
20365 |
double precision rhoconst |
20366 |
double precision rhonil |
20367 |
double precision ro_sealevel |
20368 |
double precision rsphere |
20369 |
double precision specvol_s(nr) |
20370 |
double precision sref(nr) |
20371 |
double precision starttime |
20372 |
double precision taucd |
20373 |
double precision tausaltclimrelax |
20374 |
double precision tauthetaclimrelax |
20375 |
double precision tavefreq |
20376 |
double precision theta_s(nr) |
20377 |
double precision thetamin |
20378 |
double precision tref(nr) |
20379 |
double precision vffacmom |
20380 |
double precision visca4 |
20381 |
double precision viscah |
20382 |
double precision viscap |
20383 |
double precision viscar |
20384 |
double precision viscaz |
20385 |
double precision zonal_filt_lat |
20386 |
|
20387 |
C============================================== |
20388 |
C define arguments |
20389 |
C============================================== |
20390 |
double precision adgtracer(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
20391 |
double precision adgtrnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
20392 |
double precision adtracer(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
20393 |
integer bi |
20394 |
integer bj |
20395 |
integer imax |
20396 |
integer imin |
20397 |
integer jmax |
20398 |
integer jmin |
20399 |
integer k |
20400 |
|
20401 |
C============================================== |
20402 |
C define local variables |
20403 |
C============================================== |
20404 |
double precision ab05 |
20405 |
double precision ab15 |
20406 |
integer i |
20407 |
integer j |
20408 |
|
20409 |
C---------------------------------------------- |
20410 |
C ROUTINE BODY |
20411 |
C---------------------------------------------- |
20412 |
ab15 = 1.5+abeps |
20413 |
ab05 = (-0.5)-abeps |
20414 |
do j = jmin, jmax |
20415 |
do i = imin, imax |
20416 |
adgtracer(i,j,k,bi,bj) = adgtracer(i,j,k,bi,bj)+adgtrnm1(i,j, |
20417 |
$k,bi,bj)*deltattracer*ab15 |
20418 |
adtracer(i,j,k,bi,bj) = adtracer(i,j,k,bi,bj)+adgtrnm1(i,j,k, |
20419 |
$bi,bj) |
20420 |
adgtrnm1(i,j,k,bi,bj) = adgtrnm1(i,j,k,bi,bj)*deltattracer* |
20421 |
$ab05 |
20422 |
end do |
20423 |
end do |
20424 |
|
20425 |
end |
20426 |
|
20427 |
|
20428 |
subroutine adwscale( sigma, hbl, ustar, bfsfc, adsigma, adhbl, |
20429 |
$adustar, adbfsfc, adwm, adws ) |
20430 |
C*************************************************************** |
20431 |
C*************************************************************** |
20432 |
C** This routine was generated by the ** |
20433 |
C** Tangent linear and Adjoint Model Compiler, TAMC 5.2.14 ** |
20434 |
C*************************************************************** |
20435 |
C*************************************************************** |
20436 |
C============================================== |
20437 |
C all entries are defined explicitly |
20438 |
C============================================== |
20439 |
implicit none |
20440 |
|
20441 |
C============================================== |
20442 |
C define parameters |
20443 |
C============================================== |
20444 |
integer olx |
20445 |
parameter ( olx = 3 ) |
20446 |
integer oly |
20447 |
parameter ( oly = 3 ) |
20448 |
integer snx |
20449 |
parameter ( snx = 20 ) |
20450 |
integer sny |
20451 |
parameter ( sny = 40 ) |
20452 |
integer imt |
20453 |
parameter ( imt = (snx+2*olx)*(sny+2*oly) ) |
20454 |
integer nni |
20455 |
parameter ( nni = 890 ) |
20456 |
integer nnj |
20457 |
parameter ( nnj = 480 ) |
20458 |
|
20459 |
C============================================== |
20460 |
C define common blocks |
20461 |
C============================================== |
20462 |
common /kmixcom/ epsln, phepsi, epsilon, vonk, db_dz, conc1, |
20463 |
$conam, concm, conc2, zetam, conas, concs, conc3, zetas |
20464 |
double precision conam |
20465 |
double precision conas |
20466 |
double precision conc1 |
20467 |
double precision conc2 |
20468 |
double precision conc3 |
20469 |
double precision concm |
20470 |
double precision concs |
20471 |
double precision db_dz |
20472 |
double precision epsilon |
20473 |
double precision epsln |
20474 |
double precision phepsi |
20475 |
double precision vonk |
20476 |
double precision zetam |
20477 |
double precision zetas |
20478 |
|
20479 |
common /kmixcws/ wmt, wst, deltaz, deltau, zmin, zmax, umin, umax |
20480 |
double precision deltau |
20481 |
double precision deltaz |
20482 |
double precision umax |
20483 |
double precision umin |
20484 |
double precision wmt(0:nni+1,0:nnj+1) |
20485 |
double precision wst(0:nni+1,0:nnj+1) |
20486 |
double precision zmax |
20487 |
double precision zmin |
20488 |
|
20489 |
C============================================== |
20490 |
C define arguments |
20491 |
C============================================== |
20492 |
double precision adbfsfc(imt) |
20493 |
double precision adhbl(imt) |
20494 |
double precision adsigma(imt) |
20495 |
double precision adustar(imt) |
20496 |
double precision adwm(imt) |
20497 |
double precision adws(imt) |
20498 |
double precision bfsfc(imt) |
20499 |
double precision hbl(imt) |
20500 |
double precision sigma(imt) |
20501 |
double precision ustar(imt) |
20502 |
|
20503 |
C============================================== |
20504 |
C define local variables |
20505 |
C============================================== |
20506 |
double precision adfzfrac |
20507 |
double precision adtempvar |
20508 |
double precision adu3 |
20509 |
double precision adudiff |
20510 |
double precision adufrac |
20511 |
double precision adwam |
20512 |
double precision adwas |
20513 |
double precision adwbm |
20514 |
double precision adwbs |
20515 |
double precision adzdiff |
20516 |
double precision adzehat |
20517 |
double precision adzfrac |
20518 |
double precision fzfrac |
20519 |
integer i |
20520 |
integer iz |
20521 |
integer izp1 |
20522 |
integer ju |
20523 |
integer jup1 |
20524 |
double precision tempvar |
20525 |
double precision u3 |
20526 |
double precision udiff |
20527 |
double precision ufrac |
20528 |
double precision wam |
20529 |
double precision was |
20530 |
double precision wbm |
20531 |
double precision wbs |
20532 |
double precision zdiff |
20533 |
double precision zehat |
20534 |
double precision zfrac |
20535 |
|
20536 |
C---------------------------------------------- |
20537 |
C RESET LOCAL ADJOINT VARIABLES |
20538 |
C---------------------------------------------- |
20539 |
adfzfrac = 0.d0 |
20540 |
adtempvar = 0.d0 |
20541 |
adu3 = 0.d0 |
20542 |
adudiff = 0.d0 |
20543 |
adufrac = 0.d0 |
20544 |
adwam = 0.d0 |
20545 |
adwas = 0.d0 |
20546 |
adwbm = 0.d0 |
20547 |
adwbs = 0.d0 |
20548 |
adzdiff = 0.d0 |
20549 |
adzehat = 0.d0 |
20550 |
adzfrac = 0.d0 |
20551 |
|
20552 |
C---------------------------------------------- |
20553 |
C ROUTINE BODY |
20554 |
C---------------------------------------------- |
20555 |
do i = 1, imt |
20556 |
adfzfrac = 0.d0 |
20557 |
adtempvar = 0.d0 |
20558 |
adu3 = 0.d0 |
20559 |
adudiff = 0.d0 |
20560 |
adufrac = 0.d0 |
20561 |
adwam = 0.d0 |
20562 |
adwas = 0.d0 |
20563 |
adwbm = 0.d0 |
20564 |
adwbs = 0.d0 |
20565 |
adzdiff = 0.d0 |
20566 |
adzehat = 0.d0 |
20567 |
adzfrac = 0.d0 |
20568 |
zehat = vonk*sigma(i)*hbl(i)*bfsfc(i) |
20569 |
if (zehat .le. zmax) then |
20570 |
zdiff = zehat-zmin |
20571 |
iz = int(zdiff/deltaz) |
20572 |
iz = min(iz,nni) |
20573 |
iz = max(iz,0) |
20574 |
izp1 = iz+1 |
20575 |
udiff = ustar(i)-umin |
20576 |
ju = int(udiff/deltau) |
20577 |
ju = min(ju,nnj) |
20578 |
ju = max(ju,0) |
20579 |
jup1 = ju+1 |
20580 |
zfrac = zdiff/deltaz-float(iz) |
20581 |
ufrac = udiff/deltau-float(ju) |
20582 |
fzfrac = 1.-zfrac |
20583 |
wam = fzfrac*wmt(iz,jup1)+zfrac*wmt(izp1,jup1) |
20584 |
wbm = fzfrac*wmt(iz,ju)+zfrac*wmt(izp1,ju) |
20585 |
was = fzfrac*wst(iz,jup1)+zfrac*wst(izp1,jup1) |
20586 |
wbs = fzfrac*wst(iz,ju)+zfrac*wst(izp1,ju) |
20587 |
adufrac = adufrac+adws(i)*((-wbs)+was) |
20588 |
adwas = adwas+adws(i)*ufrac |
20589 |
adwbs = adwbs+adws(i)*(1.-ufrac) |
20590 |
adws(i) = 0.d0 |
20591 |
adfzfrac = adfzfrac+adwbs*wst(iz,ju) |
20592 |
adzfrac = adzfrac+adwbs*wst(izp1,ju) |
20593 |
adwbs = 0.d0 |
20594 |
adfzfrac = adfzfrac+adwas*wst(iz,jup1) |
20595 |
adzfrac = adzfrac+adwas*wst(izp1,jup1) |
20596 |
adwas = 0.d0 |
20597 |
adufrac = adufrac+adwm(i)*((-wbm)+wam) |
20598 |
adwam = adwam+adwm(i)*ufrac |
20599 |
adwbm = adwbm+adwm(i)*(1.-ufrac) |
20600 |
adwm(i) = 0.d0 |
20601 |
adfzfrac = adfzfrac+adwbm*wmt(iz,ju) |
20602 |
adzfrac = adzfrac+adwbm*wmt(izp1,ju) |
20603 |
adwbm = 0.d0 |
20604 |
adfzfrac = adfzfrac+adwam*wmt(iz,jup1) |
20605 |
adzfrac = adzfrac+adwam*wmt(izp1,jup1) |
20606 |
adwam = 0.d0 |
20607 |
adzfrac = adzfrac-adfzfrac |
20608 |
adfzfrac = 0.d0 |
20609 |
adudiff = adudiff+adufrac/deltau |
20610 |
adufrac = 0.d0 |
20611 |
adzdiff = adzdiff+adzfrac/deltaz |
20612 |
adzfrac = 0.d0 |
20613 |
adustar(i) = adustar(i)+adudiff |
20614 |
adudiff = 0.d0 |
20615 |
adzehat = adzehat+adzdiff |
20616 |
adzdiff = 0.d0 |
20617 |
else |
20618 |
u3 = ustar(i)*ustar(i)*ustar(i) |
20619 |
tempvar = u3+conc1*zehat |
20620 |
adwm(i) = adwm(i)+adws(i) |
20621 |
adws(i) = 0.d0 |
20622 |
adtempvar = adtempvar-adwm(i)*(vonk*ustar(i)*u3/(tempvar* |
20623 |
$tempvar)) |
20624 |
adu3 = adu3+adwm(i)*(vonk*ustar(i)/tempvar) |
20625 |
adustar(i) = adustar(i)+adwm(i)*(vonk*u3/tempvar) |
20626 |
adwm(i) = 0.d0 |
20627 |
adu3 = adu3+adtempvar |
20628 |
adzehat = adzehat+adtempvar*conc1 |
20629 |
adtempvar = 0.d0 |
20630 |
adustar(i) = adustar(i)+3*adu3*ustar(i)*ustar(i) |
20631 |
adu3 = 0.d0 |
20632 |
endif |
20633 |
adbfsfc(i) = adbfsfc(i)+adzehat*vonk*sigma(i)*hbl(i) |
20634 |
adhbl(i) = adhbl(i)+adzehat*vonk*sigma(i)*bfsfc(i) |
20635 |
adsigma(i) = adsigma(i)+adzehat*vonk*hbl(i)*bfsfc(i) |
20636 |
adzehat = 0.d0 |
20637 |
end do |
20638 |
|
20639 |
end |
20640 |
|
20641 |
|
20642 |
subroutine adzero |
20643 |
C*************************************************************** |
20644 |
C*************************************************************** |
20645 |
C** This routine was generated by the ** |
20646 |
C** Tangent linear and Adjoint Model Compiler, TAMC 5.2.14 ** |
20647 |
C*************************************************************** |
20648 |
C*************************************************************** |
20649 |
C============================================== |
20650 |
C all entries are defined explicitly |
20651 |
C============================================== |
20652 |
implicit none |
20653 |
|
20654 |
C============================================== |
20655 |
C define parameters |
20656 |
C============================================== |
20657 |
integer nr |
20658 |
parameter ( nr = 15 ) |
20659 |
integer nsx |
20660 |
parameter ( nsx = 1 ) |
20661 |
integer nsy |
20662 |
parameter ( nsy = 1 ) |
20663 |
integer olx |
20664 |
parameter ( olx = 3 ) |
20665 |
integer oly |
20666 |
parameter ( oly = 3 ) |
20667 |
integer snx |
20668 |
parameter ( snx = 20 ) |
20669 |
integer sny |
20670 |
parameter ( sny = 40 ) |
20671 |
|
20672 |
C============================================== |
20673 |
C define common blocks |
20674 |
C============================================== |
20675 |
common /adcontrolvars_r/ adtmpfld2d, adtmpfld3d |
20676 |
double precision adtmpfld2d(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
20677 |
double precision adtmpfld3d(1-olx:snx+olx,1-oly:sny+oly,nr,nsx, |
20678 |
$nsy) |
20679 |
|
20680 |
common /adcost_r/ adfc, adobjf_test |
20681 |
double precision adfc |
20682 |
double precision adobjf_test(nsx,nsy) |
20683 |
|
20684 |
common /addynvars_cd/ aduveld, advveld, adetanm1, adunm1, advnm1, |
20685 |
$adgucd, adgvcd |
20686 |
double precision adetanm1(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
20687 |
double precision adgucd(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
20688 |
double precision adgvcd(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
20689 |
double precision adunm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
20690 |
double precision aduveld(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
20691 |
double precision advnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
20692 |
double precision advveld(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
20693 |
|
20694 |
common /addynvars_r/ adetan, aduvel, advvel, adwvel, adtheta, |
20695 |
$adsalt, adgu, adgv, adgt, adgs, adgunm1, adgvnm1, adgtnm1, adgsnm1 |
20696 |
double precision adetan(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
20697 |
double precision adgs(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
20698 |
double precision adgsnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
20699 |
double precision adgt(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
20700 |
double precision adgtnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
20701 |
double precision adgu(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
20702 |
double precision adgunm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
20703 |
double precision adgv(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
20704 |
double precision adgvnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
20705 |
double precision adsalt(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
20706 |
double precision adtheta(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
20707 |
double precision aduvel(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
20708 |
double precision advvel(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
20709 |
double precision adwvel(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
20710 |
|
20711 |
common /adffields/ adfu, adfv, adqnet, adempmr |
20712 |
double precision adempmr(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
20713 |
double precision adfu(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
20714 |
double precision adfv(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
20715 |
double precision adqnet(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
20716 |
|
20717 |
common /adgm_wtensor/ adgm_wtensor1, adgm_wtensor2, adgm_wtensor3 |
20718 |
double precision adgm_wtensor1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx, |
20719 |
$nsy) |
20720 |
double precision adgm_wtensor2(1-olx:snx+olx,1-oly:sny+oly,nr,nsx, |
20721 |
$nsy) |
20722 |
double precision adgm_wtensor3(1-olx:snx+olx,1-oly:sny+oly,nr,nsx, |
20723 |
$nsy) |
20724 |
|
20725 |
common /adkpp/ adkpp1, adkpp2, adkpp3, adkpp4, adkpp5 |
20726 |
double precision adkpp1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
20727 |
double precision adkpp2(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
20728 |
double precision adkpp3(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
20729 |
double precision adkpp4(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) |
20730 |
double precision adkpp5(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
20731 |
|
20732 |
common /adkpp_short/ adkpp_short1 |
20733 |
double precision adkpp_short1(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
20734 |
|
20735 |
common /adtendency_forcing/ adsurfacetendencyu, |
20736 |
$adsurfacetendencyv, adsurfacetendencyt, adsurfacetendencys |
20737 |
double precision adsurfacetendencys(1-olx:snx+olx,1-oly:sny+oly, |
20738 |
$nsx,nsy) |
20739 |
double precision adsurfacetendencyt(1-olx:snx+olx,1-oly:sny+oly, |
20740 |
$nsx,nsy) |
20741 |
double precision adsurfacetendencyu(1-olx:snx+olx,1-oly:sny+oly, |
20742 |
$nsx,nsy) |
20743 |
double precision adsurfacetendencyv(1-olx:snx+olx,1-oly:sny+oly, |
20744 |
$nsx,nsy) |
20745 |
|
20746 |
C============================================== |
20747 |
C define local variables |
20748 |
C============================================== |
20749 |
integer ip1 |
20750 |
integer ip2 |
20751 |
integer ip3 |
20752 |
integer ip4 |
20753 |
integer ip5 |
20754 |
|
20755 |
do ip4 = 1, nsy |
20756 |
do ip3 = 1, nsx |
20757 |
do ip2 = 1-oly, sny+oly |
20758 |
do ip1 = 1-olx, snx+olx |
20759 |
adtmpfld2d(ip1,ip2,ip3,ip4) = 0.d0 |
20760 |
end do |
20761 |
end do |
20762 |
end do |
20763 |
end do |
20764 |
do ip5 = 1, nsy |
20765 |
do ip4 = 1, nsx |
20766 |
do ip3 = 1, nr |
20767 |
do ip2 = 1-oly, sny+oly |
20768 |
do ip1 = 1-olx, snx+olx |
20769 |
adtmpfld3d(ip1,ip2,ip3,ip4,ip5) = 0.d0 |
20770 |
end do |
20771 |
end do |
20772 |
end do |
20773 |
end do |
20774 |
end do |
20775 |
do ip2 = 1, nsy |
20776 |
do ip1 = 1, nsx |
20777 |
adobjf_test(ip1,ip2) = 0.d0 |
20778 |
end do |
20779 |
end do |
20780 |
do ip5 = 1, nsy |
20781 |
do ip4 = 1, nsx |
20782 |
do ip3 = 1, nr |
20783 |
do ip2 = 1-oly, sny+oly |
20784 |
do ip1 = 1-olx, snx+olx |
20785 |
aduveld(ip1,ip2,ip3,ip4,ip5) = 0.d0 |
20786 |
end do |
20787 |
end do |
20788 |
end do |
20789 |
end do |
20790 |
end do |
20791 |
do ip5 = 1, nsy |
20792 |
do ip4 = 1, nsx |
20793 |
do ip3 = 1, nr |
20794 |
do ip2 = 1-oly, sny+oly |
20795 |
do ip1 = 1-olx, snx+olx |
20796 |
advveld(ip1,ip2,ip3,ip4,ip5) = 0.d0 |
20797 |
end do |
20798 |
end do |
20799 |
end do |
20800 |
end do |
20801 |
end do |
20802 |
do ip4 = 1, nsy |
20803 |
do ip3 = 1, nsx |
20804 |
do ip2 = 1-oly, sny+oly |
20805 |
do ip1 = 1-olx, snx+olx |
20806 |
adetanm1(ip1,ip2,ip3,ip4) = 0.d0 |
20807 |
end do |
20808 |
end do |
20809 |
end do |
20810 |
end do |
20811 |
do ip5 = 1, nsy |
20812 |
do ip4 = 1, nsx |
20813 |
do ip3 = 1, nr |
20814 |
do ip2 = 1-oly, sny+oly |
20815 |
do ip1 = 1-olx, snx+olx |
20816 |
adunm1(ip1,ip2,ip3,ip4,ip5) = 0.d0 |
20817 |
end do |
20818 |
end do |
20819 |
end do |
20820 |
end do |
20821 |
end do |
20822 |
do ip5 = 1, nsy |
20823 |
do ip4 = 1, nsx |
20824 |
do ip3 = 1, nr |
20825 |
do ip2 = 1-oly, sny+oly |
20826 |
do ip1 = 1-olx, snx+olx |
20827 |
advnm1(ip1,ip2,ip3,ip4,ip5) = 0.d0 |
20828 |
end do |
20829 |
end do |
20830 |
end do |
20831 |
end do |
20832 |
end do |
20833 |
do ip5 = 1, nsy |
20834 |
do ip4 = 1, nsx |
20835 |
do ip3 = 1, nr |
20836 |
do ip2 = 1-oly, sny+oly |
20837 |
do ip1 = 1-olx, snx+olx |
20838 |
adgucd(ip1,ip2,ip3,ip4,ip5) = 0.d0 |
20839 |
end do |
20840 |
end do |
20841 |
end do |
20842 |
end do |
20843 |
end do |
20844 |
do ip5 = 1, nsy |
20845 |
do ip4 = 1, nsx |
20846 |
do ip3 = 1, nr |
20847 |
do ip2 = 1-oly, sny+oly |
20848 |
do ip1 = 1-olx, snx+olx |
20849 |
adgvcd(ip1,ip2,ip3,ip4,ip5) = 0.d0 |
20850 |
end do |
20851 |
end do |
20852 |
end do |
20853 |
end do |
20854 |
end do |
20855 |
do ip4 = 1, nsy |
20856 |
do ip3 = 1, nsx |
20857 |
do ip2 = 1-oly, sny+oly |
20858 |
do ip1 = 1-olx, snx+olx |
20859 |
adetan(ip1,ip2,ip3,ip4) = 0.d0 |
20860 |
end do |
20861 |
end do |
20862 |
end do |
20863 |
end do |
20864 |
do ip5 = 1, nsy |
20865 |
do ip4 = 1, nsx |
20866 |
do ip3 = 1, nr |
20867 |
do ip2 = 1-oly, sny+oly |
20868 |
do ip1 = 1-olx, snx+olx |
20869 |
aduvel(ip1,ip2,ip3,ip4,ip5) = 0.d0 |
20870 |
end do |
20871 |
end do |
20872 |
end do |
20873 |
end do |
20874 |
end do |
20875 |
do ip5 = 1, nsy |
20876 |
do ip4 = 1, nsx |
20877 |
do ip3 = 1, nr |
20878 |
do ip2 = 1-oly, sny+oly |
20879 |
do ip1 = 1-olx, snx+olx |
20880 |
advvel(ip1,ip2,ip3,ip4,ip5) = 0.d0 |
20881 |
end do |
20882 |
end do |
20883 |
end do |
20884 |
end do |
20885 |
end do |
20886 |
do ip5 = 1, nsy |
20887 |
do ip4 = 1, nsx |
20888 |
do ip3 = 1, nr |
20889 |
do ip2 = 1-oly, sny+oly |
20890 |
do ip1 = 1-olx, snx+olx |
20891 |
adwvel(ip1,ip2,ip3,ip4,ip5) = 0.d0 |
20892 |
end do |
20893 |
end do |
20894 |
end do |
20895 |
end do |
20896 |
end do |
20897 |
do ip5 = 1, nsy |
20898 |
do ip4 = 1, nsx |
20899 |
do ip3 = 1, nr |
20900 |
do ip2 = 1-oly, sny+oly |
20901 |
do ip1 = 1-olx, snx+olx |
20902 |
adtheta(ip1,ip2,ip3,ip4,ip5) = 0.d0 |
20903 |
end do |
20904 |
end do |
20905 |
end do |
20906 |
end do |
20907 |
end do |
20908 |
do ip5 = 1, nsy |
20909 |
do ip4 = 1, nsx |
20910 |
do ip3 = 1, nr |
20911 |
do ip2 = 1-oly, sny+oly |
20912 |
do ip1 = 1-olx, snx+olx |
20913 |
adsalt(ip1,ip2,ip3,ip4,ip5) = 0.d0 |
20914 |
end do |
20915 |
end do |
20916 |
end do |
20917 |
end do |
20918 |
end do |
20919 |
do ip5 = 1, nsy |
20920 |
do ip4 = 1, nsx |
20921 |
do ip3 = 1, nr |
20922 |
do ip2 = 1-oly, sny+oly |
20923 |
do ip1 = 1-olx, snx+olx |
20924 |
adgu(ip1,ip2,ip3,ip4,ip5) = 0.d0 |
20925 |
end do |
20926 |
end do |
20927 |
end do |
20928 |
end do |
20929 |
end do |
20930 |
do ip5 = 1, nsy |
20931 |
do ip4 = 1, nsx |
20932 |
do ip3 = 1, nr |
20933 |
do ip2 = 1-oly, sny+oly |
20934 |
do ip1 = 1-olx, snx+olx |
20935 |
adgv(ip1,ip2,ip3,ip4,ip5) = 0.d0 |
20936 |
end do |
20937 |
end do |
20938 |
end do |
20939 |
end do |
20940 |
end do |
20941 |
do ip5 = 1, nsy |
20942 |
do ip4 = 1, nsx |
20943 |
do ip3 = 1, nr |
20944 |
do ip2 = 1-oly, sny+oly |
20945 |
do ip1 = 1-olx, snx+olx |
20946 |
adgt(ip1,ip2,ip3,ip4,ip5) = 0.d0 |
20947 |
end do |
20948 |
end do |
20949 |
end do |
20950 |
end do |
20951 |
end do |
20952 |
do ip5 = 1, nsy |
20953 |
do ip4 = 1, nsx |
20954 |
do ip3 = 1, nr |
20955 |
do ip2 = 1-oly, sny+oly |
20956 |
do ip1 = 1-olx, snx+olx |
20957 |
adgs(ip1,ip2,ip3,ip4,ip5) = 0.d0 |
20958 |
end do |
20959 |
end do |
20960 |
end do |
20961 |
end do |
20962 |
end do |
20963 |
do ip5 = 1, nsy |
20964 |
do ip4 = 1, nsx |
20965 |
do ip3 = 1, nr |
20966 |
do ip2 = 1-oly, sny+oly |
20967 |
do ip1 = 1-olx, snx+olx |
20968 |
adgunm1(ip1,ip2,ip3,ip4,ip5) = 0.d0 |
20969 |
end do |
20970 |
end do |
20971 |
end do |
20972 |
end do |
20973 |
end do |
20974 |
do ip5 = 1, nsy |
20975 |
do ip4 = 1, nsx |
20976 |
do ip3 = 1, nr |
20977 |
do ip2 = 1-oly, sny+oly |
20978 |
do ip1 = 1-olx, snx+olx |
20979 |
adgvnm1(ip1,ip2,ip3,ip4,ip5) = 0.d0 |
20980 |
end do |
20981 |
end do |
20982 |
end do |
20983 |
end do |
20984 |
end do |
20985 |
do ip5 = 1, nsy |
20986 |
do ip4 = 1, nsx |
20987 |
do ip3 = 1, nr |
20988 |
do ip2 = 1-oly, sny+oly |
20989 |
do ip1 = 1-olx, snx+olx |
20990 |
adgtnm1(ip1,ip2,ip3,ip4,ip5) = 0.d0 |
20991 |
end do |
20992 |
end do |
20993 |
end do |
20994 |
end do |
20995 |
end do |
20996 |
do ip5 = 1, nsy |
20997 |
do ip4 = 1, nsx |
20998 |
do ip3 = 1, nr |
20999 |
do ip2 = 1-oly, sny+oly |
21000 |
do ip1 = 1-olx, snx+olx |
21001 |
adgsnm1(ip1,ip2,ip3,ip4,ip5) = 0.d0 |
21002 |
end do |
21003 |
end do |
21004 |
end do |
21005 |
end do |
21006 |
end do |
21007 |
do ip4 = 1, nsy |
21008 |
do ip3 = 1, nsx |
21009 |
do ip2 = 1-oly, sny+oly |
21010 |
do ip1 = 1-olx, snx+olx |
21011 |
adfu(ip1,ip2,ip3,ip4) = 0.d0 |
21012 |
end do |
21013 |
end do |
21014 |
end do |
21015 |
end do |
21016 |
do ip4 = 1, nsy |
21017 |
do ip3 = 1, nsx |
21018 |
do ip2 = 1-oly, sny+oly |
21019 |
do ip1 = 1-olx, snx+olx |
21020 |
adfv(ip1,ip2,ip3,ip4) = 0.d0 |
21021 |
end do |
21022 |
end do |
21023 |
end do |
21024 |
end do |
21025 |
do ip4 = 1, nsy |
21026 |
do ip3 = 1, nsx |
21027 |
do ip2 = 1-oly, sny+oly |
21028 |
do ip1 = 1-olx, snx+olx |
21029 |
adqnet(ip1,ip2,ip3,ip4) = 0.d0 |
21030 |
end do |
21031 |
end do |
21032 |
end do |
21033 |
end do |
21034 |
do ip4 = 1, nsy |
21035 |
do ip3 = 1, nsx |
21036 |
do ip2 = 1-oly, sny+oly |
21037 |
do ip1 = 1-olx, snx+olx |
21038 |
adempmr(ip1,ip2,ip3,ip4) = 0.d0 |
21039 |
end do |
21040 |
end do |
21041 |
end do |
21042 |
end do |
21043 |
do ip5 = 1, nsy |
21044 |
do ip4 = 1, nsx |
21045 |
do ip3 = 1, nr |
21046 |
do ip2 = 1-oly, sny+oly |
21047 |
do ip1 = 1-olx, snx+olx |
21048 |
adgm_wtensor1(ip1,ip2,ip3,ip4,ip5) = 0.d0 |
21049 |
end do |
21050 |
end do |
21051 |
end do |
21052 |
end do |
21053 |
end do |
21054 |
do ip5 = 1, nsy |
21055 |
do ip4 = 1, nsx |
21056 |
do ip3 = 1, nr |
21057 |
do ip2 = 1-oly, sny+oly |
21058 |
do ip1 = 1-olx, snx+olx |
21059 |
adgm_wtensor2(ip1,ip2,ip3,ip4,ip5) = 0.d0 |
21060 |
end do |
21061 |
end do |
21062 |
end do |
21063 |
end do |
21064 |
end do |
21065 |
do ip5 = 1, nsy |
21066 |
do ip4 = 1, nsx |
21067 |
do ip3 = 1, nr |
21068 |
do ip2 = 1-oly, sny+oly |
21069 |
do ip1 = 1-olx, snx+olx |
21070 |
adgm_wtensor3(ip1,ip2,ip3,ip4,ip5) = 0.d0 |
21071 |
end do |
21072 |
end do |
21073 |
end do |
21074 |
end do |
21075 |
end do |
21076 |
do ip5 = 1, nsy |
21077 |
do ip4 = 1, nsx |
21078 |
do ip3 = 1, nr |
21079 |
do ip2 = 1-oly, sny+oly |
21080 |
do ip1 = 1-olx, snx+olx |
21081 |
adkpp1(ip1,ip2,ip3,ip4,ip5) = 0.d0 |
21082 |
end do |
21083 |
end do |
21084 |
end do |
21085 |
end do |
21086 |
end do |
21087 |
do ip5 = 1, nsy |
21088 |
do ip4 = 1, nsx |
21089 |
do ip3 = 1, nr |
21090 |
do ip2 = 1-oly, sny+oly |
21091 |
do ip1 = 1-olx, snx+olx |
21092 |
adkpp2(ip1,ip2,ip3,ip4,ip5) = 0.d0 |
21093 |
end do |
21094 |
end do |
21095 |
end do |
21096 |
end do |
21097 |
end do |
21098 |
do ip5 = 1, nsy |
21099 |
do ip4 = 1, nsx |
21100 |
do ip3 = 1, nr |
21101 |
do ip2 = 1-oly, sny+oly |
21102 |
do ip1 = 1-olx, snx+olx |
21103 |
adkpp3(ip1,ip2,ip3,ip4,ip5) = 0.d0 |
21104 |
end do |
21105 |
end do |
21106 |
end do |
21107 |
end do |
21108 |
end do |
21109 |
do ip5 = 1, nsy |
21110 |
do ip4 = 1, nsx |
21111 |
do ip3 = 1, nr |
21112 |
do ip2 = 1-oly, sny+oly |
21113 |
do ip1 = 1-olx, snx+olx |
21114 |
adkpp4(ip1,ip2,ip3,ip4,ip5) = 0.d0 |
21115 |
end do |
21116 |
end do |
21117 |
end do |
21118 |
end do |
21119 |
end do |
21120 |
do ip4 = 1, nsy |
21121 |
do ip3 = 1, nsx |
21122 |
do ip2 = 1-oly, sny+oly |
21123 |
do ip1 = 1-olx, snx+olx |
21124 |
adkpp5(ip1,ip2,ip3,ip4) = 0.d0 |
21125 |
end do |
21126 |
end do |
21127 |
end do |
21128 |
end do |
21129 |
do ip4 = 1, nsy |
21130 |
do ip3 = 1, nsx |
21131 |
do ip2 = 1-oly, sny+oly |
21132 |
do ip1 = 1-olx, snx+olx |
21133 |
adkpp_short1(ip1,ip2,ip3,ip4) = 0.d0 |
21134 |
end do |
21135 |
end do |
21136 |
end do |
21137 |
end do |
21138 |
do ip4 = 1, nsy |
21139 |
do ip3 = 1, nsx |
21140 |
do ip2 = 1-oly, sny+oly |
21141 |
do ip1 = 1-olx, snx+olx |
21142 |
adsurfacetendencyu(ip1,ip2,ip3,ip4) = 0.d0 |
21143 |
end do |
21144 |
end do |
21145 |
end do |
21146 |
end do |
21147 |
do ip4 = 1, nsy |
21148 |
do ip3 = 1, nsx |
21149 |
do ip2 = 1-oly, sny+oly |
21150 |
do ip1 = 1-olx, snx+olx |
21151 |
adsurfacetendencyv(ip1,ip2,ip3,ip4) = 0.d0 |
21152 |
end do |
21153 |
end do |
21154 |
end do |
21155 |
end do |
21156 |
do ip4 = 1, nsy |
21157 |
do ip3 = 1, nsx |
21158 |
do ip2 = 1-oly, sny+oly |
21159 |
do ip1 = 1-olx, snx+olx |
21160 |
adsurfacetendencyt(ip1,ip2,ip3,ip4) = 0.d0 |
21161 |
end do |
21162 |
end do |
21163 |
end do |
21164 |
end do |
21165 |
do ip4 = 1, nsy |
21166 |
do ip3 = 1, nsx |
21167 |
do ip2 = 1-oly, sny+oly |
21168 |
do ip1 = 1-olx, snx+olx |
21169 |
adsurfacetendencys(ip1,ip2,ip3,ip4) = 0.d0 |
21170 |
end do |
21171 |
end do |
21172 |
end do |
21173 |
end do |
21174 |
end |