1 |
C $Header$ |
C $Header$ |
2 |
|
C $Name$ |
3 |
|
|
4 |
#include "CTRL_CPPOPTIONS.h" |
#include "CTRL_CPPOPTIONS.h" |
5 |
|
|
11 |
C !DESCRIPTION: \bv |
C !DESCRIPTION: \bv |
12 |
c *================================================================= |
c *================================================================= |
13 |
c | SUBROUTINE ctrl_map_ini |
c | SUBROUTINE ctrl_map_ini |
14 |
c | Add the temperature, salinity, and diffusivity parts of the |
c | Add the temperature, salinity, and diffusivity parts of the |
15 |
c | control vector to the model state and update the tile halos. |
c | control vector to the model state and update the tile halos. |
16 |
c | The control vector is defined in the header file "ctrl.h". |
c | The control vector is defined in the header file "ctrl.h". |
17 |
c *================================================================= |
c *================================================================= |
18 |
C \ev |
C \ev |
32 |
#include "optim.h" |
#include "optim.h" |
33 |
#ifdef ALLOW_PTRACERS |
#ifdef ALLOW_PTRACERS |
34 |
# include "PTRACERS_SIZE.h" |
# include "PTRACERS_SIZE.h" |
35 |
# include "PTRACERS.h" |
c#include "PTRACERS_PARAMS.h" |
36 |
|
# include "PTRACERS_FIELDS.h" |
37 |
#endif |
#endif |
38 |
#ifdef ALLOW_ECCO |
#ifdef ALLOW_ECCO |
39 |
# include "ecco_cost.h" |
# include "ecco_cost.h" |
110 |
$ tmpfld3d(i,j,k,bi,bj)= |
$ tmpfld3d(i,j,k,bi,bj)= |
111 |
$ sign(2.0/sqrt(wtheta(k,bi,bj)),tmpfld3d(i,j,k,bi,bj)) |
$ sign(2.0/sqrt(wtheta(k,bi,bj)),tmpfld3d(i,j,k,bi,bj)) |
112 |
#endif |
#endif |
113 |
#ifdef ALLOW_OPENAD |
#ifdef ALLOW_AUTODIFF_OPENAD |
114 |
theta(i,j,k,bi,bj) = theta(i,j,k,bi,bj) + |
theta(i,j,k,bi,bj) = theta(i,j,k,bi,bj) + |
115 |
& fac*xx_theta(i,j,k,bi,bj) + |
& fac*xx_theta(i,j,k,bi,bj) + |
116 |
& fac*tmpfld3d(i,j,k,bi,bj) |
& fac*tmpfld3d(i,j,k,bi,bj) |
118 |
theta(i,j,k,bi,bj) = theta(i,j,k,bi,bj) + |
theta(i,j,k,bi,bj) = theta(i,j,k,bi,bj) + |
119 |
& fac*tmpfld3d(i,j,k,bi,bj) |
& fac*tmpfld3d(i,j,k,bi,bj) |
120 |
#endif |
#endif |
121 |
if(theta(i,j,k,bi,bj).lt.-2.0) |
#ifndef DISABLE_CTRL_THETA_LIMIT |
122 |
& theta(i,j,k,bi,bj)= -2.0 |
if(theta(i,j,k,bi,bj).lt.-2.0) |
123 |
|
& theta(i,j,k,bi,bj)= -2.0 |
124 |
|
#endif |
125 |
enddo |
enddo |
126 |
enddo |
enddo |
127 |
enddo |
enddo |
150 |
$ tmpfld3d(i,j,k,bi,bj)= |
$ tmpfld3d(i,j,k,bi,bj)= |
151 |
$ sign(2.0/sqrt(wsalt(k,bi,bj)),tmpfld3d(i,j,k,bi,bj)) |
$ sign(2.0/sqrt(wsalt(k,bi,bj)),tmpfld3d(i,j,k,bi,bj)) |
152 |
#endif |
#endif |
153 |
#ifdef ALLOW_OPENAD |
#ifdef ALLOW_AUTODIFF_OPENAD |
154 |
salt(i,j,k,bi,bj) = salt(i,j,k,bi,bj) + |
salt(i,j,k,bi,bj) = salt(i,j,k,bi,bj) + |
155 |
& fac*xx_salt(i,j,k,bi,bj) + |
& fac*xx_salt(i,j,k,bi,bj) + |
156 |
& fac*tmpfld3d(i,j,k,bi,bj) |
& fac*tmpfld3d(i,j,k,bi,bj) |
204 |
do j = jmin,jmax |
do j = jmin,jmax |
205 |
do i = imin,imax |
do i = imin,imax |
206 |
cph sst(i,j,bi,bj) = sst(i,j,bi,bj) + tmpfld2d(i,j,bi,bj) |
cph sst(i,j,bi,bj) = sst(i,j,bi,bj) + tmpfld2d(i,j,bi,bj) |
207 |
theta(i,j,1,bi,bj) = theta(i,j,1,bi,bj) |
theta(i,j,1,bi,bj) = theta(i,j,1,bi,bj) |
208 |
& + tmpfld2d(i,j,bi,bj) |
& + tmpfld2d(i,j,bi,bj) |
209 |
enddo |
enddo |
210 |
enddo |
enddo |
233 |
enddo |
enddo |
234 |
#endif |
#endif |
235 |
|
|
236 |
|
#ifdef ALLOW_AUTODIFF |
237 |
#ifdef ALLOW_DIFFKR_CONTROL |
#ifdef ALLOW_DIFFKR_CONTROL |
238 |
c-- diffkr. |
c-- diffkr. |
239 |
il=ilnblnk( xx_diffkr_file ) |
il=ilnblnk( xx_diffkr_file ) |
255 |
enddo |
enddo |
256 |
enddo |
enddo |
257 |
#endif |
#endif |
258 |
|
#endif |
259 |
|
|
260 |
|
#ifdef ALLOW_AUTODIFF |
261 |
#ifdef ALLOW_KAPGM_CONTROL |
#ifdef ALLOW_KAPGM_CONTROL |
262 |
c-- kapgm. |
c-- kapgm. |
263 |
il=ilnblnk( xx_kapgm_file ) |
il=ilnblnk( xx_kapgm_file ) |
279 |
enddo |
enddo |
280 |
enddo |
enddo |
281 |
#endif |
#endif |
282 |
|
#endif |
283 |
|
|
284 |
|
#ifdef ALLOW_AUTODIFF |
285 |
|
#ifdef ALLOW_KAPREDI_CONTROL |
286 |
|
c-- kapredi. |
287 |
|
il=ilnblnk( xx_kapredi_file ) |
288 |
|
write(fnamegeneric(1:80),'(2a,i10.10)') |
289 |
|
& xx_kapredi_file(1:il),'.',optimcycle |
290 |
|
call active_read_xyz( fnamegeneric, tmpfld3d, 1, |
291 |
|
& doglobalread, ladinit, optimcycle, |
292 |
|
& mythid, xx_kapredi_dummy ) |
293 |
|
do bj = jtlo,jthi |
294 |
|
do bi = itlo,ithi |
295 |
|
do k = 1,nr |
296 |
|
do j = jmin,jmax |
297 |
|
do i = imin,imax |
298 |
|
kapredi(i,j,k,bi,bj) = kapredi(i,j,k,bi,bj) + |
299 |
|
& tmpfld3d(i,j,k,bi,bj) |
300 |
|
enddo |
301 |
|
enddo |
302 |
|
enddo |
303 |
|
enddo |
304 |
|
enddo |
305 |
|
#endif |
306 |
|
#endif |
307 |
|
|
308 |
#ifdef ALLOW_EFLUXY0_CONTROL |
#ifdef ALLOW_EFLUXY0_CONTROL |
309 |
c-- y-component EP-flux field. |
c-- y-component EP-flux field. |
373 |
do bi = itlo,ithi |
do bi = itlo,ithi |
374 |
do j = jmin,jmax |
do j = jmin,jmax |
375 |
do i = imin,imax |
do i = imin,imax |
376 |
bottomdragfld(i,j,bi,bj) = bottomdragfld(i,j,bi,bj) |
bottomdragfld(i,j,bi,bj) = bottomdragfld(i,j,bi,bj) |
377 |
& + tmpfld2d(i,j,bi,bj) |
& + tmpfld2d(i,j,bi,bj) |
378 |
enddo |
enddo |
379 |
enddo |
enddo |
381 |
enddo |
enddo |
382 |
#endif |
#endif |
383 |
|
|
384 |
#ifdef ALLOW_EDTAUX_CONTROL |
#ifdef ALLOW_EDDYPSI_CONTROL |
385 |
c-- zonal eddy stress : edtaux |
c-- zonal eddy streamfunction : eddyPsiX |
386 |
il=ilnblnk( xx_edtaux_file ) |
il=ilnblnk( xx_edtaux_file ) |
387 |
write(fnamegeneric(1:80),'(2a,i10.10)') |
write(fnamegeneric(1:80),'(2a,i10.10)') |
388 |
& xx_edtaux_file(1:il),'.',optimcycle |
& xx_edtaux_file(1:il),'.',optimcycle |
394 |
do k = 1,nr |
do k = 1,nr |
395 |
do j = jmin,jmax |
do j = jmin,jmax |
396 |
do i = imin,imax |
do i = imin,imax |
397 |
eddyTauX(i,j,k,bi,bj) = eddyTauX(i,j,k,bi,bj) + |
eddyPsiX(i,j,k,bi,bj) = eddyPsiX(i,j,k,bi,bj) + |
398 |
& fCori(i,j,bi,bj)*tmpfld3d(i,j,k,bi,bj) |
& tmpfld3d(i,j,k,bi,bj) |
399 |
enddo |
enddo |
400 |
enddo |
enddo |
401 |
enddo |
enddo |
402 |
enddo |
enddo |
403 |
enddo |
enddo |
404 |
#endif |
c-- meridional eddy streamfunction : eddyPsiY |
|
|
|
|
#ifdef ALLOW_EDTAUY_CONTROL |
|
|
c-- meridional eddy stress : edtauy |
|
405 |
il=ilnblnk( xx_edtauy_file ) |
il=ilnblnk( xx_edtauy_file ) |
406 |
write(fnamegeneric(1:80),'(2a,i10.10)') |
write(fnamegeneric(1:80),'(2a,i10.10)') |
407 |
& xx_edtauy_file(1:il),'.',optimcycle |
& xx_edtauy_file(1:il),'.',optimcycle |
413 |
do k = 1,nr |
do k = 1,nr |
414 |
do j = jmin,jmax |
do j = jmin,jmax |
415 |
do i = imin,imax |
do i = imin,imax |
416 |
eddyTauY(i,j,k,bi,bj) = eddyTauY(i,j,k,bi,bj) + |
eddyPsiY(i,j,k,bi,bj) = eddyPsiY(i,j,k,bi,bj) + |
417 |
& fCoriG(i,j,bi,bj)*tmpfld3d(i,j,k,bi,bj) |
& tmpfld3d(i,j,k,bi,bj) |
418 |
enddo |
enddo |
419 |
enddo |
enddo |
420 |
enddo |
enddo |
435 |
do k = 1,nr |
do k = 1,nr |
436 |
do j = jmin,jmax |
do j = jmin,jmax |
437 |
do i = imin,imax |
do i = imin,imax |
438 |
#ifdef ALLOW_OPENAD |
#ifdef ALLOW_AUTODIFF_OPENAD |
439 |
uVel(i,j,k,bi,bj) = uVel(i,j,k,bi,bj) + |
uVel(i,j,k,bi,bj) = uVel(i,j,k,bi,bj) + |
440 |
& fac*xx_uvel(i,j,k,bi,bj) |
& fac*xx_uvel(i,j,k,bi,bj) |
441 |
#else |
#else |
462 |
do k = 1,nr |
do k = 1,nr |
463 |
do j = jmin,jmax |
do j = jmin,jmax |
464 |
do i = imin,imax |
do i = imin,imax |
465 |
#ifdef ALLOW_OPENAD |
#ifdef ALLOW_AUTODIFF_OPENAD |
466 |
vVel(i,j,k,bi,bj) = vVel(i,j,k,bi,bj) + |
vVel(i,j,k,bi,bj) = vVel(i,j,k,bi,bj) + |
467 |
& fac*xx_vvel(i,j,k,bi,bj) |
& fac*xx_vvel(i,j,k,bi,bj) |
468 |
#else |
#else |
488 |
do bi = itlo,ithi |
do bi = itlo,ithi |
489 |
do j = jmin,jmax |
do j = jmin,jmax |
490 |
do i = imin,imax |
do i = imin,imax |
491 |
#ifdef ALLOW_OPENAD |
#ifdef ALLOW_AUTODIFF_OPENAD |
492 |
etaN(i,j,bi,bj) = etaN(i,j,bi,bj) + |
etaN(i,j,bi,bj) = etaN(i,j,bi,bj) + |
493 |
& fac*xx_etan(i,j,bi,bj) |
& fac*xx_etan(i,j,bi,bj) |
494 |
#else |
#else |
495 |
etaN(i,j,bi,bj) = etaN(i,j,bi,bj) + |
etaN(i,j,bi,bj) = etaN(i,j,bi,bj) + |
496 |
& fac*tmpfld2d(i,j,bi,bj) |
& fac*tmpfld2d(i,j,bi,bj) |
497 |
#endif |
#endif |
498 |
enddo |
enddo |
513 |
do bi = itlo,ithi |
do bi = itlo,ithi |
514 |
do j = jmin,jmax |
do j = jmin,jmax |
515 |
do i = imin,imax |
do i = imin,imax |
516 |
lambdaThetaClimRelax(i,j,bi,bj) = |
lambdaThetaClimRelax(i,j,bi,bj) = |
517 |
& lambdaThetaClimRelax(i,j,bi,bj) |
& lambdaThetaClimRelax(i,j,bi,bj) |
518 |
& + tmpfld2d(i,j,bi,bj) |
& + tmpfld2d(i,j,bi,bj) |
519 |
enddo |
enddo |
520 |
enddo |
enddo |
534 |
do bi = itlo,ithi |
do bi = itlo,ithi |
535 |
do j = jmin,jmax |
do j = jmin,jmax |
536 |
do i = imin,imax |
do i = imin,imax |
537 |
lambdaSaltClimRelax(i,j,bi,bj) = |
lambdaSaltClimRelax(i,j,bi,bj) = |
538 |
& lambdaSaltClimRelax(i,j,bi,bj) |
& lambdaSaltClimRelax(i,j,bi,bj) |
539 |
& + tmpfld2d(i,j,bi,bj) |
& + tmpfld2d(i,j,bi,bj) |
540 |
enddo |
enddo |
541 |
enddo |
enddo |
543 |
enddo |
enddo |
544 |
#endif |
#endif |
545 |
|
|
546 |
|
#ifdef ALLOW_SEAICE |
547 |
|
call seaice_ctrl_map_ini( mythid ) |
548 |
|
#endif |
549 |
|
|
550 |
c-- Update the tile edges. |
c-- Update the tile edges. |
551 |
|
|
552 |
#if (defined (ALLOW_THETA0_CONTROL) || defined (ALLOW_SST0_CONTROL)) |
#if (defined (ALLOW_THETA0_CONTROL) || defined (ALLOW_SST0_CONTROL)) |
560 |
_EXCH_XYZ_R8(pTracer(1-Olx,1-Oly,1,1,1,1),myThid) |
_EXCH_XYZ_R8(pTracer(1-Olx,1-Oly,1,1,1,1),myThid) |
561 |
#endif |
#endif |
562 |
#endif |
#endif |
563 |
#ifdef ALLOW_DIFFKR_CONTROL |
|
564 |
|
#ifdef ALLOW_AUTODIFF |
565 |
|
# ifdef ALLOW_DIFFKR_CONTROL |
566 |
_EXCH_XYZ_R8( diffkr, mythid) |
_EXCH_XYZ_R8( diffkr, mythid) |
567 |
#endif |
# endif |
568 |
#ifdef ALLOW_KAPGM_CONTROL |
# ifdef ALLOW_KAPGM_CONTROL |
569 |
_EXCH_XYZ_R8( kapgm, mythid) |
_EXCH_XYZ_R8( kapgm, mythid) |
570 |
|
# endif |
571 |
|
# ifdef ALLOW_KAPREDI_CONTROL |
572 |
|
_EXCH_XYZ_R8( kapredi, mythid) |
573 |
|
# endif |
574 |
#endif |
#endif |
575 |
|
|
576 |
#ifdef ALLOW_EFLUXY0_CONTROL |
#ifdef ALLOW_EFLUXY0_CONTROL |
577 |
_EXCH_XYZ_R8( EfluxY, mythid ) |
_EXCH_XYZ_R8( EfluxY, mythid ) |
578 |
#endif |
#endif |
583 |
_EXCH_XY_R8( bottomdragfld, mythid ) |
_EXCH_XY_R8( bottomdragfld, mythid ) |
584 |
#endif |
#endif |
585 |
|
|
586 |
#if (defined (ALLOW_EDTAUX_CONTROL) && defined (ALLOW_EDTAUY_CONTROL)) |
#ifdef ALLOW_EDDYPSI_CONTROL |
587 |
CALL EXCH_UV_XYZ_RS(eddyTauX,eddyTauY,.TRUE.,myThid) |
CALL EXCH_UV_XYZ_RS(eddyPsiX,eddyPsiY,.TRUE.,myThid) |
|
#elif (defined (ALLOW_EDTAUX_CONTROL) || defined (ALLOW_EDTAUY_CONTROL)) |
|
|
STOP 'ctrl_map_forcing: need BOTH ALLOW_EDTAU[X,Y]_CONTROL' |
|
588 |
#endif |
#endif |
589 |
|
|
590 |
#ifdef ALLOW_UVEL0_CONTROL |
#ifdef ALLOW_UVEL0_CONTROL |