1 |
|
|
2 |
#include "CTRL_CPPOPTIONS.h" |
#include "CTRL_CPPOPTIONS.h" |
3 |
|
|
|
CBOP |
|
|
C !ROUTINE: ctrl_pack |
|
|
C !INTERFACE: |
|
|
subroutine ctrl_pack( myiter, mytime, mythid ) |
|
|
|
|
|
C !DESCRIPTION: \bv |
|
|
c *================================================================= |
|
|
c | SUBROUTINE ctrl_pack |
|
|
c | Pack the control vector |
|
|
c | * All control variable and adjoint variable fields are |
|
|
c | read from disk. |
|
|
c | * Wet points are extracted, and elements are |
|
|
c | normalized (optional) |
|
|
c | * A single control vector containing only (normalized |
|
|
c | wet points is written to file. |
|
|
c *================================================================= |
|
|
C \ev |
|
4 |
|
|
5 |
C !USES: |
subroutine ctrl_pack( |
6 |
|
I myiter, |
7 |
|
I mytime, |
8 |
|
I mythid |
9 |
|
& ) |
10 |
|
|
11 |
|
c ================================================================== |
12 |
|
c SUBROUTINE ctrl_pack |
13 |
|
c ================================================================== |
14 |
|
c |
15 |
|
c o Compress the control vector such that only ocean points are |
16 |
|
c written to file. |
17 |
|
c |
18 |
|
c started: Christian Eckert eckert@mit.edu 10-Mar=2000 |
19 |
|
c |
20 |
|
c changed: Patrick Heimbach heimbach@mit.edu 06-Jun-2000 |
21 |
|
c - Transferred some filename declarations |
22 |
|
c from here to namelist in ctrl_init |
23 |
|
c |
24 |
|
c Patrick Heimbach heimbach@mit.edu 16-Jun-2000 |
25 |
|
c - single file name convention with or without |
26 |
|
c ALLOW_ECCO_OPTIMIZATION |
27 |
|
c |
28 |
|
c G. Gebbie, added open boundary control packing, |
29 |
|
c gebbie@mit.edu 18 -Mar- 2003 |
30 |
|
c |
31 |
|
c ================================================================== |
32 |
|
c SUBROUTINE ctrl_pack |
33 |
|
c ================================================================== |
34 |
|
|
35 |
implicit none |
implicit none |
36 |
|
|
37 |
c == global variables == |
c == global variables == |
259 |
|
|
260 |
#ifdef ALLOW_THETA0_CONTROL |
#ifdef ALLOW_THETA0_CONTROL |
261 |
ivartype = 1 |
ivartype = 1 |
262 |
|
write(weighttype(1:80),'(80a)') ' ' |
263 |
|
write(weighttype(1:80),'(a)') "wtheta" |
264 |
call ctrl_set_pack_xyz( |
call ctrl_set_pack_xyz( |
265 |
& cunit, ivartype, adfname_theta, "hFacC", |
& cunit, ivartype, adfname_theta, "hFacC", |
266 |
& wtheta, lxxadxx, mythid) |
& weighttype, wtheta, lxxadxx, mythid) |
267 |
#endif |
#endif |
268 |
|
|
269 |
#ifdef ALLOW_SALT0_CONTROL |
#ifdef ALLOW_SALT0_CONTROL |
270 |
ivartype = 2 |
ivartype = 2 |
271 |
|
write(weighttype(1:80),'(80a)') ' ' |
272 |
|
write(weighttype(1:80),'(a)') "wsalt" |
273 |
call ctrl_set_pack_xyz( |
call ctrl_set_pack_xyz( |
274 |
& cunit, ivartype, adfname_salt, "hFacC", |
& cunit, ivartype, adfname_salt, "hFacC", |
275 |
& wsalt, lxxadxx, mythid) |
& weighttype, wsalt, lxxadxx, mythid) |
276 |
#endif |
#endif |
277 |
|
|
278 |
#if (defined (ALLOW_HFLUX_CONTROL) || \ |
#if (defined (ALLOW_HFLUX_CONTROL) || \ |
353 |
|
|
354 |
#ifdef ALLOW_OBCSN_CONTROL |
#ifdef ALLOW_OBCSN_CONTROL |
355 |
ivartype = 11 |
ivartype = 11 |
356 |
|
write(weighttype(1:80),'(80a)') ' ' |
357 |
|
write(weighttype(1:80),'(a)') "wobcsn" |
358 |
call ctrl_set_pack_xz( |
call ctrl_set_pack_xz( |
359 |
& cunit, ivartype, adfname_obcsn, "maskobcsn", |
& cunit, ivartype, adfname_obcsn, "maskobcsn", |
360 |
& wobcsn, lxxadxx, mythid) |
& weighttype, wobcsn, lxxadxx, mythid) |
361 |
#endif |
#endif |
362 |
|
|
363 |
#ifdef ALLOW_OBCSS_CONTROL |
#ifdef ALLOW_OBCSS_CONTROL |
364 |
ivartype = 12 |
ivartype = 12 |
365 |
|
write(weighttype(1:80),'(80a)') ' ' |
366 |
|
write(weighttype(1:80),'(a)') "wobcss" |
367 |
call ctrl_set_pack_xz( |
call ctrl_set_pack_xz( |
368 |
& cunit, ivartype, adfname_obcss, "maskobcss", |
& cunit, ivartype, adfname_obcss, "maskobcss", |
369 |
& wobcss, lxxadxx, mythid) |
& weighttype, wobcss, lxxadxx, mythid) |
370 |
#endif |
#endif |
371 |
|
|
372 |
#ifdef ALLOW_OBCSW_CONTROL |
#ifdef ALLOW_OBCSW_CONTROL |
373 |
ivartype = 13 |
ivartype = 13 |
374 |
|
write(weighttype(1:80),'(80a)') ' ' |
375 |
|
write(weighttype(1:80),'(a)') "wobcsw" |
376 |
call ctrl_set_pack_yz( |
call ctrl_set_pack_yz( |
377 |
& cunit, ivartype, adfname_obcsw, "maskobcsw", |
& cunit, ivartype, adfname_obcsw, "maskobcsw", |
378 |
& wobcsw, lxxadxx, mythid) |
& weighttype, wobcsw, lxxadxx, mythid) |
379 |
#endif |
#endif |
380 |
|
|
381 |
#ifdef ALLOW_OBCSE_CONTROL |
#ifdef ALLOW_OBCSE_CONTROL |
382 |
ivartype = 14 |
ivartype = 14 |
383 |
|
write(weighttype(1:80),'(80a)') ' ' |
384 |
|
write(weighttype(1:80),'(a)') "wobcse" |
385 |
call ctrl_set_pack_yz( |
call ctrl_set_pack_yz( |
386 |
& cunit, ivartype, adfname_obcse, "maskobcse", |
& cunit, ivartype, adfname_obcse, "maskobcse", |
387 |
& wobcse, lxxadxx, mythid) |
& weighttype, wobcse, lxxadxx, mythid) |
388 |
#endif |
#endif |
389 |
|
|
390 |
#ifdef ALLOW_DIFFKR_CONTROL |
#ifdef ALLOW_DIFFKR_CONTROL |
391 |
ivartype = 15 |
ivartype = 15 |
392 |
|
write(weighttype(1:80),'(80a)') ' ' |
393 |
|
write(weighttype(1:80),'(a)') "wdiffkr" |
394 |
call ctrl_set_pack_xyz( |
call ctrl_set_pack_xyz( |
395 |
& cunit, ivartype, adfname_diffkr, "hFacC", |
& cunit, ivartype, adfname_diffkr, "hFacC", |
396 |
& wunit, lxxadxx, mythid) |
& weighttype, wunit, lxxadxx, mythid) |
397 |
#endif |
#endif |
398 |
|
|
399 |
#ifdef ALLOW_KAPGM_CONTROL |
#ifdef ALLOW_KAPGM_CONTROL |
400 |
ivartype = 16 |
ivartype = 16 |
401 |
|
write(weighttype(1:80),'(80a)') ' ' |
402 |
|
write(weighttype(1:80),'(a)') "wkapgm" |
403 |
call ctrl_set_pack_xyz( |
call ctrl_set_pack_xyz( |
404 |
& cunit, ivartype, adfname_kapgm, "hFacC", |
& cunit, ivartype, adfname_kapgm, "hFacC", |
405 |
& wunit, lxxadxx, mythid) |
& weighttype, wunit, lxxadxx, mythid) |
406 |
#endif |
#endif |
407 |
|
|
408 |
#ifdef ALLOW_TR10_CONTROL |
#ifdef ALLOW_TR10_CONTROL |
409 |
ivartype = 17 |
ivartype = 17 |
410 |
|
write(weighttype(1:80),'(80a)') ' ' |
411 |
|
write(weighttype(1:80),'(a)') "wtr1" |
412 |
call ctrl_set_pack_xyz( |
call ctrl_set_pack_xyz( |
413 |
& cunit, ivartype, adfname_tr1, "hFacC", |
& cunit, ivartype, adfname_tr1, "hFacC", |
414 |
& wunit, lxxadxx, mythid) |
& weighttype, wunit, lxxadxx, mythid) |
415 |
#endif |
#endif |
416 |
|
|
417 |
#ifdef ALLOW_SST0_CONTROL |
#ifdef ALLOW_SST0_CONTROL |
434 |
|
|
435 |
#ifdef ALLOW_HFACC_CONTROL |
#ifdef ALLOW_HFACC_CONTROL |
436 |
ivartype = 20 |
ivartype = 20 |
|
#ifdef ALLOW_HFACC3D_CONTROL |
|
|
call ctrl_set_pack_xyz( |
|
|
& cunit, ivartype, adfname_hfacc, "hFacC", |
|
|
& wunit, lxxadxx, mythid) |
|
|
#else |
|
437 |
write(weighttype(1:80),'(80a)') ' ' |
write(weighttype(1:80),'(80a)') ' ' |
438 |
write(weighttype(1:80),'(a)') "whfacc" |
write(weighttype(1:80),'(a)') "whfacc" |
439 |
|
# ifdef ALLOW_HFACC3D_CONTROL |
440 |
|
call ctrl_set_pack_xyz( |
441 |
|
& cunit, ivartype, adfname_hfacc, "hFacC", |
442 |
|
& weighttype, wunit, lxxadxx, mythid) |
443 |
|
# else |
444 |
call ctrl_set_pack_xy( |
call ctrl_set_pack_xy( |
445 |
& cunit, ivartype, adfname_hfacc, "hFacC", weighttype, |
& cunit, ivartype, adfname_hfacc, "hFacC", weighttype, |
446 |
& lxxadxx, mythid) |
& lxxadxx, mythid) |
447 |
#endif |
# endif |
448 |
#endif |
#endif |
449 |
|
|
450 |
#ifdef ALLOW_EFLUXY0_CONTROL |
#ifdef ALLOW_EFLUXY0_CONTROL |
451 |
ivartype = 21 |
ivartype = 21 |
452 |
|
write(weighttype(1:80),'(80a)') ' ' |
453 |
|
write(weighttype(1:80),'(a)') "wefluxy0" |
454 |
call ctrl_set_pack_xyz( |
call ctrl_set_pack_xyz( |
455 |
& cunit, ivartype, adfname_efluxy, "hFacS", |
& cunit, ivartype, adfname_efluxy, "hFacS", |
456 |
& wunit, lxxadxx, mythid) |
& weighttype, wunit, lxxadxx, mythid) |
457 |
#endif |
#endif |
458 |
|
|
459 |
#ifdef ALLOW_EFLUXP0_CONTROL |
#ifdef ALLOW_EFLUXP0_CONTROL |
460 |
ivartype = 22 |
ivartype = 22 |
461 |
|
write(weighttype(1:80),'(80a)') ' ' |
462 |
|
write(weighttype(1:80),'(a)') "wefluxp0" |
463 |
call ctrl_set_pack_xyz( |
call ctrl_set_pack_xyz( |
464 |
& cunit, ivartype, adfname_efluxp, "hFacV", |
& cunit, ivartype, adfname_efluxp, "hFacV", |
465 |
& wunit, lxxadxx, mythid) |
& weighttype, wunit, lxxadxx, mythid) |
466 |
#endif |
#endif |
467 |
|
|
468 |
#ifdef ALLOW_BOTTOMDRAG_CONTROL |
#ifdef ALLOW_BOTTOMDRAG_CONTROL |