344 & LBi, UBi, LBj, UBj, LBij, UBij, &
345 & IminS, ImaxS, JminS, JmaxS, &
347 & innLoop, outLoop, &
349 & rmask, umask, vmask, &
351# ifdef ADJUST_BOUNDARY
353 & nl_t_obc, nl_u_obc, nl_v_obc, &
355 & nl_ubar_obc, nl_vbar_obc, &
358# ifdef ADJUST_WSTRESS
359 & nl_ustr, nl_vstr, &
365 & nl_t, nl_u, nl_v, &
367 & nl_ubar, nl_vbar, &
370# ifdef ADJUST_BOUNDARY
372 & tl_t_obc, tl_u_obc, tl_v_obc, &
374 & tl_ubar_obc, tl_vbar_obc, &
377# ifdef ADJUST_WSTRESS
378 & tl_ustr, tl_vstr, &
384 & tl_t, tl_u, tl_v, &
386 & tl_ubar, tl_vbar, &
389# ifdef ADJUST_BOUNDARY
391 & d_t_obc, d_u_obc, d_v_obc, &
393 & d_ubar_obc, d_vbar_obc, &
396# ifdef ADJUST_WSTRESS
397 & d_sustr, d_svstr, &
408# ifdef ADJUST_BOUNDARY
410 & ad_t_obc, ad_u_obc, ad_v_obc, &
412 & ad_ubar_obc, ad_vbar_obc, &
415# ifdef ADJUST_WSTRESS
416 & ad_ustr, ad_vstr, &
422 & ad_t, ad_u, ad_v, &
424 & ad_ubar, ad_vbar, &
431 integer,
intent(in) :: ng, tile, model
432 integer,
intent(in) :: lbi, ubi, lbj, ubj, lbij, ubij
433 integer,
intent(in) :: imins, imaxs, jmins, jmaxs
435 integer,
intent(in) :: innloop, outloop
439 real(r8),
intent(in) :: rmask(lbi:,lbj:)
440 real(r8),
intent(in) :: umask(lbi:,lbj:)
441 real(r8),
intent(in) :: vmask(lbi:,lbj:)
443# ifdef ADJUST_BOUNDARY
445 real(r8),
intent(inout) :: ad_t_obc(lbij:,:,:,:,:,:)
446 real(r8),
intent(inout) :: ad_u_obc(lbij:,:,:,:,:)
447 real(r8),
intent(inout) :: ad_v_obc(lbij:,:,:,:,:)
449 real(r8),
intent(inout) :: ad_ubar_obc(lbij:,:,:,:)
450 real(r8),
intent(inout) :: ad_vbar_obc(lbij:,:,:,:)
451 real(r8),
intent(inout) :: ad_zeta_obc(lbij:,:,:,:)
453# ifdef ADJUST_WSTRESS
454 real(r8),
intent(inout) :: ad_ustr(lbi:,lbj:,:,:)
455 real(r8),
intent(inout) :: ad_vstr(lbi:,lbj:,:,:)
459 real(r8),
intent(inout) :: ad_tflux(lbi:,lbj:,:,:,:)
461 real(r8),
intent(inout) :: ad_t(lbi:,lbj:,:,:,:)
462 real(r8),
intent(inout) :: ad_u(lbi:,lbj:,:,:)
463 real(r8),
intent(inout) :: ad_v(lbi:,lbj:,:,:)
465 real(r8),
intent(inout) :: ad_ubar(lbi:,lbj:,:)
466 real(r8),
intent(inout) :: ad_vbar(lbi:,lbj:,:)
468 real(r8),
intent(inout) :: ad_zeta(lbi:,lbj:,:)
469# ifdef ADJUST_BOUNDARY
471 real(r8),
intent(inout) :: d_t_obc(lbij:,:,:,:,:)
472 real(r8),
intent(inout) :: d_u_obc(lbij:,:,:,:)
473 real(r8),
intent(inout) :: d_v_obc(lbij:,:,:,:)
475 real(r8),
intent(inout) :: d_ubar_obc(lbij:,:,:)
476 real(r8),
intent(inout) :: d_vbar_obc(lbij:,:,:)
477 real(r8),
intent(inout) :: d_zeta_obc(lbij:,:,:)
479# ifdef ADJUST_WSTRESS
480 real(r8),
intent(inout) :: d_sustr(lbi:,lbj:,:)
481 real(r8),
intent(inout) :: d_svstr(lbi:,lbj:,:)
485 real(r8),
intent(inout) :: d_stflx(lbi:,lbj:,:,:)
487 real(r8),
intent(inout) :: d_t(lbi:,lbj:,:,:)
488 real(r8),
intent(inout) :: d_u(lbi:,lbj:,:)
489 real(r8),
intent(inout) :: d_v(lbi:,lbj:,:)
491 real(r8),
intent(inout) :: d_ubar(lbi:,lbj:)
492 real(r8),
intent(inout) :: d_vbar(lbi:,lbj:)
494 real(r8),
intent(inout) :: d_zeta(lbi:,lbj:)
495# ifdef ADJUST_BOUNDARY
497 real(r8),
intent(inout) :: nl_t_obc(lbij:,:,:,:,:,:)
498 real(r8),
intent(inout) :: nl_u_obc(lbij:,:,:,:,:)
499 real(r8),
intent(inout) :: nl_v_obc(lbij:,:,:,:,:)
501 real(r8),
intent(inout) :: nl_ubar_obc(lbij:,:,:,:)
502 real(r8),
intent(inout) :: nl_vbar_obc(lbij:,:,:,:)
503 real(r8),
intent(inout) :: nl_zeta_obc(lbij:,:,:,:)
505# ifdef ADJUST_WSTRESS
506 real(r8),
intent(inout) :: nl_ustr(lbi:,lbj:,:,:)
507 real(r8),
intent(inout) :: nl_vstr(lbi:,lbj:,:,:)
511 real(r8),
intent(inout) :: nl_tflux(lbi:,lbj:,:,:,:)
513 real(r8),
intent(inout) :: nl_t(lbi:,lbj:,:,:,:)
514 real(r8),
intent(inout) :: nl_u(lbi:,lbj:,:,:)
515 real(r8),
intent(inout) :: nl_v(lbi:,lbj:,:,:)
517 real(r8),
intent(inout) :: nl_ubar(lbi:,lbj:,:)
518 real(r8),
intent(inout) :: nl_vbar(lbi:,lbj:,:)
520 real(r8),
intent(inout) :: nl_zeta(lbi:,lbj:,:)
521# ifdef ADJUST_BOUNDARY
523 real(r8),
intent(inout) :: tl_t_obc(lbij:,:,:,:,:,:)
524 real(r8),
intent(inout) :: tl_u_obc(lbij:,:,:,:,:)
525 real(r8),
intent(inout) :: tl_v_obc(lbij:,:,:,:,:)
527 real(r8),
intent(inout) :: tl_ubar_obc(lbij:,:,:,:)
528 real(r8),
intent(inout) :: tl_vbar_obc(lbij:,:,:,:)
529 real(r8),
intent(inout) :: tl_zeta_obc(lbij:,:,:,:)
531# ifdef ADJUST_WSTRESS
532 real(r8),
intent(inout) :: tl_ustr(lbi:,lbj:,:,:)
533 real(r8),
intent(inout) :: tl_vstr(lbi:,lbj:,:,:)
537 real(r8),
intent(inout) :: tl_tflux(lbi:,lbj:,:,:,:)
539 real(r8),
intent(inout) :: tl_t(lbi:,lbj:,:,:,:)
540 real(r8),
intent(inout) :: tl_u(lbi:,lbj:,:,:)
541 real(r8),
intent(inout) :: tl_v(lbi:,lbj:,:,:)
543 real(r8),
intent(inout) :: tl_ubar(lbi:,lbj:,:)
544 real(r8),
intent(inout) :: tl_vbar(lbi:,lbj:,:)
546 real(r8),
intent(inout) :: tl_zeta(lbi:,lbj:,:)
551 real(r8),
intent(in) :: rmask(lbi:ubi,lbj:ubj)
552 real(r8),
intent(in) :: umask(lbi:ubi,lbj:ubj)
553 real(r8),
intent(in) :: vmask(lbi:ubi,lbj:ubj)
555# ifdef ADJUST_BOUNDARY
557 real(r8),
intent(inout) :: ad_t_obc(lbij:ubij,
n(ng),4, &
558 & Nbrec(ng),2,NT(ng))
559 real(r8),
intent(inout) :: ad_u_obc(lbij:ubij,
n(ng),4,
nbrec(ng),2)
560 real(r8),
intent(inout) :: ad_v_obc(lbij:ubij,
n(ng),4,
nbrec(ng),2)
562 real(r8),
intent(inout) :: ad_ubar_obc(lbij:ubij,4,
nbrec(ng),2)
563 real(r8),
intent(inout) :: ad_vbar_obc(lbij:ubij,4,
nbrec(ng),2)
564 real(r8),
intent(inout) :: ad_zeta_obc(lbij:ubij,4,
nbrec(ng),2)
566# ifdef ADJUST_WSTRESS
567 real(r8),
intent(inout) :: ad_ustr(lbi:ubi,lbj:ubj,
nfrec(ng),2)
568 real(r8),
intent(inout) :: ad_vstr(lbi:ubi,lbj:ubj,
nfrec(ng),2)
572 real(r8),
intent(inout) :: ad_tflux(lbi:ubi,lbj:ubj, &
573 & Nfrec(ng),2,NT(ng))
575 real(r8),
intent(inout) :: ad_t(lbi:ubi,lbj:ubj,
n(ng),3,
nt(ng))
576 real(r8),
intent(inout) :: ad_u(lbi:ubi,lbj:ubj,
n(ng),2)
577 real(r8),
intent(inout) :: ad_v(lbi:ubi,lbj:ubj,
n(ng),2)
579 real(r8),
intent(inout) :: ad_ubar(lbi:ubi,lbj:ubj,:)
580 real(r8),
intent(inout) :: ad_vbar(lbi:ubi,lbj:ubj,:)
582 real(r8),
intent(inout) :: ad_zeta(lbi:ubi,lbj:ubj,:)
583# ifdef ADJUST_BOUNDARY
585 real(r8),
intent(inout) :: d_t_obc(lbij:ubij,
n(ng),4, &
587 real(r8),
intent(inout) :: d_u_obc(lbij:ubij,
n(ng),4,
nbrec(ng))
588 real(r8),
intent(inout) :: d_v_obc(lbij:ubij,
n(ng),4,
nbrec(ng))
590 real(r8),
intent(inout) :: d_ubar_obc(lbij:ubij,4,
nbrec(ng))
591 real(r8),
intent(inout) :: d_vbar_obc(lbij:ubij,4,
nbrec(ng))
592 real(r8),
intent(inout) :: d_zeta_obc(lbij:ubij,4,
nbrec(ng))
594# ifdef ADJUST_WSTRESS
595 real(r8),
intent(inout) :: d_sustr(lbi:ubi,lbj:ubj,
nfrec(ng))
596 real(r8),
intent(inout) :: d_svstr(lbi:ubi,lbj:ubj,
nfrec(ng))
600 real(r8),
intent(inout) :: d_stflx(lbi:ubi,lbj:ubj, &
603 real(r8),
intent(inout) :: d_t(lbi:ubi,lbj:ubj,
n(ng),
nt(ng))
604 real(r8),
intent(inout) :: d_u(lbi:ubi,lbj:ubj,
n(ng))
605 real(r8),
intent(inout) :: d_v(lbi:ubi,lbj:ubj,
n(ng))
607 real(r8),
intent(inout) :: d_ubar(lbi:ubi,lbj:ubj)
608 real(r8),
intent(inout) :: d_vbar(lbi:ubi,lbj:ubj)
610 real(r8),
intent(inout) :: d_zeta(lbi:ubi,lbj:ubj)
611# ifdef ADJUST_BOUNDARY
613 real(r8),
intent(inout) :: nl_t_obc(lbij:ubij,
n(ng),4, &
614 & Nbrec(ng),2,NT(ng))
615 real(r8),
intent(inout) :: nl_u_obc(lbij:ubij,
n(ng),4,
nbrec(ng),2)
616 real(r8),
intent(inout) :: nl_v_obc(lbij:ubij,
n(ng),4,
nbrec(ng),2)
618 real(r8),
intent(inout) :: nl_ubar_obc(lbij:ubij,4,
nbrec(ng),2)
619 real(r8),
intent(inout) :: nl_vbar_obc(lbij:ubij,4,
nbrec(ng),2)
620 real(r8),
intent(inout) :: nl_zeta_obc(lbij:ubij,4,
nbrec(ng),2)
622# ifdef ADJUST_WSTRESS
623 real(r8),
intent(inout) :: nl_ustr(lbi:ubi,lbj:ubj,
nfrec(ng),2)
624 real(r8),
intent(inout) :: nl_vstr(lbi:ubi,lbj:ubj,
nfrec(ng),2)
628 real(r8),
intent(inout) :: nl_tflux(lbi:ubi,lbj:ubj, &
629 & Nfrec(ng),2,NT(ng))
631 real(r8),
intent(inout) :: nl_t(lbi:ubi,lbj:ubj,
n(ng),3,
nt(ng))
632 real(r8),
intent(inout) :: nl_u(lbi:ubi,lbj:ubj,
n(ng),2)
633 real(r8),
intent(inout) :: nl_v(lbi:ubi,lbj:ubj,
n(ng),2)
635 real(r8),
intent(inout) :: nl_ubar(lbi:ubi,lbj:ubj,:)
636 real(r8),
intent(inout) :: nl_vbar(lbi:ubi,lbj:ubj,:)
638 real(r8),
intent(inout) :: nl_zeta(lbi:ubi,lbj:ubj,:)
639# ifdef ADJUST_BOUNDARY
641 real(r8),
intent(inout) :: tl_t_obc(lbij:ubij,
n(ng),4, &
642 & Nbrec(ng),2,NT(ng))
643 real(r8),
intent(inout) :: tl_u_obc(lbij:ubij,
n(ng),4,
nbrec(ng),2)
644 real(r8),
intent(inout) :: tl_v_obc(lbij:ubij,
n(ng),4,
nbrec(ng),2)
646 real(r8),
intent(inout) :: tl_ubar_obc(lbij:ubij,4,
nbrec(ng),2)
647 real(r8),
intent(inout) :: tl_vbar_obc(lbij:ubij,4,
nbrec(ng),2)
648 real(r8),
intent(inout) :: tl_zeta_obc(lbij:ubij,4,
nbrec(ng),2)
650# ifdef ADJUST_WSTRESS
651 real(r8),
intent(inout) :: tl_ustr(lbi:ubi,lbj:ubj,
nfrec(ng),2)
652 real(r8),
intent(inout) :: tl_vstr(lbi:ubi,lbj:ubj,
nfrec(ng),2)
656 real(r8),
intent(inout) :: tl_tflux(lbi:ubi,lbj:ubj, &
657 & Nfrec(ng),2,NT(ng))
659 real(r8),
intent(inout) :: tl_t(lbi:ubi,lbj:ubj,
n(ng),3,
nt(ng))
660 real(r8),
intent(inout) :: tl_u(lbi:ubi,lbj:ubj,
n(ng),2)
661 real(r8),
intent(inout) :: tl_v(lbi:ubi,lbj:ubj,
n(ng),2)
663 real(r8),
intent(inout) :: tl_ubar(lbi:ubi,lbj:ubj,:)
664 real(r8),
intent(inout) :: tl_vbar(lbi:ubi,lbj:ubj,:)
666 real(r8),
intent(inout) :: tl_zeta(lbi:ubi,lbj:ubj,:)
676 integer :: linp, lout, lscale, lwrk, lwrk1, i, j, ic
677 integer :: info, itheta1
679 real(dp) :: norm, zbeta, ztheta1
681 real(dp),
dimension(2*Ninner-2) :: work
683 character (len=13) :: string
685 character (len=*),
parameter :: myfile = &
686 & __FILE__//
", cgradient_tile"
688# include "set_bounds.h"
698 10
FORMAT (/,
' <<<< Conjugate Gradient Algorithm >>>>',/)
703 IF (
lprecond.and.(outloop.gt.1))
THEN
711 & lbi, ubi, lbj, ubj, lbij, ubij, &
713# ifdef ADJUST_BOUNDARY
715 & nl_t_obc, ad_t_obc, &
716 & nl_u_obc, ad_u_obc, &
717 & nl_v_obc, ad_v_obc, &
719 & nl_ubar_obc, ad_ubar_obc, &
720 & nl_vbar_obc, ad_vbar_obc, &
721 & nl_zeta_obc, ad_zeta_obc, &
723# ifdef ADJUST_WSTRESS
724 & nl_ustr, ad_ustr, &
725 & nl_vstr, ad_vstr, &
729 & nl_tflux, ad_tflux, &
735 & nl_ubar, ad_ubar, &
736 & nl_vbar, ad_vbar, &
740 CALL precond (ng, tile, model,
'convert gradient to y-space', &
741 & lbi, ubi, lbj, ubj, lbij, ubij, &
742 & imins, imaxs, jmins, jmaxs, &
744 & innloop, outloop, &
746 & rmask, umask, vmask, &
748# ifdef ADJUST_BOUNDARY
750 & nl_t_obc, nl_u_obc, nl_v_obc, &
752 & nl_ubar_obc, nl_vbar_obc, &
755# ifdef ADJUST_WSTRESS
756 & nl_ustr, nl_vstr, &
762 & nl_t, nl_u, nl_v, &
764 & nl_ubar, nl_vbar, &
772 & lbi, ubi, lbj, ubj, lbij, ubij, &
774# ifdef ADJUST_BOUNDARY
776 & ad_t_obc, nl_t_obc, &
777 & ad_u_obc, nl_u_obc, &
778 & ad_v_obc, nl_v_obc, &
780 & ad_ubar_obc, nl_ubar_obc, &
781 & ad_vbar_obc, nl_vbar_obc, &
782 & ad_zeta_obc, nl_zeta_obc, &
784# ifdef ADJUST_WSTRESS
785 & ad_ustr, nl_ustr, &
786 & ad_vstr, nl_vstr, &
790 & ad_tflux, nl_tflux, &
796 & ad_ubar, nl_ubar, &
797 & ad_vbar, nl_vbar, &
807 IF (innloop.gt.0)
THEN
811 CALL hessian (ng, tile, model, &
812 & lbi, ubi, lbj, ubj, lbij, ubij, &
813 & imins, imaxs, jmins, jmaxs, &
814 & linp, lout, lwrk, &
815 & innloop, outloop, &
817 & rmask, umask, vmask, &
819# ifdef ADJUST_BOUNDARY
821 & ad_t_obc, ad_u_obc, ad_v_obc, &
823 & ad_ubar_obc, ad_vbar_obc, &
826# ifdef ADJUST_WSTRESS
827 & ad_ustr, ad_vstr, &
833 & ad_t, ad_u, ad_v, &
835 & ad_ubar, ad_vbar, &
838# ifdef ADJUST_BOUNDARY
840 & tl_t_obc, tl_u_obc, tl_v_obc, &
842 & tl_ubar_obc, tl_vbar_obc, &
845# ifdef ADJUST_WSTRESS
846 & tl_ustr, tl_vstr, &
852 & tl_t, tl_u, tl_v, &
854 & tl_ubar, tl_vbar, &
861 IF (
cg_delta(innloop,outloop).le.0.0_r8)
THEN
862 WRITE (
stdout,*)
' CG_DELTA not positive.'
864 &
', outer = ', outloop,
', inner = ', innloop
877 CALL lanczos (ng, tile, model, &
878 & lbi, ubi, lbj, ubj, lbij, ubij, &
879 & imins, imaxs, jmins, jmaxs, &
880 & linp, lout, lwrk, &
881 & innloop, outloop, &
883 & rmask, umask, vmask, &
885# ifdef ADJUST_BOUNDARY
887 & tl_t_obc, tl_u_obc, tl_v_obc, &
889 & tl_ubar_obc, tl_vbar_obc, &
892# ifdef ADJUST_WSTRESS
893 & tl_ustr, tl_vstr, &
899 & tl_t, tl_u, tl_v, &
901 & tl_ubar, tl_vbar, &
904# ifdef ADJUST_BOUNDARY
906 & ad_t_obc, ad_u_obc, ad_v_obc, &
908 & ad_ubar_obc, ad_vbar_obc, &
911# ifdef ADJUST_WSTRESS
912 & ad_ustr, ad_vstr, &
918 & ad_t, ad_u, ad_v, &
920 & ad_ubar, ad_vbar, &
928 & lbi, ubi, lbj, ubj, lbij, ubij, &
929 & imins, imaxs, jmins, jmaxs, &
932 & rmask, umask, vmask, &
934# ifdef ADJUST_BOUNDARY
936 & ad_t_obc, ad_u_obc, ad_v_obc, &
938 & ad_ubar_obc, ad_vbar_obc, &
941# ifdef ADJUST_WSTRESS
942 & ad_ustr, ad_vstr, &
948 & ad_t, ad_u, ad_v, &
950 & ad_ubar, ad_vbar, &
953# ifdef ADJUST_BOUNDARY
955 & d_t_obc, d_u_obc, d_v_obc, &
957 & d_ubar_obc, d_vbar_obc, &
960# ifdef ADJUST_WSTRESS
961 & d_sustr, d_svstr, &
981 IF (innloop.gt.0)
THEN
986 IF (innloop.gt.1)
THEN
1011 & lbi, ubi, lbj, ubj, lbij, ubij, &
1012 & imins, imaxs, jmins, jmaxs, &
1013 & linp, lout, lwrk, &
1014 & innloop, outloop, &
1016 & rmask, umask, vmask, &
1018# ifdef ADJUST_BOUNDARY
1020 & tl_t_obc, tl_u_obc, tl_v_obc, &
1022 & tl_ubar_obc, tl_vbar_obc, &
1025# ifdef ADJUST_WSTRESS
1026 & tl_ustr, tl_vstr, &
1029# ifdef ADJUST_STFLUX
1032 & tl_t, tl_u, tl_v, &
1034 & tl_ubar, tl_vbar, &
1037# ifdef ADJUST_BOUNDARY
1039 & ad_t_obc, ad_u_obc, ad_v_obc, &
1041 & ad_ubar_obc, ad_vbar_obc, &
1044# ifdef ADJUST_WSTRESS
1045 & ad_ustr, ad_vstr, &
1048# ifdef ADJUST_STFLUX
1051 & ad_t, ad_u, ad_v, &
1053 & ad_ubar, ad_vbar, &
1060 IF (innloop.gt.0)
THEN
1062 & lbi, ubi, lbj, ubj, lbij, ubij, &
1063 & imins, imaxs, jmins, jmaxs, &
1064 & innloop, outloop, &
1066 & rmask, umask, vmask, &
1068# ifdef ADJUST_BOUNDARY
1070 & nl_t_obc, nl_u_obc, nl_v_obc, &
1072 & nl_ubar_obc, nl_vbar_obc, &
1075# ifdef ADJUST_WSTRESS
1076 & nl_ustr, nl_vstr, &
1079# ifdef ADJUST_STFLUX
1082 & nl_t, nl_u, nl_v, &
1084 & nl_ubar, nl_vbar, &
1096 IF (innloop.gt.0)
THEN
1118 WRITE (
stdout,*)
' Error in DSTEQR: info = ', info
1137 IF (
cg_ritz(i,outloop).lt.0.0_r8)
THEN
1138 WRITE (
stdout,*)
' Negative Ritz value found.'
1146 IF (innloop.eq.
ninner)
THEN
1155 & lbi, ubi, lbj, ubj, lbij, ubij, &
1156 & imins, imaxs, jmins, jmaxs, &
1157 & linp, lout, lwrk, &
1158 & innloop, outloop, &
1160 & rmask, umask, vmask, &
1162# ifdef ADJUST_BOUNDARY
1164 & nl_t_obc, nl_u_obc, nl_v_obc, &
1166 & nl_ubar_obc, nl_vbar_obc, &
1169# ifdef ADJUST_WSTRESS
1170 & nl_ustr, nl_vstr, &
1173# ifdef ADJUST_STFLUX
1176 & nl_t, nl_u, nl_v, &
1178 & nl_ubar, nl_vbar, &
1181# ifdef ADJUST_BOUNDARY
1183 & tl_t_obc, tl_u_obc, tl_v_obc, &
1185 & tl_ubar_obc, tl_vbar_obc, &
1189# ifdef ADJUST_WSTRESS
1190 & tl_ustr, tl_vstr, &
1193# ifdef ADJUST_STFLUX
1196 & tl_t, tl_u, tl_v, &
1198 & tl_ubar, tl_vbar, &
1201# ifdef ADJUST_BOUNDARY
1203 & ad_t_obc, ad_u_obc, ad_v_obc, &
1205 & ad_ubar_obc, ad_vbar_obc, &
1208# ifdef ADJUST_WSTRESS
1209 & ad_ustr, ad_vstr, &
1212# ifdef ADJUST_STFLUX
1215 & ad_t, ad_u, ad_v, &
1217 & ad_ubar, ad_vbar, &
1223 WRITE (
stdout,*)
' No converged Hesssian eigenvectors', &
1242 & lbi, ubi, lbj, ubj, lbij, ubij, &
1243 & imins, imaxs, jmins, jmaxs, &
1245 & innloop, outloop, &
1247 & rmask, umask, vmask, &
1249# ifdef ADJUST_BOUNDARY
1251 & d_t_obc, d_u_obc, d_v_obc, &
1253 & d_ubar_obc, d_vbar_obc, &
1256# ifdef ADJUST_WSTRESS
1257 & d_sustr, d_svstr, &
1260# ifdef ADJUST_STFLUX
1268# ifdef ADJUST_BOUNDARY
1270 & tl_t_obc, tl_u_obc, tl_v_obc, &
1272 & tl_ubar_obc, tl_vbar_obc, &
1275# ifdef ADJUST_WSTRESS
1276 & tl_ustr, tl_vstr, &
1279# ifdef ADJUST_STFLUX
1282 & tl_t, tl_u, tl_v, &
1284 & tl_ubar, tl_vbar, &
1287# ifdef ADJUST_BOUNDARY
1289 & ad_t_obc, ad_u_obc, ad_v_obc, &
1291 & ad_ubar_obc, ad_vbar_obc, &
1294# ifdef ADJUST_WSTRESS
1295 & ad_ustr, ad_vstr, &
1298# ifdef ADJUST_STFLUX
1301 & ad_t, ad_u, ad_v, &
1303 & ad_ubar, ad_vbar, &
1309 IF (
lprecond.and.(outloop.gt.1))
THEN
1317 & lbi, ubi, lbj, ubj, lbij, ubij, &
1319# ifdef ADJUST_BOUNDARY
1321 & nl_t_obc, tl_t_obc, &
1322 & nl_u_obc, tl_u_obc, &
1323 & nl_v_obc, tl_v_obc, &
1325 & nl_ubar_obc, tl_ubar_obc, &
1326 & nl_vbar_obc, tl_vbar_obc, &
1327 & nl_zeta_obc, tl_zeta_obc, &
1329# ifdef ADJUST_WSTRESS
1330 & nl_ustr, tl_ustr, &
1331 & nl_vstr, tl_vstr, &
1334# ifdef ADJUST_STFLUX
1335 & nl_tflux, tl_tflux, &
1341 & nl_ubar, tl_ubar, &
1342 & nl_vbar, tl_vbar, &
1346 CALL precond (ng, tile, model,
'convert increment to v-space', &
1347 & lbi, ubi, lbj, ubj, lbij, ubij, &
1348 & imins, imaxs, jmins, jmaxs, &
1350 & innloop, outloop, &
1352 & rmask, umask, vmask, &
1354# ifdef ADJUST_BOUNDARY
1356 & nl_t_obc, nl_u_obc, nl_v_obc, &
1358 & nl_ubar_obc, nl_vbar_obc, &
1361# ifdef ADJUST_WSTRESS
1362 & nl_ustr, nl_vstr, &
1365# ifdef ADJUST_STFLUX
1368 & nl_t, nl_u, nl_v, &
1370 & nl_ubar, nl_vbar, &
1378 & lbi, ubi, lbj, ubj, lbij, ubij, &
1380# ifdef ADJUST_BOUNDARY
1382 & tl_t_obc, nl_t_obc, &
1383 & tl_u_obc, nl_u_obc, &
1384 & tl_v_obc, nl_v_obc, &
1386 & tl_ubar_obc, nl_ubar_obc, &
1387 & tl_vbar_obc, nl_vbar_obc, &
1388 & tl_zeta_obc, nl_zeta_obc, &
1390# ifdef ADJUST_WSTRESS
1391 & tl_ustr, nl_ustr, &
1392 & tl_vstr, nl_vstr, &
1395# ifdef ADJUST_STFLUX
1396 & tl_tflux, nl_tflux, &
1402 & tl_ubar, nl_ubar, &
1403 & tl_vbar, nl_vbar, &
1418 IF (
inner.eq.0)
THEN
1419 WRITE (
stdout,20) outloop, innloop, &
1421 20
FORMAT (/,1x,
'(',i3.3,
',',i3.3,
'): ', &
1422 &
'Initial gradient norm, Gnorm = ',1p,e14.7)
1424 IF (innloop.gt.0)
THEN
1425 WRITE (
stdout,30) outloop, innloop, &
1427 & outloop, innloop, &
1429 30
FORMAT (/,1x,
'(',i3.3,
',',i3.3,
'): ', &
1430 &
'Reduction in the gradient norm, Greduc = ', &
1432 & 1x,
'(',i3.3,
',',i3.3,
'): ', &
1433 &
'Lanczos algorithm coefficient, delta = ', &
1436 40
FORMAT (/,
' Ritz Eigenvalues and relative accuracy: ', &
1437 &
'RitzMaxErr = ',1p,e14.7,/)
1445 & trim(adjustl(string)), ic
1446 50
FORMAT(5x,i3.3,2x,1p,e14.7,2x,1p,e14.7,2x,a,2x, &
1449 string=
'not converged'
1452 & trim(adjustl(string))
1453 60
FORMAT(5x,i3.3,2x,1p,e14.7,2x,1p,e14.7,2x,a)
1464 & LBi, UBi, LBj, UBj, LBij, UBij, &
1465 & IminS, ImaxS, JminS, JmaxS, &
1467 & innLoop, outLoop, &
1469 & rmask, umask, vmask, &
1471# ifdef ADJUST_BOUNDARY
1473 & d_t_obc, d_u_obc, d_v_obc, &
1475 & d_ubar_obc, d_vbar_obc, &
1478# ifdef ADJUST_WSTRESS
1479 & d_sustr, d_svstr, &
1482# ifdef ADJUST_STFLUX
1490# ifdef ADJUST_BOUNDARY
1492 & tl_t_obc, tl_u_obc, tl_v_obc, &
1494 & tl_ubar_obc, tl_vbar_obc, &
1497# ifdef ADJUST_WSTRESS
1498 & tl_ustr, tl_vstr, &
1501# ifdef ADJUST_STFLUX
1504 & tl_t, tl_u, tl_v, &
1506 & tl_ubar, tl_vbar, &
1509# ifdef ADJUST_BOUNDARY
1511 & ad_t_obc, ad_u_obc, ad_v_obc, &
1513 & ad_ubar_obc, ad_vbar_obc, &
1516# ifdef ADJUST_WSTRESS
1517 & ad_ustr, ad_vstr, &
1520# ifdef ADJUST_STFLUX
1523 & ad_t, ad_u, ad_v, &
1525 & ad_ubar, ad_vbar, &
1532 integer,
intent(in) :: ng, tile, model
1533 integer,
intent(in) :: lbi, ubi, lbj, ubj, lbij, ubij
1534 integer,
intent(in) :: imins, imaxs, jmins, jmaxs
1535 integer,
intent(in) :: linp, lout
1536 integer,
intent(in) :: innloop, outloop
1538# ifdef ASSUMED_SHAPE
1540 real(r8),
intent(in) :: rmask(lbi:,lbj:)
1541 real(r8),
intent(in) :: umask(lbi:,lbj:)
1542 real(r8),
intent(in) :: vmask(lbi:,lbj:)
1544# ifdef ADJUST_BOUNDARY
1546 real(r8),
intent(inout) :: d_t_obc(lbij:,:,:,:,:)
1547 real(r8),
intent(inout) :: d_u_obc(lbij:,:,:,:)
1548 real(r8),
intent(inout) :: d_v_obc(lbij:,:,:,:)
1550 real(r8),
intent(inout) :: d_ubar_obc(lbij:,:,:)
1551 real(r8),
intent(inout) :: d_vbar_obc(lbij:,:,:)
1552 real(r8),
intent(inout) :: d_zeta_obc(lbij:,:,:)
1554# ifdef ADJUST_WSTRESS
1555 real(r8),
intent(in) :: d_sustr(lbi:,lbj:,:)
1556 real(r8),
intent(in) :: d_svstr(lbi:,lbj:,:)
1559# ifdef ADJUST_STFLUX
1560 real(r8),
intent(in) :: d_stflx(lbi:,lbj:,:,:)
1562 real(r8),
intent(in) :: d_t(lbi:,lbj:,:,:)
1563 real(r8),
intent(in) :: d_u(lbi:,lbj:,:)
1564 real(r8),
intent(in) :: d_v(lbi:,lbj:,:)
1566 real(r8),
intent(in) :: d_ubar(lbi:,lbj:)
1567 real(r8),
intent(in) :: d_vbar(lbi:,lbj:)
1569 real(r8),
intent(in) :: d_zeta(lbi:,lbj:)
1570# ifdef ADJUST_BOUNDARY
1572 real(r8),
intent(inout) :: ad_t_obc(lbij:,:,:,:,:,:)
1573 real(r8),
intent(inout) :: ad_u_obc(lbij:,:,:,:,:)
1574 real(r8),
intent(inout) :: ad_v_obc(lbij:,:,:,:,:)
1576 real(r8),
intent(inout) :: ad_ubar_obc(lbij:,:,:,:)
1577 real(r8),
intent(inout) :: ad_vbar_obc(lbij:,:,:,:)
1578 real(r8),
intent(inout) :: ad_zeta_obc(lbij:,:,:,:)
1580# ifdef ADJUST_WSTRESS
1581 real(r8),
intent(inout) :: ad_ustr(lbi:,lbj:,:,:)
1582 real(r8),
intent(inout) :: ad_vstr(lbi:,lbj:,:,:)
1585# ifdef ADJUST_STFLUX
1586 real(r8),
intent(inout) :: ad_tflux(lbi:,lbj:,:,:,:)
1588 real(r8),
intent(inout) :: ad_t(lbi:,lbj:,:,:,:)
1589 real(r8),
intent(inout) :: ad_u(lbi:,lbj:,:,:)
1590 real(r8),
intent(inout) :: ad_v(lbi:,lbj:,:,:)
1592 real(r8),
intent(inout) :: ad_ubar(lbi:,lbj:,:)
1593 real(r8),
intent(inout) :: ad_vbar(lbi:,lbj:,:)
1595 real(r8),
intent(inout) :: ad_zeta(lbi:,lbj:,:)
1596# ifdef ADJUST_BOUNDARY
1598 real(r8),
intent(inout) :: tl_t_obc(lbij:,:,:,:,:,:)
1599 real(r8),
intent(inout) :: tl_u_obc(lbij:,:,:,:,:)
1600 real(r8),
intent(inout) :: tl_v_obc(lbij:,:,:,:,:)
1602 real(r8),
intent(inout) :: tl_ubar_obc(lbij:,:,:,:)
1603 real(r8),
intent(inout) :: tl_vbar_obc(lbij:,:,:,:)
1604 real(r8),
intent(inout) :: tl_zeta_obc(lbij:,:,:,:)
1606# ifdef ADJUST_WSTRESS
1607 real(r8),
intent(inout) :: tl_ustr(lbi:,lbj:,:,:)
1608 real(r8),
intent(inout) :: tl_vstr(lbi:,lbj:,:,:)
1611# ifdef ADJUST_STFLUX
1612 real(r8),
intent(inout) :: tl_tflux(lbi:,lbj:,:,:,:)
1614 real(r8),
intent(inout) :: tl_t(lbi:,lbj:,:,:,:)
1615 real(r8),
intent(inout) :: tl_u(lbi:,lbj:,:,:)
1616 real(r8),
intent(inout) :: tl_v(lbi:,lbj:,:,:)
1618 real(r8),
intent(inout) :: tl_ubar(lbi:,lbj:,:)
1619 real(r8),
intent(inout) :: tl_vbar(lbi:,lbj:,:)
1621 real(r8),
intent(inout) :: tl_zeta(lbi:,lbj:,:)
1626 real(r8),
intent(in) :: rmask(lbi:ubi,lbj:ubj)
1627 real(r8),
intent(in) :: umask(lbi:ubi,lbj:ubj)
1628 real(r8),
intent(in) :: vmask(lbi:ubi,lbj:ubj)
1630# ifdef ADJUST_BOUNDARY
1632 real(r8),
intent(in) :: d_t_obc(lbij:ubij,
n(ng),4, &
1634 real(r8),
intent(in) :: d_u_obc(lbij:ubij,
n(ng),4,
nbrec(ng))
1635 real(r8),
intent(in) :: d_v_obc(lbij:ubij,
n(ng),4,
nbrec(ng))
1637 real(r8),
intent(in) :: d_ubar_obc(lbij:ubij,4,
nbrec(ng))
1638 real(r8),
intent(in) :: d_vbar_obc(lbij:ubij,4,
nbrec(ng))
1639 real(r8),
intent(in) :: d_zeta_obc(lbij:ubij,4,
nbrec(ng))
1641# ifdef ADJUST_WSTRESS
1642 real(r8),
intent(in) :: d_sustr(lbi:ubi,lbj:ubj,
nfrec(ng))
1643 real(r8),
intent(in) :: d_svstr(lbi:ubi,lbj:ubj,
nfrec(ng))
1646# ifdef ADJUST_STFLUX
1647 real(r8),
intent(in) :: d_stflx(lbi:ubi,lbj:ubj, &
1650 real(r8),
intent(in) :: d_t(lbi:ubi,lbj:ubj,
n(ng),
nt(ng))
1651 real(r8),
intent(in) :: d_u(lbi:ubi,lbj:ubj,
n(ng))
1652 real(r8),
intent(in) :: d_v(lbi:ubi,lbj:ubj,
n(ng))
1654 real(r8),
intent(in) :: d_ubar(lbi:ubi,lbj:ubj)
1655 real(r8),
intent(in) :: d_vbar(lbi:ubi,lbj:ubj)
1657 real(r8),
intent(in) :: d_zeta(lbi:ubi,lbj:ubj)
1658# ifdef ADJUST_BOUNDARY
1660 real(r8),
intent(inout) :: ad_t_obc(lbij:ubij,
n(ng),4, &
1661 & Nbrec(ng),2,NT(ng))
1662 real(r8),
intent(inout) :: ad_u_obc(lbij:ubij,
n(ng),4,
nbrec(ng),2)
1663 real(r8),
intent(inout) :: ad_v_obc(lbij:ubij,
n(ng),4,
nbrec(ng),2)
1665 real(r8),
intent(inout) :: ad_ubar_obc(lbij:ubij,4,
nbrec(ng),2)
1666 real(r8),
intent(inout) :: ad_vbar_obc(lbij:ubij,4,
nbrec(ng),2)
1667 real(r8),
intent(inout) :: ad_zeta_obc(lbij:ubij,4,
nbrec(ng),2)
1669# ifdef ADJUST_WSTRESS
1670 real(r8),
intent(inout) :: ad_ustr(lbi:ubi,lbj:ubj,
nfrec(ng),2)
1671 real(r8),
intent(inout) :: ad_vstr(lbi:ubi,lbj:ubj,
nfrec(ng),2)
1674# ifdef ADJUST_STFLUX
1675 real(r8),
intent(inout) :: ad_tflux(lbi:ubi,lbj:ubj, &
1676 & Nfrec(ng),2,NT(ng))
1678 real(r8),
intent(inout) :: ad_t(lbi:ubi,lbj:ubj,
n(ng),3,
nt(ng))
1679 real(r8),
intent(inout) :: ad_u(lbi:ubi,lbj:ubj,
n(ng),2)
1680 real(r8),
intent(inout) :: ad_v(lbi:ubi,lbj:ubj,
n(ng),2)
1682 real(r8),
intent(inout) :: ad_ubar(lbi:ubi,lbj:ubj,:)
1683 real(r8),
intent(inout) :: ad_vbar(lbi:ubi,lbj:ubj,:)
1685 real(r8),
intent(inout) :: ad_zeta(lbi:ubi,lbj:ubj,:)
1686# ifdef ADJUST_BOUNDARY
1688 real(r8),
intent(inout) :: tl_t_obc(lbij:ubij,
n(ng),4, &
1689 & Nbrec(ng),2,NT(ng))
1690 real(r8),
intent(inout) :: tl_u_obc(lbij:ubij,
n(ng),4,
nbrec(ng),2)
1691 real(r8),
intent(inout) :: tl_v_obc(lbij:ubij,
n(ng),4,
nbrec(ng),2)
1693 real(r8),
intent(inout) :: tl_ubar_obc(lbij:ubij,4,
nbrec(ng),2)
1694 real(r8),
intent(inout) :: tl_vbar_obc(lbij:ubij,4,
nbrec(ng),2)
1695 real(r8),
intent(inout) :: tl_zeta_obc(lbij:ubij,4,
nbrec(ng),2)
1697# ifdef ADJUST_WSTRESS
1698 real(r8),
intent(inout) :: tl_ustr(lbi:ubi,lbj:ubj,
nfrec(ng),2)
1699 real(r8),
intent(inout) :: tl_vstr(lbi:ubi,lbj:ubj,
nfrec(ng),2)
1702# ifdef ADJUST_STFLUX
1703 real(r8),
intent(inout) :: tl_tflux(lbi:ubi,lbj:ubj, &
1704 & Nfrec(ng),2,NT(ng))
1706 real(r8),
intent(inout) :: tl_t(lbi:ubi,lbj:ubj,
n(ng),3,
nt(ng))
1707 real(r8),
intent(inout) :: tl_u(lbi:ubi,lbj:ubj,
n(ng),2)
1708 real(r8),
intent(inout) :: tl_v(lbi:ubi,lbj:ubj,
n(ng),2)
1710 real(r8),
intent(inout) :: tl_ubar(lbi:ubi,lbj:ubj,:)
1711 real(r8),
intent(inout) :: tl_vbar(lbi:ubi,lbj:ubj,:)
1713 real(r8),
intent(inout) :: tl_zeta(lbi:ubi,lbj:ubj,:)
1718 integer :: i, j, k, rec
1719 integer :: ib, ir, it
1721 real(r8) :: fac, fac1, fac2
1723 character (len=256) :: ncname
1725 character (len=*),
parameter :: myfile = &
1726 & __FILE__//
", tl_new_state"
1728# include "set_bounds.h"
1737 IF (innloop.ne.
ninner)
THEN
1743 tl_zeta(i,j,lout)=d_zeta(i,j)
1745 tl_zeta(i,j,lout)=tl_zeta(i,j,lout)*rmask(i,j)
1750# ifdef ADJUST_BOUNDARY
1757 &
domain(ng)%Western_Edge(tile))
THEN
1760 tl_zeta_obc(j,ib,ir,lout)=d_zeta_obc(j,ib,ir)
1762 tl_zeta_obc(j,ib,ir,lout)=tl_zeta_obc(j,ib,ir,lout)* &
1768 &
domain(ng)%Eastern_Edge(tile))
THEN
1771 tl_zeta_obc(j,ib,ir,lout)=d_zeta_obc(j,ib,ir)
1773 tl_zeta_obc(j,ib,ir,lout)=tl_zeta_obc(j,ib,ir,lout)* &
1779 &
domain(ng)%Southern_Edge(tile))
THEN
1782 tl_zeta_obc(i,ib,ir,lout)=d_zeta_obc(i,ib,ir)
1784 tl_zeta_obc(i,ib,ir,lout)=tl_zeta_obc(i,ib,ir,lout)* &
1790 &
domain(ng)%Northern_Edge(tile))
THEN
1793 tl_zeta_obc(i,ib,ir,lout)=d_zeta_obc(i,ib,ir)
1795 tl_zeta_obc(i,ib,ir,lout)=tl_zeta_obc(i,ib,ir,lout)* &
1810 tl_ubar(i,j,lout)=d_ubar(i,j)
1812 tl_ubar(i,j,lout)=tl_ubar(i,j,lout)*umask(i,j)
1818# ifdef ADJUST_BOUNDARY
1825 &
domain(ng)%Western_Edge(tile))
THEN
1828 tl_ubar_obc(j,ib,ir,lout)=d_ubar_obc(j,ib,ir)
1830 tl_ubar_obc(j,ib,ir,lout)=tl_ubar_obc(j,ib,ir,lout)* &
1836 &
domain(ng)%Eastern_Edge(tile))
THEN
1839 tl_ubar_obc(j,ib,ir,lout)=d_ubar_obc(j,ib,ir)
1841 tl_ubar_obc(j,ib,ir,lout)=tl_ubar_obc(j,ib,ir,lout)* &
1847 &
domain(ng)%Southern_Edge(tile))
THEN
1850 tl_ubar_obc(i,ib,ir,lout)=d_ubar_obc(i,ib,ir)
1852 tl_ubar_obc(i,ib,ir,lout)=tl_ubar_obc(i,ib,ir,lout)* &
1858 &
domain(ng)%Northern_Edge(tile))
THEN
1861 tl_ubar_obc(i,ib,ir,lout)=d_ubar_obc(i,ib,ir)
1863 tl_ubar_obc(i,ib,ir,lout)=tl_ubar_obc(i,ib,ir,lout)* &
1878 tl_vbar(i,j,lout)=d_vbar(i,j)
1880 tl_vbar(i,j,lout)=tl_vbar(i,j,lout)*vmask(i,j)
1886# ifdef ADJUST_BOUNDARY
1893 &
domain(ng)%Western_Edge(tile))
THEN
1896 tl_vbar_obc(j,ib,ir,lout)=d_vbar_obc(j,ib,ir)
1898 tl_vbar_obc(j,ib,ir,lout)=tl_vbar_obc(j,ib,ir,lout)* &
1904 &
domain(ng)%Eastern_Edge(tile))
THEN
1907 tl_vbar_obc(j,ib,ir,lout)=d_vbar_obc(j,ib,ir)
1909 tl_vbar_obc(j,ib,ir,lout)=tl_vbar_obc(j,ib,ir,lout)* &
1915 &
domain(ng)%Southern_Edge(tile))
THEN
1918 tl_vbar_obc(i,ib,ir,lout)=d_vbar_obc(i,ib,ir)
1920 tl_vbar_obc(i,ib,ir,lout)=tl_vbar_obc(i,ib,ir,lout)* &
1926 &
domain(ng)%Northern_Edge(tile))
THEN
1929 tl_vbar_obc(i,ib,ir,lout)=d_vbar_obc(i,ib,ir)
1931 tl_vbar_obc(i,ib,ir,lout)=tl_vbar_obc(i,ib,ir,lout)* &
1940# ifdef ADJUST_WSTRESS
1947 tl_ustr(i,j,ir,lout)=d_sustr(i,j,ir)
1949 tl_ustr(i,j,ir,lout)=tl_ustr(i,j,ir,lout)*umask(i,j)
1955 tl_vstr(i,j,ir,lout)=d_svstr(i,j,ir)
1957 tl_vstr(i,j,ir,lout)=tl_vstr(i,j,ir,lout)*vmask(i,j)
1971 tl_u(i,j,k,lout)=d_u(i,j,k)
1973 tl_u(i,j,k,lout)=tl_u(i,j,k,lout)*umask(i,j)
1979# ifdef ADJUST_BOUNDARY
1986 &
domain(ng)%Western_Edge(tile))
THEN
1990 tl_u_obc(j,k,ib,ir,lout)=d_u_obc(j,k,ib,ir)
1992 tl_u_obc(j,k,ib,ir,lout)=tl_u_obc(j,k,ib,ir,lout)* &
1999 &
domain(ng)%Eastern_Edge(tile))
THEN
2003 tl_u_obc(j,k,ib,ir,lout)=d_u_obc(j,k,ib,ir)
2005 tl_u_obc(j,k,ib,ir,lout)=tl_u_obc(j,k,ib,ir,lout)* &
2012 &
domain(ng)%Southern_Edge(tile))
THEN
2016 tl_u_obc(i,k,ib,ir,lout)=d_u_obc(i,k,ib,ir)
2018 tl_u_obc(i,k,ib,ir,lout)=tl_u_obc(i,k,ib,ir,lout)* &
2025 &
domain(ng)%Northern_Edge(tile))
THEN
2029 tl_u_obc(i,k,ib,ir,lout)=d_u_obc(i,k,ib,ir)
2031 tl_u_obc(i,k,ib,ir,lout)=tl_u_obc(i,k,ib,ir,lout)* &
2046 tl_v(i,j,k,lout)=d_v(i,j,k)
2048 tl_v(i,j,k,lout)=tl_v(i,j,k,lout)*vmask(i,j)
2054# ifdef ADJUST_BOUNDARY
2061 &
domain(ng)%Western_Edge(tile))
THEN
2065 tl_v_obc(j,k,ib,ir,lout)=d_v_obc(j,k,ib,ir)
2067 tl_v_obc(j,k,ib,ir,lout)=tl_v_obc(j,k,ib,ir,lout)* &
2074 &
domain(ng)%Eastern_Edge(tile))
THEN
2078 tl_v_obc(j,k,ib,ir,lout)=d_v_obc(j,k,ib,ir)
2080 tl_v_obc(j,k,ib,ir,lout)=tl_v_obc(j,k,ib,ir,lout)* &
2087 &
domain(ng)%Southern_Edge(tile))
THEN
2091 tl_v_obc(i,k,ib,ir,lout)=d_v_obc(i,k,ib,ir)
2093 tl_v_obc(i,k,ib,ir,lout)=tl_v_obc(i,k,ib,ir,lout)* &
2100 &
domain(ng)%Northern_Edge(tile))
THEN
2104 tl_v_obc(i,k,ib,ir,lout)=d_v_obc(i,k,ib,ir)
2106 tl_v_obc(i,k,ib,ir,lout)=tl_v_obc(i,k,ib,ir,lout)* &
2122 tl_t(i,j,k,lout,it)=d_t(i,j,k,it)
2124 tl_t(i,j,k,lout,it)=tl_t(i,j,k,lout,it)*rmask(i,j)
2131# ifdef ADJUST_BOUNDARY
2139 &
domain(ng)%Western_Edge(tile))
THEN
2143 tl_t_obc(j,k,ib,ir,lout,it)=d_t_obc(j,k,ib,ir,it)
2145 tl_t_obc(j,k,ib,ir,lout,it)= &
2146 & tl_t_obc(j,k,ib,ir,lout,it)*rmask(istr-1,j)
2152 &
domain(ng)%Eastern_Edge(tile))
THEN
2156 tl_t_obc(j,k,ib,ir,lout,it)=d_t_obc(j,k,ib,ir,it)
2158 tl_t_obc(j,k,ib,ir,lout,it)= &
2159 & tl_t_obc(j,k,ib,ir,lout,it)*rmask(iend+1,j)
2165 &
domain(ng)%Southern_Edge(tile))
THEN
2169 tl_t_obc(i,k,ib,ir,lout,it)=d_t_obc(i,k,ib,ir,it)
2171 tl_t_obc(i,k,ib,ir,lout,it)= &
2172 & tl_t_obc(i,k,ib,ir,lout,it)*rmask(i,jstr-1)
2178 &
domain(ng)%Northern_Edge(tile))
THEN
2182 tl_t_obc(i,k,ib,ir,lout,it)=d_t_obc(i,k,ib,ir,it)
2184 tl_t_obc(i,k,ib,ir,lout,it)= &
2185 & tl_t_obc(i,k,ib,ir,lout,it)*rmask(i,jend+1)
2195# ifdef ADJUST_STFLUX
2204 tl_tflux(i,j,ir,lout,it)=d_stflx(i,j,ir,it)
2206 tl_tflux(i,j,ir,lout,it)=tl_tflux(i,j,ir,lout,it)* &
2234 & lbi, ubi, lbj, ubj, lbij, ubij, &
2237 & rmask, umask, vmask, &
2239# ifdef ADJUST_BOUNDARY
2241 & ad_t_obc, ad_u_obc, ad_v_obc, &
2243 & ad_ubar_obc, ad_vbar_obc, &
2246# ifdef ADJUST_WSTRESS
2247 & ad_ustr, ad_vstr, &
2250# ifdef ADJUST_STFLUX
2253 & ad_t, ad_u, ad_v, &
2255 & ad_ubar, ad_vbar, &
2262 WRITE (ncname,10) trim(
adm(ng)%base), outloop
2263 10
FORMAT (a,
'_',i3.3,
'.nc')
2274 & lbi, ubi, lbj, ubj, lbij, ubij, &
2277# if defined PIO_LIB && defined DISTRIBUTE
2278 &
adm(ng)%pioFile, &
2282 & rmask, umask, vmask, &
2284# ifdef ADJUST_BOUNDARY
2286 & tl_t_obc, tl_u_obc, tl_v_obc, &
2288 & tl_ubar_obc, tl_vbar_obc, &
2291# ifdef ADJUST_WSTRESS
2292 & tl_ustr, tl_vstr, &
2295# ifdef ADJUST_STFLUX
2298 & tl_t, tl_u, tl_v, &
2300 & tl_ubar, tl_vbar, &
2310 fac2=
cg_zu(rec,outloop)
2313 & lbi, ubi, lbj, ubj, lbij, ubij, &
2314 & linp, lout, linp, fac1, fac2, &
2316 & rmask, umask, vmask, &
2318# ifdef ADJUST_BOUNDARY
2320 & ad_t_obc, tl_t_obc, &
2321 & ad_u_obc, tl_u_obc, &
2322 & ad_v_obc, tl_v_obc, &
2324 & ad_ubar_obc, tl_ubar_obc, &
2325 & ad_vbar_obc, tl_vbar_obc, &
2326 & ad_zeta_obc, tl_zeta_obc, &
2328# ifdef ADJUST_WSTRESS
2329 & ad_ustr, tl_ustr, &
2330 & ad_vstr, tl_vstr, &
2333# ifdef ADJUST_STFLUX
2334 & ad_tflux, tl_tflux, &
2340 & ad_ubar, tl_ubar, &
2341 & ad_vbar, tl_vbar, &
2352 & lbi, ubi, lbj, ubj, lbij, ubij, &
2354# ifdef ADJUST_BOUNDARY
2356 & tl_t_obc, ad_t_obc, &
2357 & tl_u_obc, ad_u_obc, &
2358 & tl_v_obc, ad_v_obc, &
2360 & tl_ubar_obc, ad_ubar_obc, &
2361 & tl_vbar_obc, ad_vbar_obc, &
2362 & tl_zeta_obc, ad_zeta_obc, &
2364# ifdef ADJUST_WSTRESS
2365 & tl_ustr, ad_ustr, &
2366 & tl_vstr, ad_vstr, &
2369# ifdef ADJUST_STFLUX
2370 & tl_tflux, ad_tflux, &
2376 & tl_ubar, ad_ubar, &
2377 & tl_vbar, ad_vbar, &
2387 & LBi, UBi, LBj, UBj, LBij, UBij, &
2388 & IminS, ImaxS, JminS, JmaxS, &
2391 & rmask, umask, vmask, &
2393# ifdef ADJUST_BOUNDARY
2395 & ad_t_obc, ad_u_obc, ad_v_obc, &
2397 & ad_ubar_obc, ad_vbar_obc, &
2400# ifdef ADJUST_WSTRESS
2401 & ad_ustr, ad_vstr, &
2404# ifdef ADJUST_STFLUX
2407 & ad_t, ad_u, ad_v, &
2409 & ad_ubar, ad_vbar, &
2412# ifdef ADJUST_BOUNDARY
2414 & d_t_obc, d_u_obc, d_v_obc, &
2416 & d_ubar_obc, d_vbar_obc, &
2419# ifdef ADJUST_WSTRESS
2420 & d_sustr, d_svstr, &
2423# ifdef ADJUST_STFLUX
2435 integer,
intent(in) :: ng, tile, model
2436 integer,
intent(in) :: lbi, ubi, lbj, ubj, lbij, ubij
2437 integer,
intent(in) :: imins, imaxs, jmins, jmaxs
2440# ifdef ASSUMED_SHAPE
2442 real(r8),
intent(in) :: rmask(lbi:,lbj:)
2443 real(r8),
intent(in) :: umask(lbi:,lbj:)
2444 real(r8),
intent(in) :: vmask(lbi:,lbj:)
2446# ifdef ADJUST_BOUNDARY
2448 real(r8),
intent(in) :: ad_t_obc(lbij:,:,:,:,:,:)
2449 real(r8),
intent(in) :: ad_u_obc(lbij:,:,:,:,:)
2450 real(r8),
intent(in) :: ad_v_obc(lbij:,:,:,:,:)
2452 real(r8),
intent(in) :: ad_ubar_obc(lbij:,:,:,:)
2453 real(r8),
intent(in) :: ad_vbar_obc(lbij:,:,:,:)
2454 real(r8),
intent(in) :: ad_zeta_obc(lbij:,:,:,:)
2456# ifdef ADJUST_WSTRESS
2457 real(r8),
intent(in) :: ad_ustr(lbi:,lbj:,:,:)
2458 real(r8),
intent(in) :: ad_vstr(lbi:,lbj:,:,:)
2461# ifdef ADJUST_STFLUX
2462 real(r8),
intent(in) :: ad_tflux(lbi:,lbj:,:,:,:)
2464 real(r8),
intent(in) :: ad_t(lbi:,lbj:,:,:,:)
2465 real(r8),
intent(in) :: ad_u(lbi:,lbj:,:,:)
2466 real(r8),
intent(in) :: ad_v(lbi:,lbj:,:,:)
2468 real(r8),
intent(in) :: ad_ubar(lbi:,lbj:,:)
2469 real(r8),
intent(in) :: ad_vbar(lbi:,lbj:,:)
2471 real(r8),
intent(in) :: ad_zeta(lbi:,lbj:,:)
2472# ifdef ADJUST_BOUNDARY
2474 real(r8),
intent(inout) :: d_t_obc(lbij:,:,:,:,:)
2475 real(r8),
intent(inout) :: d_u_obc(lbij:,:,:,:)
2476 real(r8),
intent(inout) :: d_v_obc(lbij:,:,:,:)
2478 real(r8),
intent(inout) :: d_ubar_obc(lbij:,:,:)
2479 real(r8),
intent(inout) :: d_vbar_obc(lbij:,:,:)
2480 real(r8),
intent(inout) :: d_zeta_obc(lbij:,:,:)
2482# ifdef ADJUST_WSTRESS
2483 real(r8),
intent(inout) :: d_sustr(lbi:,lbj:,:)
2484 real(r8),
intent(inout) :: d_svstr(lbi:,lbj:,:)
2487# ifdef ADJUST_STFLUX
2488 real(r8),
intent(inout) :: d_stflx(lbi:,lbj:,:,:)
2490 real(r8),
intent(inout) :: d_t(lbi:,lbj:,:,:)
2491 real(r8),
intent(inout) :: d_u(lbi:,lbj:,:)
2492 real(r8),
intent(inout) :: d_v(lbi:,lbj:,:)
2494 real(r8),
intent(inout) :: d_ubar(lbi:,lbj:)
2495 real(r8),
intent(inout) :: d_vbar(lbi:,lbj:)
2497 real(r8),
intent(inout) :: d_zeta(lbi:,lbj:)
2502 real(r8),
intent(in) :: rmask(lbi:ubi,lbj:ubj)
2503 real(r8),
intent(in) :: umask(lbi:ubi,lbj:ubj)
2504 real(r8),
intent(in) :: vmask(lbi:ubi,lbj:ubj)
2506# ifdef ADJUST_BOUNDARY
2508 real(r8),
intent(in) :: ad_t_obc(lbij:ubij,
n(ng),4, &
2509 & Nbrec(ng),2,NT(ng))
2510 real(r8),
intent(in) :: ad_u_obc(lbij:ubij,
n(ng),4,
nbrec(ng),2)
2511 real(r8),
intent(in) :: ad_v_obc(lbij:ubij,
n(ng),4,
nbrec(ng),2)
2513 real(r8),
intent(in) :: ad_ubar_obc(lbij:ubij,4,
nbrec(ng),2)
2514 real(r8),
intent(in) :: ad_vbar_obc(lbij:ubij,4,
nbrec(ng),2)
2515 real(r8),
intent(in) :: ad_zeta_obc(lbij:ubij,4,
nbrec(ng),2)
2517# ifdef ADJUST_WSTRESS
2518 real(r8),
intent(in) :: ad_ustr(lbi:ubi,lbj:ubj,
nfrec(ng),2)
2519 real(r8),
intent(in) :: ad_vstr(lbi:ubi,lbj:ubj,
nfrec(ng),2)
2522# ifdef ADJUST_STFLUX
2523 real(r8),
intent(in) :: ad_tflux(lbi:ubi,lbj:ubj, &
2524 & Nfrec(ng),2,NT(ng))
2526 real(r8),
intent(in) :: ad_t(lbi:ubi,lbj:ubj,
n(ng),3,
nt(ng))
2527 real(r8),
intent(in) :: ad_u(lbi:ubi,lbj:ubj,
n(ng),2)
2528 real(r8),
intent(in) :: ad_v(lbi:ubi,lbj:ubj,
n(ng),2)
2530 real(r8),
intent(in) :: ad_ubar(lbi:ubi,lbj:ubj,:)
2531 real(r8),
intent(in) :: ad_vbar(lbi:ubi,lbj:ubj,:)
2533 real(r8),
intent(in) :: ad_zeta(lbi:ubi,lbj:ubj,:)
2534# ifdef ADJUST_BOUNDARY
2536 real(r8),
intent(inout) :: d_t_obc(lbij:ubij,
n(ng),4, &
2538 real(r8),
intent(inout) :: d_u_obc(lbij:ubij,
n(ng),4,
nbrec(ng))
2539 real(r8),
intent(inout) :: d_v_obc(lbij:ubij,
n(ng),4,
nbrec(ng))
2541 real(r8),
intent(inout) :: d_ubar_obc(lbij:ubij,4,
nbrec(ng))
2542 real(r8),
intent(inout) :: d_vbar_obc(lbij:ubij,4,
nbrec(ng))
2543 real(r8),
intent(inout) :: d_zeta_obc(lbij:ubij,4,
nbrec(ng))
2545# ifdef ADJUST_WSTRESS
2546 real(r8),
intent(inout) :: d_sustr(lbi:ubi,lbj:ubj,
nfrec(ng))
2547 real(r8),
intent(inout) :: d_svstr(lbi:ubi,lbj:ubj,
nfrec(ng))
2550# ifdef ADJUST_STFLUX
2551 real(r8),
intent(inout) :: d_stflx(lbi:ubi,lbj:ubj, &
2554 real(r8),
intent(inout) :: d_t(lbi:ubi,lbj:ubj,
n(ng),
nt(ng))
2555 real(r8),
intent(inout) :: d_u(lbi:ubi,lbj:ubj,
n(ng))
2556 real(r8),
intent(inout) :: d_v(lbi:ubi,lbj:ubj,
n(ng))
2558 real(r8),
intent(inout) :: d_ubar(lbi:ubi,lbj:ubj)
2559 real(r8),
intent(inout) :: d_vbar(lbi:ubi,lbj:ubj)
2561 real(r8),
intent(inout) :: d_zeta(lbi:ubi,lbj:ubj)
2567 integer :: ib, ir, it
2569# include "set_bounds.h"
2580 d_zeta(i,j)=ad_zeta(i,j,
lnew)
2582 d_zeta(i,j)=d_zeta(i,j)*rmask(i,j)
2587# ifdef ADJUST_BOUNDARY
2594 &
domain(ng)%Western_Edge(tile))
THEN
2597 d_zeta_obc(j,ib,ir)=ad_zeta_obc(j,ib,ir,
lnew)
2599 d_zeta_obc(j,ib,ir)=d_zeta_obc(j,ib,ir)* &
2605 &
domain(ng)%Eastern_Edge(tile))
THEN
2608 d_zeta_obc(j,ib,ir)=ad_zeta_obc(j,ib,ir,
lnew)
2610 d_zeta_obc(j,ib,ir)=d_zeta_obc(j,ib,ir)* &
2616 &
domain(ng)%Southern_Edge(tile))
THEN
2619 d_zeta_obc(i,ib,ir)=ad_zeta_obc(i,ib,ir,
lnew)
2621 d_zeta_obc(i,ib,ir)=d_zeta_obc(i,ib,ir)* &
2627 &
domain(ng)%Northern_Edge(tile))
THEN
2630 d_zeta_obc(i,ib,ir)=ad_zeta_obc(i,ib,ir,
lnew)
2632 d_zeta_obc(i,ib,ir)=d_zeta_obc(i,ib,ir)* &
2647 d_ubar(i,j)=ad_ubar(i,j,
lnew)
2649 d_ubar(i,j)=d_ubar(i,j)*umask(i,j)
2655# ifdef ADJUST_BOUNDARY
2662 &
domain(ng)%Western_Edge(tile))
THEN
2665 d_ubar_obc(j,ib,ir)=ad_ubar_obc(j,ib,ir,
lnew)
2667 d_ubar_obc(j,ib,ir)=d_ubar_obc(j,ib,ir)* &
2673 &
domain(ng)%Eastern_Edge(tile))
THEN
2676 d_ubar_obc(j,ib,ir)=ad_ubar_obc(j,ib,ir,
lnew)
2678 d_ubar_obc(j,ib,ir)=d_ubar_obc(j,ib,ir)* &
2684 &
domain(ng)%Southern_Edge(tile))
THEN
2687 d_ubar_obc(i,ib,ir)=ad_ubar_obc(i,ib,ir,
lnew)
2689 d_ubar_obc(i,ib,ir)=d_ubar_obc(i,ib,ir)* &
2695 &
domain(ng)%Northern_Edge(tile))
THEN
2698 d_ubar_obc(i,ib,ir)=ad_ubar_obc(i,ib,ir,
lnew)
2700 d_ubar_obc(i,ib,ir)=d_ubar_obc(i,ib,ir)* &
2715 d_vbar(i,j)=ad_vbar(i,j,
lnew)
2717 d_vbar(i,j)=d_vbar(i,j)*vmask(i,j)
2723# ifdef ADJUST_BOUNDARY
2730 &
domain(ng)%Western_Edge(tile))
THEN
2733 d_vbar_obc(j,ib,ir)=ad_vbar_obc(j,ib,ir,
lnew)
2735 d_vbar_obc(j,ib,ir)=d_vbar_obc(j,ib,ir)* &
2741 &
domain(ng)%Eastern_Edge(tile))
THEN
2744 d_vbar_obc(j,ib,ir)=ad_vbar_obc(j,ib,ir,
lnew)
2746 d_vbar_obc(j,ib,ir)=d_vbar_obc(j,ib,ir)* &
2752 &
domain(ng)%Southern_Edge(tile))
THEN
2755 d_vbar_obc(i,ib,ir)=ad_vbar_obc(i,ib,ir,
lnew)
2757 d_vbar_obc(i,ib,ir)=d_vbar_obc(i,ib,ir)* &
2763 &
domain(ng)%Northern_Edge(tile))
THEN
2766 d_vbar_obc(i,ib,ir)=ad_vbar_obc(i,ib,ir,
lnew)
2768 d_vbar_obc(i,ib,ir)=d_vbar_obc(i,ib,ir)* &
2777# ifdef ADJUST_WSTRESS
2784 d_sustr(i,j,ir)=ad_ustr(i,j,ir,
lnew)
2786 d_sustr(i,j,ir)=d_sustr(i,j,ir)*umask(i,j)
2792 d_svstr(i,j,ir)=ad_vstr(i,j,ir,
lnew)
2794 d_svstr(i,j,ir)=d_svstr(i,j,ir)*vmask(i,j)
2808 d_u(i,j,k)=ad_u(i,j,k,
lnew)
2810 d_u(i,j,k)=d_u(i,j,k)*umask(i,j)
2816# ifdef ADJUST_BOUNDARY
2823 &
domain(ng)%Western_Edge(tile))
THEN
2827 d_u_obc(j,k,ib,ir)=ad_u_obc(j,k,ib,ir,
lnew)
2829 d_u_obc(j,k,ib,ir)=d_u_obc(j,k,ib,ir)* &
2836 &
domain(ng)%Eastern_Edge(tile))
THEN
2840 d_u_obc(j,k,ib,ir)=ad_u_obc(j,k,ib,ir,
lnew)
2842 d_u_obc(j,k,ib,ir)=d_u_obc(j,k,ib,ir)* &
2849 &
domain(ng)%Southern_Edge(tile))
THEN
2853 d_u_obc(i,k,ib,ir)=ad_u_obc(i,k,ib,ir,
lnew)
2855 d_u_obc(i,k,ib,ir)=d_u_obc(i,k,ib,ir)* &
2862 &
domain(ng)%Northern_Edge(tile))
THEN
2866 d_u_obc(i,k,ib,ir)=ad_u_obc(i,k,ib,ir,
lnew)
2868 d_u_obc(i,k,ib,ir)=d_u_obc(i,k,ib,ir)* &
2883 d_v(i,j,k)=ad_v(i,j,k,
lnew)
2885 d_v(i,j,k)=d_v(i,j,k)*vmask(i,j)
2891# ifdef ADJUST_BOUNDARY
2898 &
domain(ng)%Western_Edge(tile))
THEN
2902 d_v_obc(j,k,ib,ir)=ad_v_obc(j,k,ib,ir,
lnew)
2904 d_v_obc(j,k,ib,ir)=d_v_obc(j,k,ib,ir)* &
2911 &
domain(ng)%Eastern_Edge(tile))
THEN
2915 d_v_obc(j,k,ib,ir)=ad_v_obc(j,k,ib,ir,
lnew)
2917 d_v_obc(j,k,ib,ir)=d_v_obc(j,k,ib,ir)* &
2924 &
domain(ng)%Southern_Edge(tile))
THEN
2928 d_v_obc(i,k,ib,ir)=ad_v_obc(i,k,ib,ir,
lnew)
2930 d_v_obc(i,k,ib,ir)=d_v_obc(i,k,ib,ir)* &
2937 &
domain(ng)%Northern_Edge(tile))
THEN
2941 d_v_obc(i,k,ib,ir)=ad_v_obc(i,k,ib,ir,
lnew)
2943 d_v_obc(i,k,ib,ir)=d_v_obc(i,k,ib,ir)* &
2959 d_t(i,j,k,it)=ad_t(i,j,k,
lnew,it)
2961 d_t(i,j,k,it)=d_t(i,j,k,it)*rmask(i,j)
2968# ifdef ADJUST_BOUNDARY
2976 &
domain(ng)%Western_Edge(tile))
THEN
2980 d_t_obc(j,k,ib,ir,it)=ad_t_obc(j,k,ib,ir,
lnew,it)
2982 d_t_obc(j,k,ib,ir,it)=d_t_obc(j,k,ib,ir,it)* &
2989 &
domain(ng)%Eastern_Edge(tile))
THEN
2993 d_t_obc(j,k,ib,ir,it)=ad_t_obc(j,k,ib,ir,
lnew,it)
2995 d_t_obc(j,k,ib,ir,it)=d_t_obc(j,k,ib,ir,it)* &
3002 &
domain(ng)%Southern_Edge(tile))
THEN
3006 d_t_obc(i,k,ib,ir,it)=ad_t_obc(i,k,ib,ir,
lnew,it)
3008 d_t_obc(i,k,ib,ir,it)=d_t_obc(i,k,ib,ir,it)* &
3015 &
domain(ng)%Northern_Edge(tile))
THEN
3019 d_t_obc(i,k,ib,ir,it)=ad_t_obc(i,k,ib,ir,
lnew,it)
3021 d_t_obc(i,k,ib,ir,it)=d_t_obc(i,k,ib,ir,it)* &
3032# ifdef ADJUST_STFLUX
3041 d_stflx(i,j,ir,it)=ad_tflux(i,j,ir,
lnew,it)
3043 d_stflx(i,j,ir,it)=d_stflx(i,j,ir,it)*rmask(i,j)
3058 & LBi, UBi, LBj, UBj, LBij, UBij, &
3059 & IminS, ImaxS, JminS, JmaxS, &
3060 & Lold, Lnew, Lwrk, &
3061 & innLoop, outLoop, &
3063 & rmask, umask, vmask, &
3065# ifdef ADJUST_BOUNDARY
3067 & ad_t_obc, ad_u_obc, ad_v_obc, &
3069 & ad_ubar_obc, ad_vbar_obc, &
3072# ifdef ADJUST_WSTRESS
3073 & ad_ustr, ad_vstr, &
3076# ifdef ADJUST_STFLUX
3079 & ad_t, ad_u, ad_v, &
3081 & ad_ubar, ad_vbar, &
3084# ifdef ADJUST_BOUNDARY
3086 & tl_t_obc, tl_u_obc, tl_v_obc, &
3088 & tl_ubar_obc, tl_vbar_obc, &
3091# ifdef ADJUST_WSTRESS
3092 & tl_ustr, tl_vstr, &
3095# ifdef ADJUST_STFLUX
3098 & tl_t, tl_u, tl_v, &
3100 & tl_ubar, tl_vbar, &
3107 integer,
intent(in) :: ng, tile, model
3108 integer,
intent(in) :: lbi, ubi, lbj, ubj, lbij, ubij
3109 integer,
intent(in) :: imins, imaxs, jmins, jmaxs
3110 integer,
intent(in) ::
lold,
lnew, lwrk
3111 integer,
intent(in) :: innloop, outloop
3113# ifdef ASSUMED_SHAPE
3115 real(r8),
intent(in) :: rmask(lbi:,lbj:)
3116 real(r8),
intent(in) :: umask(lbi:,lbj:)
3117 real(r8),
intent(in) :: vmask(lbi:,lbj:)
3119# ifdef ADJUST_BOUNDARY
3121 real(r8),
intent(inout) :: ad_t_obc(lbij:,:,:,:,:,:)
3122 real(r8),
intent(inout) :: ad_u_obc(lbij:,:,:,:,:)
3123 real(r8),
intent(inout) :: ad_v_obc(lbij:,:,:,:,:)
3125 real(r8),
intent(inout) :: ad_ubar_obc(lbij:,:,:,:)
3126 real(r8),
intent(inout) :: ad_vbar_obc(lbij:,:,:,:)
3127 real(r8),
intent(inout) :: ad_zeta_obc(lbij:,:,:,:)
3129# ifdef ADJUST_WSTRESS
3130 real(r8),
intent(inout) :: ad_ustr(lbi:,lbj:,:,:)
3131 real(r8),
intent(inout) :: ad_vstr(lbi:,lbj:,:,:)
3134# ifdef ADJUST_STFLUX
3135 real(r8),
intent(inout) :: ad_tflux(lbi:,lbj:,:,:,:)
3137 real(r8),
intent(inout) :: ad_t(lbi:,lbj:,:,:,:)
3138 real(r8),
intent(inout) :: ad_u(lbi:,lbj:,:,:)
3139 real(r8),
intent(inout) :: ad_v(lbi:,lbj:,:,:)
3141 real(r8),
intent(inout) :: ad_ubar(lbi:,lbj:,:)
3142 real(r8),
intent(inout) :: ad_vbar(lbi:,lbj:,:)
3144 real(r8),
intent(inout) :: ad_zeta(lbi:,lbj:,:)
3145# ifdef ADJUST_BOUNDARY
3147 real(r8),
intent(inout) :: tl_t_obc(lbij:,:,:,:,:,:)
3148 real(r8),
intent(inout) :: tl_u_obc(lbij:,:,:,:,:)
3149 real(r8),
intent(inout) :: tl_v_obc(lbij:,:,:,:,:)
3151 real(r8),
intent(inout) :: tl_ubar_obc(lbij:,:,:,:)
3152 real(r8),
intent(inout) :: tl_vbar_obc(lbij:,:,:,:)
3153 real(r8),
intent(inout) :: tl_zeta_obc(lbij:,:,:,:)
3155# ifdef ADJUST_WSTRESS
3156 real(r8),
intent(inout) :: tl_ustr(lbi:,lbj:,:,:)
3157 real(r8),
intent(inout) :: tl_vstr(lbi:,lbj:,:,:)
3160# ifdef ADJUST_STFLUX
3161 real(r8),
intent(inout) :: tl_tflux(lbi:,lbj:,:,:,:)
3163 real(r8),
intent(inout) :: tl_t(lbi:,lbj:,:,:,:)
3164 real(r8),
intent(inout) :: tl_u(lbi:,lbj:,:,:)
3165 real(r8),
intent(inout) :: tl_v(lbi:,lbj:,:,:)
3167 real(r8),
intent(inout) :: tl_ubar(lbi:,lbj:,:)
3168 real(r8),
intent(inout) :: tl_vbar(lbi:,lbj:,:)
3170 real(r8),
intent(inout) :: tl_zeta(lbi:,lbj:,:)
3175 real(r8),
intent(in) :: rmask(lbi:ubi,lbj:ubj)
3176 real(r8),
intent(in) :: umask(lbi:ubi,lbj:ubj)
3177 real(r8),
intent(in) :: vmask(lbi:ubi,lbj:ubj)
3179# ifdef ADJUST_BOUNDARY
3181 real(r8),
intent(inout) :: ad_t_obc(lbij:ubij,
n(ng),4, &
3182 & Nbrec(ng),2,NT(ng))
3183 real(r8),
intent(inout) :: ad_u_obc(lbij:ubij,
n(ng),4,
nbrec(ng),2)
3184 real(r8),
intent(inout) :: ad_v_obc(lbij:ubij,
n(ng),4,
nbrec(ng),2)
3186 real(r8),
intent(inout) :: ad_ubar_obc(lbij:ubij,4,
nbrec(ng),2)
3187 real(r8),
intent(inout) :: ad_vbar_obc(lbij:ubij,4,
nbrec(ng),2)
3188 real(r8),
intent(inout) :: ad_zeta_obc(lbij:ubij,4,
nbrec(ng),2)
3190# ifdef ADJUST_WSTRESS
3191 real(r8),
intent(inout) :: ad_ustr(lbi:ubi,lbj:ubj,
nfrec(ng),2)
3192 real(r8),
intent(inout) :: ad_vstr(lbi:ubi,lbj:ubj,
nfrec(ng),2)
3195# ifdef ADJUST_STFLUX
3196 real(r8),
intent(inout) :: ad_tflux(lbi:ubi,lbj:ubj, &
3197 & Nfrec(ng),2,NT(ng))
3199 real(r8),
intent(inout) :: ad_t(lbi:ubi,lbj:ubj,
n(ng),3,
nt(ng))
3200 real(r8),
intent(inout) :: ad_u(lbi:ubi,lbj:ubj,
n(ng),2)
3201 real(r8),
intent(inout) :: ad_v(lbi:ubi,lbj:ubj,
n(ng),2)
3203 real(r8),
intent(inout) :: ad_ubar(lbi:ubi,lbj:ubj,:)
3204 real(r8),
intent(inout) :: ad_vbar(lbi:ubi,lbj:ubj,:)
3206 real(r8),
intent(inout) :: ad_zeta(lbi:ubi,lbj:ubj,:)
3207# ifdef ADJUST_BOUNDARY
3209 real(r8),
intent(inout) :: tl_t_obc(lbij:ubij,
n(ng),4, &
3210 & Nbrec(ng),2,NT(ng))
3211 real(r8),
intent(inout) :: tl_u_obc(lbij:ubij,
n(ng),4,
nbrec(ng),2)
3212 real(r8),
intent(inout) :: tl_v_obc(lbij:ubij,
n(ng),4,
nbrec(ng),2)
3214 real(r8),
intent(inout) :: tl_ubar_obc(lbij:ubij,4,
nbrec(ng),2)
3215 real(r8),
intent(inout) :: tl_vbar_obc(lbij:ubij,4,
nbrec(ng),2)
3216 real(r8),
intent(inout) :: tl_zeta_obc(lbij:ubij,4,
nbrec(ng),2)
3218# ifdef ADJUST_WSTRESS
3219 real(r8),
intent(inout) :: tl_ustr(lbi:ubi,lbj:ubj,
nfrec(ng),2)
3220 real(r8),
intent(inout) :: tl_vstr(lbi:ubi,lbj:ubj,
nfrec(ng),2)
3223# ifdef ADJUST_STFLUX
3224 real(r8),
intent(inout) :: tl_tflux(lbi:ubi,lbj:ubj, &
3225 & Nfrec(ng),2,NT(ng))
3227 real(r8),
intent(inout) :: tl_t(lbi:ubi,lbj:ubj,
n(ng),3,
nt(ng))
3228 real(r8),
intent(inout) :: tl_u(lbi:ubi,lbj:ubj,
n(ng),2)
3229 real(r8),
intent(inout) :: tl_v(lbi:ubi,lbj:ubj,
n(ng),2)
3231 real(r8),
intent(inout) :: tl_ubar(lbi:ubi,lbj:ubj,:)
3232 real(r8),
intent(inout) :: tl_vbar(lbi:ubi,lbj:ubj,:)
3234 real(r8),
intent(inout) :: tl_zeta(lbi:ubi,lbj:ubj,:)
3240 integer :: ib, ir, it
3244 real(r8),
dimension(0:NstateVar(ng)) :: dot
3246 character (len=256) :: ncname
3248 character (len=*),
parameter :: myfile = &
3249 & __FILE__//
", hessian"
3251# include "set_bounds.h"
3274 ad_zeta(i,j,
lnew)=ad_zeta(i,j,
lnew)- &
3275 & ad_zeta(i,j,
lold)* &
3278 ad_zeta(i,j,
lnew)=ad_zeta(i,j,
lnew)*rmask(i,j)
3283# ifdef ADJUST_BOUNDARY
3290 &
domain(ng)%Western_Edge(tile))
THEN
3293 ad_zeta_obc(j,ib,ir,
lnew)=ad_zeta_obc(j,ib,ir,
lnew)- &
3294 & ad_zeta_obc(j,ib,ir,
lold)* &
3297 ad_zeta_obc(j,ib,ir,
lnew)=ad_zeta_obc(j,ib,ir,
lnew)* &
3303 &
domain(ng)%Eastern_Edge(tile))
THEN
3306 ad_zeta_obc(j,ib,ir,
lnew)=ad_zeta_obc(j,ib,ir,
lnew)- &
3307 & ad_zeta_obc(j,ib,ir,
lold)* &
3310 ad_zeta_obc(j,ib,ir,
lnew)=ad_zeta_obc(j,ib,ir,
lnew)* &
3316 &
domain(ng)%Southern_Edge(tile))
THEN
3319 ad_zeta_obc(i,ib,ir,
lnew)=ad_zeta_obc(i,ib,ir,
lnew)- &
3320 & ad_zeta_obc(i,ib,ir,
lold)* &
3323 ad_zeta_obc(i,ib,ir,
lnew)=ad_zeta_obc(i,ib,ir,
lnew)* &
3329 &
domain(ng)%Northern_Edge(tile))
THEN
3332 ad_zeta_obc(i,ib,ir,
lnew)=ad_zeta_obc(i,ib,ir,
lnew)- &
3333 & ad_zeta_obc(i,ib,ir,
lold)* &
3336 ad_zeta_obc(i,ib,ir,
lnew)=ad_zeta_obc(i,ib,ir,
lnew)* &
3351 ad_ubar(i,j,
lnew)=ad_ubar(i,j,
lnew)- &
3352 & ad_ubar(i,j,
lold)* &
3355 ad_ubar(i,j,
lnew)=ad_ubar(i,j,
lnew)*umask(i,j)
3361# ifdef ADJUST_BOUNDARY
3368 &
domain(ng)%Western_Edge(tile))
THEN
3371 ad_ubar_obc(j,ib,ir,
lnew)=ad_ubar_obc(j,ib,ir,
lnew)- &
3372 & ad_ubar_obc(j,ib,ir,
lold)* &
3375 ad_ubar_obc(j,ib,ir,
lnew)=ad_ubar_obc(j,ib,ir,
lnew)* &
3381 &
domain(ng)%Eastern_Edge(tile))
THEN
3384 ad_ubar_obc(j,ib,ir,
lnew)=ad_ubar_obc(j,ib,ir,
lnew)- &
3385 & ad_ubar_obc(j,ib,ir,
lold)* &
3388 ad_ubar_obc(j,ib,ir,
lnew)=ad_ubar_obc(j,ib,ir,
lnew)* &
3394 &
domain(ng)%Southern_Edge(tile))
THEN
3397 ad_ubar_obc(i,ib,ir,
lnew)=ad_ubar_obc(i,ib,ir,
lnew)- &
3398 & ad_ubar_obc(i,ib,ir,
lold)* &
3401 ad_ubar_obc(i,ib,ir,
lnew)=ad_ubar_obc(i,ib,ir,
lnew)* &
3407 &
domain(ng)%Northern_Edge(tile))
THEN
3410 ad_ubar_obc(i,ib,ir,
lnew)=ad_ubar_obc(i,ib,ir,
lnew)- &
3411 & ad_ubar_obc(i,ib,ir,
lold)* &
3414 ad_ubar_obc(i,ib,ir,
lnew)=ad_ubar_obc(i,ib,ir,
lnew)* &
3429 ad_vbar(i,j,
lnew)=ad_vbar(i,j,
lnew)- &
3430 & ad_vbar(i,j,
lold)* &
3433 ad_vbar(i,j,
lnew)=ad_vbar(i,j,
lnew)*vmask(i,j)
3439# ifdef ADJUST_BOUNDARY
3446 &
domain(ng)%Western_Edge(tile))
THEN
3449 ad_vbar_obc(j,ib,ir,
lnew)=ad_vbar_obc(j,ib,ir,
lnew)- &
3450 & ad_vbar_obc(j,ib,ir,
lold)* &
3453 ad_vbar_obc(j,ib,ir,
lnew)=ad_vbar_obc(j,ib,ir,
lnew)* &
3459 &
domain(ng)%Eastern_Edge(tile))
THEN
3462 ad_vbar_obc(j,ib,ir,
lnew)=ad_vbar_obc(j,ib,ir,
lnew)- &
3463 & ad_vbar_obc(j,ib,ir,
lold)* &
3466 ad_vbar_obc(j,ib,ir,
lnew)=ad_vbar_obc(j,ib,ir,
lnew)* &
3472 &
domain(ng)%Southern_Edge(tile))
THEN
3475 ad_vbar_obc(i,ib,ir,
lnew)=ad_vbar_obc(i,ib,ir,
lnew)- &
3476 & ad_vbar_obc(i,ib,ir,
lold)* &
3479 ad_vbar_obc(i,ib,ir,
lnew)=ad_vbar_obc(i,ib,ir,
lnew)* &
3485 &
domain(ng)%Northern_Edge(tile))
THEN
3488 ad_vbar_obc(i,ib,ir,
lnew)=ad_vbar_obc(i,ib,ir,
lnew)- &
3489 & ad_vbar_obc(i,ib,ir,
lold)* &
3492 ad_vbar_obc(i,ib,ir,
lnew)=ad_vbar_obc(i,ib,ir,
lnew)* &
3501# ifdef ADJUST_WSTRESS
3508 ad_ustr(i,j,ir,
lnew)=ad_ustr(i,j,ir,
lnew)- &
3509 & ad_ustr(i,j,ir,
lold)* &
3512 ad_ustr(i,j,ir,
lnew)=ad_ustr(i,j,ir,
lnew)*umask(i,j)
3518 ad_vstr(i,j,ir,
lnew)=ad_vstr(i,j,ir,
lnew)- &
3519 & ad_vstr(i,j,ir,
lold)* &
3522 ad_vstr(i,j,ir,
lnew)=ad_vstr(i,j,ir,
lnew)*vmask(i,j)
3536 ad_u(i,j,k,
lnew)=ad_u(i,j,k,
lnew)- &
3537 & ad_u(i,j,k,
lold)* &
3540 ad_u(i,j,k,
lnew)=ad_u(i,j,k,
lnew)*umask(i,j)
3546# ifdef ADJUST_BOUNDARY
3553 &
domain(ng)%Western_Edge(tile))
THEN
3557 ad_u_obc(j,k,ib,ir,
lnew)=ad_u_obc(j,k,ib,ir,
lnew)- &
3558 & ad_u_obc(j,k,ib,ir,
lold)* &
3561 ad_u_obc(j,k,ib,ir,
lnew)=ad_u_obc(j,k,ib,ir,
lnew)* &
3568 &
domain(ng)%Eastern_Edge(tile))
THEN
3572 ad_u_obc(j,k,ib,ir,
lnew)=ad_u_obc(j,k,ib,ir,
lnew)- &
3573 & ad_u_obc(j,k,ib,ir,
lold)* &
3576 ad_u_obc(j,k,ib,ir,
lnew)=ad_u_obc(j,k,ib,ir,
lnew)* &
3583 &
domain(ng)%Southern_Edge(tile))
THEN
3587 ad_u_obc(i,k,ib,ir,
lnew)=ad_u_obc(i,k,ib,ir,
lnew)- &
3588 & ad_u_obc(i,k,ib,ir,
lold)* &
3591 ad_u_obc(i,k,ib,ir,
lnew)=ad_u_obc(i,k,ib,ir,
lnew)* &
3598 &
domain(ng)%Northern_Edge(tile))
THEN
3602 ad_u_obc(i,k,ib,ir,
lnew)=ad_u_obc(i,k,ib,ir,
lnew)- &
3603 & ad_u_obc(i,k,ib,ir,
lold)* &
3606 ad_u_obc(i,k,ib,ir,
lnew)=ad_u_obc(i,k,ib,ir,
lnew)* &
3621 ad_v(i,j,k,
lnew)=ad_v(i,j,k,
lnew)- &
3622 & ad_v(i,j,k,
lold)* &
3625 ad_v(i,j,k,
lnew)=ad_v(i,j,k,
lnew)*vmask(i,j)
3631# ifdef ADJUST_BOUNDARY
3638 &
domain(ng)%Western_Edge(tile))
THEN
3642 ad_v_obc(j,k,ib,ir,
lnew)=ad_v_obc(j,k,ib,ir,
lnew)- &
3643 & ad_v_obc(j,k,ib,ir,
lold)* &
3646 ad_v_obc(j,k,ib,ir,
lnew)=ad_v_obc(j,k,ib,ir,
lnew)* &
3653 &
domain(ng)%Eastern_Edge(tile))
THEN
3657 ad_v_obc(j,k,ib,ir,
lnew)=ad_v_obc(j,k,ib,ir,
lnew)- &
3658 & ad_v_obc(j,k,ib,ir,
lold)* &
3661 ad_v_obc(j,k,ib,ir,
lnew)=ad_v_obc(j,k,ib,ir,
lnew)* &
3668 &
domain(ng)%Southern_Edge(tile))
THEN
3672 ad_v_obc(i,k,ib,ir,
lnew)=ad_v_obc(i,k,ib,ir,
lnew)- &
3673 & ad_v_obc(i,k,ib,ir,
lold)* &
3676 ad_v_obc(i,k,ib,ir,
lnew)=ad_v_obc(i,k,ib,ir,
lnew)* &
3683 &
domain(ng)%Northern_Edge(tile))
THEN
3687 ad_v_obc(i,k,ib,ir,
lnew)=ad_v_obc(i,k,ib,ir,
lnew)- &
3688 & ad_v_obc(i,k,ib,ir,
lold)* &
3691 ad_v_obc(i,k,ib,ir,
lnew)=ad_v_obc(i,k,ib,ir,
lnew)* &
3707 ad_t(i,j,k,
lnew,it)=ad_t(i,j,k,
lnew,it)- &
3708 & ad_t(i,j,k,
lold,it)* &
3711 ad_t(i,j,k,
lnew,it)=ad_t(i,j,k,
lnew,it)*rmask(i,j)
3718# ifdef ADJUST_BOUNDARY
3726 &
domain(ng)%Western_Edge(tile))
THEN
3730 ad_t_obc(j,k,ib,ir,
lnew,it)= &
3731 & ad_t_obc(j,k,ib,ir,
lnew,it)- &
3732 & ad_t_obc(j,k,ib,ir,
lold,it)* &
3735 ad_t_obc(j,k,ib,ir,
lnew,it)= &
3736 & ad_t_obc(j,k,ib,ir,
lnew,it)*rmask(istr-1,j)
3742 &
domain(ng)%Eastern_Edge(tile))
THEN
3746 ad_t_obc(j,k,ib,ir,
lnew,it)= &
3747 & ad_t_obc(j,k,ib,ir,
lnew,it)- &
3748 & ad_t_obc(j,k,ib,ir,
lold,it)* &
3751 ad_t_obc(j,k,ib,ir,
lnew,it)= &
3752 & ad_t_obc(j,k,ib,ir,
lnew,it)*rmask(iend+1,j)
3758 &
domain(ng)%Southern_Edge(tile))
THEN
3762 ad_t_obc(i,k,ib,ir,
lnew,it)= &
3763 & ad_t_obc(i,k,ib,ir,
lnew,it)- &
3764 & ad_t_obc(i,k,ib,ir,
lold,it)* &
3767 ad_t_obc(i,k,ib,ir,
lnew,it)= &
3768 & ad_t_obc(i,k,ib,ir,
lnew,it)*rmask(i,jstr-1)
3774 &
domain(ng)%Northern_Edge(tile))
THEN
3778 ad_t_obc(i,k,ib,ir,
lnew,it)= &
3779 & ad_t_obc(i,k,ib,ir,
lnew,it)- &
3780 & ad_t_obc(i,k,ib,ir,
lold,it)* &
3783 ad_t_obc(i,k,ib,ir,
lnew,it)= &
3784 & ad_t_obc(i,k,ib,ir,
lnew,it)*rmask(i,jend+1)
3794# ifdef ADJUST_STFLUX
3803 ad_tflux(i,j,ir,
lnew,it)=ad_tflux(i,j,ir,
lnew,it)- &
3804 & ad_tflux(i,j,ir,
lold,it)* &
3807 ad_tflux(i,j,ir,
lnew,it)=ad_tflux(i,j,ir,
lnew,it)* &
3826 WRITE (ncname,10) trim(
adm(ng)%base), outloop
3827 10
FORMAT (a,
'_',i3.3,
'.nc')
3836 & lbi, ubi, lbj, ubj, lbij, ubij, &
3839# if defined PIO_LIB && defined DISTRIBUTE
3840 &
adm(ng)%pioFile, &
3844 & rmask, umask, vmask, &
3846# ifdef ADJUST_BOUNDARY
3848 & tl_t_obc, tl_u_obc, tl_v_obc, &
3850 & tl_ubar_obc, tl_vbar_obc, &
3853# ifdef ADJUST_WSTRESS
3854 & tl_ustr, tl_vstr, &
3857# ifdef ADJUST_STFLUX
3860 & tl_t, tl_u, tl_v, &
3862 & tl_ubar, tl_vbar, &
3871 & lbi, ubi, lbj, ubj, lbij, ubij, &
3874 & rmask, umask, vmask, &
3876# ifdef ADJUST_BOUNDARY
3878 & ad_t_obc(:,:,:,:,
lnew,:), &
3879 & tl_t_obc(:,:,:,:,lwrk,:), &
3880 & ad_u_obc(:,:,:,:,
lnew), &
3881 & tl_u_obc(:,:,:,:,lwrk), &
3882 & ad_v_obc(:,:,:,:,
lnew), &
3883 & tl_v_obc(:,:,:,:,lwrk), &
3885 & ad_ubar_obc(:,:,:,
lnew), &
3886 & tl_ubar_obc(:,:,:,lwrk), &
3887 & ad_vbar_obc(:,:,:,
lnew), &
3888 & tl_vbar_obc(:,:,:,lwrk), &
3889 & ad_zeta_obc(:,:,:,
lnew), &
3890 & tl_zeta_obc(:,:,:,lwrk), &
3892# ifdef ADJUST_WSTRESS
3893 & ad_ustr(:,:,:,
lnew), tl_ustr(:,:,:,lwrk), &
3894 & ad_vstr(:,:,:,
lnew), tl_vstr(:,:,:,lwrk), &
3897# ifdef ADJUST_STFLUX
3898 & ad_tflux(:,:,:,
lnew,:), &
3899 & tl_tflux(:,:,:,lwrk,:), &
3901 & ad_t(:,:,:,
lnew,:), tl_t(:,:,:,lwrk,:), &
3902 & ad_u(:,:,:,
lnew), tl_u(:,:,:,lwrk), &
3903 & ad_v(:,:,:,
lnew), tl_v(:,:,:,lwrk), &
3905 & ad_ubar(:,:,
lnew), tl_ubar(:,:,lwrk), &
3906 & ad_vbar(:,:,
lnew), tl_vbar(:,:,lwrk), &
3908 & ad_zeta(:,:,
lnew), tl_zeta(:,:,lwrk))
3917 & LBi, UBi, LBj, UBj, LBij, UBij, &
3918 & IminS, ImaxS, JminS, JmaxS, &
3919 & Lold, Lnew, Lwrk, &
3920 & innLoop, outLoop, &
3922 & rmask, umask, vmask, &
3924# ifdef ADJUST_BOUNDARY
3926 & tl_t_obc, tl_u_obc, tl_v_obc, &
3928 & tl_ubar_obc, tl_vbar_obc, &
3931# ifdef ADJUST_WSTRESS
3932 & tl_ustr, tl_vstr, &
3935# ifdef ADJUST_STFLUX
3938 & tl_t, tl_u, tl_v, &
3940 & tl_ubar, tl_vbar, &
3943# ifdef ADJUST_BOUNDARY
3945 & ad_t_obc, ad_u_obc, ad_v_obc, &
3947 & ad_ubar_obc, ad_vbar_obc, &
3950# ifdef ADJUST_WSTRESS
3951 & ad_ustr, ad_vstr, &
3954# ifdef ADJUST_STFLUX
3957 & ad_t, ad_u, ad_v, &
3959 & ad_ubar, ad_vbar, &
3966 integer,
intent(in) :: ng, tile, model
3967 integer,
intent(in) :: lbi, ubi, lbj, ubj, lbij, ubij
3968 integer,
intent(in) :: imins, imaxs, jmins, jmaxs
3969 integer,
intent(in) ::
lold,
lnew, lwrk
3970 integer,
intent(in) :: innloop, outloop
3972# ifdef ASSUMED_SHAPE
3974 real(r8),
intent(in) :: rmask(lbi:,lbj:)
3975 real(r8),
intent(in) :: umask(lbi:,lbj:)
3976 real(r8),
intent(in) :: vmask(lbi:,lbj:)
3978# ifdef ADJUST_BOUNDARY
3980 real(r8),
intent(inout) :: ad_t_obc(lbij:,:,:,:,:,:)
3981 real(r8),
intent(inout) :: ad_u_obc(lbij:,:,:,:,:)
3982 real(r8),
intent(inout) :: ad_v_obc(lbij:,:,:,:,:)
3984 real(r8),
intent(inout) :: ad_ubar_obc(lbij:,:,:,:)
3985 real(r8),
intent(inout) :: ad_vbar_obc(lbij:,:,:,:)
3986 real(r8),
intent(inout) :: ad_zeta_obc(lbij:,:,:,:)
3988# ifdef ADJUST_WSTRESS
3989 real(r8),
intent(inout) :: ad_ustr(lbi:,lbj:,:,:)
3990 real(r8),
intent(inout) :: ad_vstr(lbi:,lbj:,:,:)
3993# ifdef ADJUST_STFLUX
3994 real(r8),
intent(inout) :: ad_tflux(lbi:,lbj:,:,:,:)
3996 real(r8),
intent(inout) :: ad_t(lbi:,lbj:,:,:,:)
3997 real(r8),
intent(inout) :: ad_u(lbi:,lbj:,:,:)
3998 real(r8),
intent(inout) :: ad_v(lbi:,lbj:,:,:)
4000 real(r8),
intent(inout) :: ad_ubar(lbi:,lbj:,:)
4001 real(r8),
intent(inout) :: ad_vbar(lbi:,lbj:,:)
4003 real(r8),
intent(inout) :: ad_zeta(lbi:,lbj:,:)
4004# ifdef ADJUST_BOUNDARY
4006 real(r8),
intent(inout) :: tl_t_obc(lbij:,:,:,:,:,:)
4007 real(r8),
intent(inout) :: tl_u_obc(lbij:,:,:,:,:)
4008 real(r8),
intent(inout) :: tl_v_obc(lbij:,:,:,:,:)
4010 real(r8),
intent(inout) :: tl_ubar_obc(lbij:,:,:,:)
4011 real(r8),
intent(inout) :: tl_vbar_obc(lbij:,:,:,:)
4012 real(r8),
intent(inout) :: tl_zeta_obc(lbij:,:,:,:)
4014# ifdef ADJUST_WSTRESS
4015 real(r8),
intent(inout) :: tl_ustr(lbi:,lbj:,:,:)
4016 real(r8),
intent(inout) :: tl_vstr(lbi:,lbj:,:,:)
4019# ifdef ADJUST_STFLUX
4020 real(r8),
intent(inout) :: tl_tflux(lbi:,lbj:,:,:,:)
4022 real(r8),
intent(inout) :: tl_t(lbi:,lbj:,:,:,:)
4023 real(r8),
intent(inout) :: tl_u(lbi:,lbj:,:,:)
4024 real(r8),
intent(inout) :: tl_v(lbi:,lbj:,:,:)
4026 real(r8),
intent(inout) :: tl_ubar(lbi:,lbj:,:)
4027 real(r8),
intent(inout) :: tl_vbar(lbi:,lbj:,:)
4029 real(r8),
intent(inout) :: tl_zeta(lbi:,lbj:,:)
4034 real(r8),
intent(in) :: rmask(lbi:ubi,lbj:ubj)
4035 real(r8),
intent(in) :: umask(lbi:ubi,lbj:ubj)
4036 real(r8),
intent(in) :: vmask(lbi:ubi,lbj:ubj)
4038# ifdef ADJUST_BOUNDARY
4040 real(r8),
intent(inout) :: ad_t_obc(lbij:ubij,
n(ng),4, &
4041 & Nbrec(ng),2,NT(ng))
4042 real(r8),
intent(inout) :: ad_u_obc(lbij:ubij,
n(ng),4,
nbrec(ng),2)
4043 real(r8),
intent(inout) :: ad_v_obc(lbij:ubij,
n(ng),4,
nbrec(ng),2)
4045 real(r8),
intent(inout) :: ad_ubar_obc(lbij:ubij,4,
nbrec(ng),2)
4046 real(r8),
intent(inout) :: ad_vbar_obc(lbij:ubij,4,
nbrec(ng),2)
4047 real(r8),
intent(inout) :: ad_zeta_obc(lbij:ubij,4,
nbrec(ng),2)
4049# ifdef ADJUST_WSTRESS
4050 real(r8),
intent(inout) :: ad_ustr(lbi:ubi,lbj:ubj,
nfrec(ng),2)
4051 real(r8),
intent(inout) :: ad_vstr(lbi:ubi,lbj:ubj,
nfrec(ng),2)
4054# ifdef ADJUST_STFLUX
4055 real(r8),
intent(inout) :: ad_tflux(lbi:ubi,lbj:ubj, &
4056 & Nfrec(ng),2,NT(ng))
4058 real(r8),
intent(inout) :: ad_t(lbi:ubi,lbj:ubj,
n(ng),3,
nt(ng))
4059 real(r8),
intent(inout) :: ad_u(lbi:ubi,lbj:ubj,
n(ng),2)
4060 real(r8),
intent(inout) :: ad_v(lbi:ubi,lbj:ubj,
n(ng),2)
4062 real(r8),
intent(inout) :: ad_ubar(lbi:ubi,lbj:ubj,:)
4063 real(r8),
intent(inout) :: ad_vbar(lbi:ubi,lbj:ubj,:)
4065 real(r8),
intent(inout) :: ad_zeta(lbi:ubi,lbj:ubj,:)
4066# ifdef ADJUST_BOUNDARY
4068 real(r8),
intent(inout) :: tl_t_obc(lbij:ubij,
n(ng),4, &
4069 & Nbrec(ng),2,NT(ng))
4070 real(r8),
intent(inout) :: tl_u_obc(lbij:ubij,
n(ng),4,
nbrec(ng),2)
4071 real(r8),
intent(inout) :: tl_v_obc(lbij:ubij,
n(ng),4,
nbrec(ng),2)
4073 real(r8),
intent(inout) :: tl_ubar_obc(lbij:ubij,4,
nbrec(ng),2)
4074 real(r8),
intent(inout) :: tl_vbar_obc(lbij:ubij,4,
nbrec(ng),2)
4075 real(r8),
intent(inout) :: tl_zeta_obc(lbij:ubij,4,
nbrec(ng),2)
4077# ifdef ADJUST_WSTRESS
4078 real(r8),
intent(inout) :: tl_ustr(lbi:ubi,lbj:ubj,
nfrec(ng),2)
4079 real(r8),
intent(inout) :: tl_vstr(lbi:ubi,lbj:ubj,
nfrec(ng),2)
4082# ifdef ADJUST_STFLUX
4083 real(r8),
intent(inout) :: tl_tflux(lbi:ubi,lbj:ubj, &
4084 & Nfrec(ng),2,NT(ng))
4086 real(r8),
intent(inout) :: tl_t(lbi:ubi,lbj:ubj,
n(ng),3,
nt(ng))
4087 real(r8),
intent(inout) :: tl_u(lbi:ubi,lbj:ubj,
n(ng),2)
4088 real(r8),
intent(inout) :: tl_v(lbi:ubi,lbj:ubj,
n(ng),2)
4090 real(r8),
intent(inout) :: tl_ubar(lbi:ubi,lbj:ubj,:)
4091 real(r8),
intent(inout) :: tl_vbar(lbi:ubi,lbj:ubj,:)
4093 real(r8),
intent(inout) :: tl_zeta(lbi:ubi,lbj:ubj,:)
4098 integer :: i, j, rec
4100 real(r8) :: fac, fac1, fac2
4102 real(r8),
dimension(0:NstateVar(ng)) :: dot
4103 real(r8),
dimension(0:Ninner) :: dotprod, dot_new, dot_old
4105 character (len=256) :: ncname
4107 character (len=*),
parameter :: myfile = &
4108 & __FILE__//
", lanczos"
4110# include "set_bounds.h"
4128 IF (innloop.gt.0)
THEN
4138 & lbi, ubi, lbj, ubj, lbij, ubij, &
4141 & rmask, umask, vmask, &
4143# ifdef ADJUST_BOUNDARY
4145 & ad_t_obc, tl_t_obc, &
4146 & ad_u_obc, tl_u_obc, &
4147 & ad_v_obc, tl_v_obc, &
4149 & ad_ubar_obc, tl_ubar_obc, &
4150 & ad_vbar_obc, tl_vbar_obc, &
4151 & ad_zeta_obc, tl_zeta_obc, &
4153# ifdef ADJUST_WSTRESS
4154 & ad_ustr, tl_ustr, &
4155 & ad_vstr, tl_vstr, &
4158# ifdef ADJUST_STFLUX
4159 & ad_tflux, tl_tflux, &
4165 & ad_ubar, tl_ubar, &
4166 & ad_vbar, tl_vbar, &
4173 IF (innloop.gt.1)
THEN
4178 WRITE (ncname,10) trim(
adm(ng)%base), outloop
4179 10
FORMAT (a,
'_',i3.3,
'.nc')
4187 & lbi, ubi, lbj, ubj, lbij, ubij, &
4188 & lwrk, innloop-1, &
4190# if defined PIO_LIB && defined DISTRIBUTE
4191 &
adm(ng)%pioFile, &
4195 & rmask, umask, vmask, &
4197# ifdef ADJUST_BOUNDARY
4199 & tl_t_obc, tl_u_obc, tl_v_obc, &
4201 & tl_ubar_obc, tl_vbar_obc, &
4204# ifdef ADJUST_WSTRESS
4205 & tl_ustr, tl_vstr, &
4208# ifdef ADJUST_STFLUX
4211 & tl_t, tl_u, tl_v, &
4213 & tl_ubar, tl_vbar, &
4223 fac2=-
cg_beta(innloop,outloop)
4226 & lbi, ubi, lbj, ubj, lbij, ubij, &
4229 & rmask, umask, vmask, &
4231# ifdef ADJUST_BOUNDARY
4233 & ad_t_obc, tl_t_obc, &
4234 & ad_u_obc, tl_u_obc, &
4235 & ad_v_obc, tl_v_obc, &
4237 & ad_ubar_obc, tl_ubar_obc, &
4238 & ad_vbar_obc, tl_vbar_obc, &
4239 & ad_zeta_obc, tl_zeta_obc, &
4241# ifdef ADJUST_WSTRESS
4242 & ad_ustr, tl_ustr, &
4243 & ad_vstr, tl_vstr, &
4246# ifdef ADJUST_STFLUX
4247 & ad_tflux, tl_tflux, &
4253 & ad_ubar, tl_ubar, &
4254 & ad_vbar, tl_vbar, &
4270 WRITE (ncname,10) trim(
adm(ng)%base), outloop
4282 & lbi, ubi, lbj, ubj, lbij, ubij, &
4285# if defined PIO_LIB && defined DISTRIBUTE
4286 &
adm(ng)%pioFile, &
4290 & rmask, umask, vmask, &
4292# ifdef ADJUST_BOUNDARY
4294 & tl_t_obc, tl_u_obc, tl_v_obc, &
4296 & tl_ubar_obc, tl_vbar_obc, &
4299# ifdef ADJUST_WSTRESS
4300 & tl_ustr, tl_vstr, &
4303# ifdef ADJUST_STFLUX
4306 & tl_t, tl_u, tl_v, &
4308 & tl_ubar, tl_vbar, &
4316 & lbi, ubi, lbj, ubj, lbij, ubij, &
4319 & rmask, umask, vmask, &
4321# ifdef ADJUST_BOUNDARY
4323 & ad_t_obc(:,:,:,:,
lnew,:), &
4324 & tl_t_obc(:,:,:,:,lwrk,:), &
4325 & ad_u_obc(:,:,:,:,
lnew), &
4326 & tl_u_obc(:,:,:,:,lwrk), &
4327 & ad_v_obc(:,:,:,:,
lnew), &
4328 & tl_v_obc(:,:,:,:,lwrk), &
4330 & ad_ubar_obc(:,:,:,
lnew), &
4331 & tl_ubar_obc(:,:,:,lwrk), &
4332 & ad_vbar_obc(:,:,:,
lnew), &
4333 & tl_vbar_obc(:,:,:,lwrk), &
4334 & ad_zeta_obc(:,:,:,
lnew), &
4335 & tl_zeta_obc(:,:,:,lwrk), &
4337# ifdef ADJUST_WSTRESS
4338 & ad_ustr(:,:,:,
lnew), tl_ustr(:,:,:,lwrk), &
4339 & ad_vstr(:,:,:,
lnew), tl_vstr(:,:,:,lwrk), &
4342# ifdef ADJUST_STFLUX
4343 & ad_tflux(:,:,:,
lnew,:), &
4344 & tl_tflux(:,:,:,lwrk,:), &
4346 & ad_t(:,:,:,
lnew,:), tl_t(:,:,:,lwrk,:), &
4347 & ad_u(:,:,:,
lnew), tl_u(:,:,:,lwrk), &
4348 & ad_v(:,:,:,
lnew), tl_v(:,:,:,lwrk), &
4350 & ad_ubar(:,:,
lnew), tl_ubar(:,:,lwrk), &
4351 & ad_vbar(:,:,
lnew), tl_vbar(:,:,lwrk), &
4353 & ad_zeta(:,:,
lnew), tl_zeta(:,:,lwrk))
4367 & lbi, ubi, lbj, ubj, lbij, ubij, &
4370 & rmask, umask, vmask, &
4372# ifdef ADJUST_BOUNDARY
4374 & ad_t_obc, tl_t_obc, &
4375 & ad_u_obc, tl_u_obc, &
4376 & ad_v_obc, tl_v_obc, &
4378 & ad_ubar_obc, tl_ubar_obc, &
4379 & ad_vbar_obc, tl_vbar_obc, &
4380 & ad_zeta_obc, tl_zeta_obc, &
4382# ifdef ADJUST_WSTRESS
4383 & ad_ustr, tl_ustr, &
4384 & ad_vstr, tl_vstr, &
4387# ifdef ADJUST_STFLUX
4388 & ad_tflux, tl_tflux, &
4394 & ad_ubar, tl_ubar, &
4395 & ad_vbar, tl_vbar, &
4405 & lbi, ubi, lbj, ubj, lbij, ubij, &
4408 & rmask, umask, vmask, &
4410# ifdef ADJUST_BOUNDARY
4412 & ad_t_obc(:,:,:,:,
lnew,:), &
4413 & ad_t_obc(:,:,:,:,
lnew,:), &
4414 & ad_u_obc(:,:,:,:,
lnew), &
4415 & ad_u_obc(:,:,:,:,
lnew), &
4416 & ad_v_obc(:,:,:,:,
lnew), &
4417 & ad_v_obc(:,:,:,:,
lnew), &
4419 & ad_ubar_obc(:,:,:,
lnew), &
4420 & ad_ubar_obc(:,:,:,
lnew), &
4421 & ad_vbar_obc(:,:,:,
lnew), &
4422 & ad_vbar_obc(:,:,:,
lnew), &
4423 & ad_zeta_obc(:,:,:,
lnew), &
4424 & ad_zeta_obc(:,:,:,
lnew), &
4426# ifdef ADJUST_WSTRESS
4427 & ad_ustr(:,:,:,
lnew), ad_ustr(:,:,:,
lnew), &
4428 & ad_vstr(:,:,:,
lnew), ad_vstr(:,:,:,
lnew), &
4431# ifdef ADJUST_STFLUX
4432 & ad_tflux(:,:,:,
lnew,:), &
4433 & ad_tflux(:,:,:,
lnew,:), &
4435 & ad_t(:,:,:,
lnew,:), ad_t(:,:,:,
lnew,:), &
4436 & ad_u(:,:,:,
lnew), ad_u(:,:,:,
lnew), &
4437 & ad_v(:,:,:,
lnew), ad_v(:,:,:,
lnew), &
4439 & ad_ubar(:,:,
lnew), ad_ubar(:,:,
lnew), &
4440 & ad_vbar(:,:,
lnew), ad_vbar(:,:,
lnew), &
4442 & ad_zeta(:,:,
lnew), ad_zeta(:,:,
lnew))
4446 IF (innloop.eq.0)
THEN
4449 cg_beta(innloop+1,outloop)=sqrt(dot(0))
4454 fac=1.0_r8/sqrt(dot(0))
4457 & lbi, ubi, lbj, ubj, lbij, ubij, &
4460 & rmask, umask, vmask, &
4462# ifdef ADJUST_BOUNDARY
4464 & ad_t_obc, ad_u_obc, ad_v_obc, &
4466 & ad_ubar_obc, ad_vbar_obc, &
4469# ifdef ADJUST_WSTRESS
4470 & ad_ustr, ad_vstr, &
4473# ifdef ADJUST_STFLUX
4476 & ad_t, ad_u, ad_v, &
4478 & ad_ubar, ad_vbar, &
4486 IF (innloop.eq.0)
THEN
4488 & lbi, ubi, lbj, ubj, lbij, ubij, &
4491 & rmask, umask, vmask, &
4493# ifdef ADJUST_BOUNDARY
4495 & ad_t_obc(:,:,:,:,
lnew,:), &
4496 & ad_t_obc(:,:,:,:,
lnew,:), &
4497 & ad_u_obc(:,:,:,:,
lnew), &
4498 & ad_u_obc(:,:,:,:,
lnew), &
4499 & ad_v_obc(:,:,:,:,
lnew), &
4500 & ad_v_obc(:,:,:,:,
lnew), &
4502 & ad_ubar_obc(:,:,:,
lnew), &
4503 & ad_ubar_obc(:,:,:,
lnew), &
4504 & ad_vbar_obc(:,:,:,
lnew), &
4505 & ad_vbar_obc(:,:,:,
lnew), &
4506 & ad_zeta_obc(:,:,:,
lnew), &
4507 & ad_zeta_obc(:,:,:,
lnew), &
4509# ifdef ADJUST_WSTRESS
4510 & ad_ustr(:,:,:,
lnew), ad_ustr(:,:,:,
lnew), &
4511 & ad_vstr(:,:,:,
lnew), ad_vstr(:,:,:,
lnew), &
4514# ifdef ADJUST_STFLUX
4515 & ad_tflux(:,:,:,
lnew,:), &
4516 & ad_tflux(:,:,:,
lnew,:), &
4518 & ad_t(:,:,:,
lnew,:), ad_t(:,:,:,
lnew,:), &
4519 & ad_u(:,:,:,
lnew), ad_u(:,:,:,
lnew), &
4520 & ad_v(:,:,:,
lnew), ad_v(:,:,:,
lnew), &
4522 & ad_ubar(:,:,
lnew), ad_ubar(:,:,
lnew), &
4523 & ad_vbar(:,:,
lnew), ad_vbar(:,:,
lnew), &
4525 & ad_zeta(:,:,
lnew), ad_zeta(:,:,
lnew))
4528 & lbi, ubi, lbj, ubj, lbij, ubij, &
4531 & rmask, umask, vmask, &
4533# ifdef ADJUST_BOUNDARY
4535 & ad_t_obc(:,:,:,:,
lold,:), &
4536 & ad_t_obc(:,:,:,:,
lnew,:), &
4537 & ad_u_obc(:,:,:,:,
lold), &
4538 & ad_u_obc(:,:,:,:,
lnew), &
4539 & ad_v_obc(:,:,:,:,
lold), &
4540 & ad_v_obc(:,:,:,:,
lnew), &
4542 & ad_ubar_obc(:,:,:,
lold), &
4543 & ad_ubar_obc(:,:,:,
lnew), &
4544 & ad_vbar_obc(:,:,:,
lold), &
4545 & ad_vbar_obc(:,:,:,
lnew), &
4546 & ad_zeta_obc(:,:,:,
lold), &
4547 & ad_zeta_obc(:,:,:,
lnew), &
4549# ifdef ADJUST_WSTRESS
4550 & ad_ustr(:,:,:,
lold), ad_ustr(:,:,:,
lnew), &
4551 & ad_vstr(:,:,:,
lold), ad_vstr(:,:,:,
lnew), &
4554# ifdef ADJUST_STFLUX
4555 & ad_tflux(:,:,:,
lold,:), &
4556 & ad_tflux(:,:,:,
lnew,:), &
4558 & ad_t(:,:,:,
lold,:), ad_t(:,:,:,
lnew,:), &
4559 & ad_u(:,:,:,
lold), ad_u(:,:,:,
lnew), &
4560 & ad_v(:,:,:,
lold), ad_v(:,:,:,
lnew), &
4562 & ad_ubar(:,:,
lold), ad_ubar(:,:,
lnew), &
4563 & ad_vbar(:,:,
lold), ad_vbar(:,:,
lnew), &
4565 & ad_zeta(:,:,
lold), ad_zeta(:,:,
lnew))
4573# ifdef TEST_ORTHOGONALIZATION
4582 WRITE (ncname,10) trim(
adm(ng)%base), outloop
4595 & lbi, ubi, lbj, ubj, lbij, ubij, &
4598# if defined PIO_LIB && defined DISTRIBUTE
4599 &
adm(ng)%pioFile, &
4603 & rmask, umask, vmask, &
4605# ifdef ADJUST_BOUNDARY
4607 & tl_t_obc, tl_u_obc, tl_v_obc, &
4609 & tl_ubar_obc, tl_vbar_obc, &
4612# ifdef ADJUST_WSTRESS
4613 & tl_ustr, tl_vstr, &
4616# ifdef ADJUST_STFLUX
4619 & tl_t, tl_u, tl_v, &
4621 & tl_ubar, tl_vbar, &
4627 & lbi, ubi, lbj, ubj, lbij, ubij, &
4630 & rmask, umask, vmask, &
4632# ifdef ADJUST_BOUNDARY
4634 & ad_t_obc(:,:,:,:,
lnew,:), &
4635 & tl_t_obc(:,:,:,:,lwrk,:), &
4636 & ad_u_obc(:,:,:,:,
lnew), &
4637 & tl_u_obc(:,:,:,:,lwrk), &
4638 & ad_v_obc(:,:,:,:,
lnew), &
4639 & tl_v_obc(:,:,:,:,lwrk), &
4641 & ad_ubar_obc(:,:,:,
lnew), &
4642 & tl_ubar_obc(:,:,:,lwrk), &
4643 & ad_vbar_obc(:,:,:,
lnew), &
4644 & tl_vbar_obc(:,:,:,lwrk), &
4645 & ad_zeta_obc(:,:,:,
lnew), &
4646 & tl_zeta_obc(:,:,:,lwrk), &
4648# ifdef ADJUST_WSTRESS
4649 & ad_ustr(:,:,:,
lnew), tl_ustr(:,:,:,lwrk), &
4650 & ad_vstr(:,:,:,
lnew), tl_vstr(:,:,:,lwrk), &
4653# ifdef ADJUST_STFLUX
4654 & ad_tflux(:,:,:,
lnew,:), &
4655 & tl_tflux(:,:,:,lwrk,:), &
4657 & ad_t(:,:,:,
lnew,:), tl_t(:,:,:,lwrk,:), &
4658 & ad_u(:,:,:,
lnew), tl_u(:,:,:,lwrk), &
4659 & ad_v(:,:,:,
lnew), tl_v(:,:,:,lwrk), &
4661 & ad_ubar(:,:,
lnew), tl_ubar(:,:,lwrk), &
4662 & ad_vbar(:,:,
lnew), tl_vbar(:,:,lwrk), &
4664 & ad_zeta(:,:,
lnew), tl_zeta(:,:,lwrk))
4672 WRITE (
stdout,20) outloop, innloop
4674 WRITE (
stdout,30) dotprod(rec), rec-1
4678 WRITE (
stdout,40) innloop, rec-1, dot_new(rec), &
4679 & rec-1, rec-1, dot_old(rec)
4681 20
FORMAT (/,1x,
'(',i3.3,
',',i3.3,
'): ', &
4682 &
'Gramm-Schmidt Orthogonalization:',/)
4683 30
FORMAT (12x,
'Orthogonalization Factor = ',1p,e19.12,3x, &
4684 &
'(Iter=',i3.3,
')')
4685 40
FORMAT (2x,
'Ortho Test: ', &
4686 &
'<G(',i3.3,
'),G(',i3.3,
')> = ',1p,e15.8,1x, &
4687 &
'<G(',i3.3,
'),G(',i3.3,
')> = ',1p,e15.8)
4696 & LBi, UBi, LBj, UBj, LBij, UBij, &
4697 & IminS, ImaxS, JminS, JmaxS, &
4698 & Lold, Lnew, Lwrk, &
4699 & innLoop, outLoop, &
4701 & rmask, umask, vmask, &
4703# ifdef ADJUST_BOUNDARY
4705 & tl_t_obc, tl_u_obc, tl_v_obc, &
4707 & tl_ubar_obc, tl_vbar_obc, &
4710# ifdef ADJUST_WSTRESS
4711 & tl_ustr, tl_vstr, &
4714# ifdef ADJUST_STFLUX
4717 & tl_t, tl_u, tl_v, &
4719 & tl_ubar, tl_vbar, &
4722# ifdef ADJUST_BOUNDARY
4724 & ad_t_obc, ad_u_obc, ad_v_obc, &
4726 & ad_ubar_obc, ad_vbar_obc, &
4729# ifdef ADJUST_WSTRESS
4730 & ad_ustr, ad_vstr, &
4733# ifdef ADJUST_STFLUX
4736 & ad_t, ad_u, ad_v, &
4738 & ad_ubar, ad_vbar, &
4746 integer,
intent(in) :: ng, tile, model
4747 integer,
intent(in) :: lbi, ubi, lbj, ubj, lbij, ubij
4748 integer,
intent(in) :: imins, imaxs, jmins, jmaxs
4749 integer,
intent(in) ::
lold,
lnew, lwrk
4750 integer,
intent(in) :: innloop, outloop
4752# ifdef ASSUMED_SHAPE
4754 real(r8),
intent(in) :: rmask(lbi:,lbj:)
4755 real(r8),
intent(in) :: umask(lbi:,lbj:)
4756 real(r8),
intent(in) :: vmask(lbi:,lbj:)
4758# ifdef ADJUST_WSTRESS
4759 real(r8),
intent(inout) :: ad_ustr(lbi:,lbj:,:,:)
4760 real(r8),
intent(inout) :: ad_vstr(lbi:,lbj:,:,:)
4763# ifdef ADJUST_BOUNDARY
4765 real(r8),
intent(inout) :: ad_t_obc(lbij:,:,:,:,:,:)
4766 real(r8),
intent(inout) :: ad_u_obc(lbij:,:,:,:,:)
4767 real(r8),
intent(inout) :: ad_v_obc(lbij:,:,:,:,:)
4769 real(r8),
intent(inout) :: ad_ubar_obc(lbij:,:,:,:)
4770 real(r8),
intent(inout) :: ad_vbar_obc(lbij:,:,:,:)
4771 real(r8),
intent(inout) :: ad_zeta_obc(lbij:,:,:,:)
4773# ifdef ADJUST_STFLUX
4774 real(r8),
intent(inout) :: ad_tflux(lbi:,lbj:,:,:,:)
4776 real(r8),
intent(inout) :: ad_t(lbi:,lbj:,:,:,:)
4777 real(r8),
intent(inout) :: ad_u(lbi:,lbj:,:,:)
4778 real(r8),
intent(inout) :: ad_v(lbi:,lbj:,:,:)
4780 real(r8),
intent(inout) :: ad_ubar(lbi:,lbj:,:)
4781 real(r8),
intent(inout) :: ad_vbar(lbi:,lbj:,:)
4783 real(r8),
intent(inout) :: ad_zeta(lbi:,lbj:,:)
4784# ifdef ADJUST_BOUNDARY
4786 real(r8),
intent(inout) :: tl_t_obc(lbij:,:,:,:,:,:)
4787 real(r8),
intent(inout) :: tl_u_obc(lbij:,:,:,:,:)
4788 real(r8),
intent(inout) :: tl_v_obc(lbij:,:,:,:,:)
4790 real(r8),
intent(inout) :: tl_ubar_obc(lbij:,:,:,:)
4791 real(r8),
intent(inout) :: tl_vbar_obc(lbij:,:,:,:)
4792 real(r8),
intent(inout) :: tl_zeta_obc(lbij:,:,:,:)
4794# ifdef ADJUST_WSTRESS
4795 real(r8),
intent(inout) :: tl_ustr(lbi:,lbj:,:,:)
4796 real(r8),
intent(inout) :: tl_vstr(lbi:,lbj:,:,:)
4799# ifdef ADJUST_STFLUX
4800 real(r8),
intent(inout) :: tl_tflux(lbi:,lbj:,:,:,:)
4802 real(r8),
intent(inout) :: tl_t(lbi:,lbj:,:,:,:)
4803 real(r8),
intent(inout) :: tl_u(lbi:,lbj:,:,:)
4804 real(r8),
intent(inout) :: tl_v(lbi:,lbj:,:,:)
4806 real(r8),
intent(inout) :: tl_ubar(lbi:,lbj:,:)
4807 real(r8),
intent(inout) :: tl_vbar(lbi:,lbj:,:)
4809 real(r8),
intent(inout) :: tl_zeta(lbi:,lbj:,:)
4814 real(r8),
intent(in) :: rmask(lbi:ubi,lbj:ubj)
4815 real(r8),
intent(in) :: umask(lbi:ubi,lbj:ubj)
4816 real(r8),
intent(in) :: vmask(lbi:ubi,lbj:ubj)
4818# ifdef ADJUST_BOUNDARY
4820 real(r8),
intent(inout) :: ad_t_obc(lbij:ubij,
n(ng),4, &
4821 & Nbrec(ng),2,NT(ng))
4822 real(r8),
intent(inout) :: ad_u_obc(lbij:ubij,
n(ng),4,
nbrec(ng),2)
4823 real(r8),
intent(inout) :: ad_v_obc(lbij:ubij,
n(ng),4,
nbrec(ng),2)
4825 real(r8),
intent(inout) :: ad_ubar_obc(lbij:ubij,4,
nbrec(ng),2)
4826 real(r8),
intent(inout) :: ad_vbar_obc(lbij:ubij,4,
nbrec(ng),2)
4827 real(r8),
intent(inout) :: ad_zeta_obc(lbij:ubij,4,
nbrec(ng),2)
4829# ifdef ADJUST_WSTRESS
4830 real(r8),
intent(inout) :: ad_ustr(lbi:ubi,lbj:ubj,
nfrec(ng),2)
4831 real(r8),
intent(inout) :: ad_vstr(lbi:ubi,lbj:ubj,
nfrec(ng),2)
4834# ifdef ADJUST_STFLUX
4835 real(r8),
intent(inout) :: ad_tflux(lbi:ubi,lbj:ubj, &
4836 & Nfrec(ng),2,NT(ng))
4838 real(r8),
intent(inout) :: ad_t(lbi:ubi,lbj:ubj,
n(ng),3,
nt(ng))
4839 real(r8),
intent(inout) :: ad_u(lbi:ubi,lbj:ubj,
n(ng),2)
4840 real(r8),
intent(inout) :: ad_v(lbi:ubi,lbj:ubj,
n(ng),2)
4842 real(r8),
intent(inout) :: ad_ubar(lbi:ubi,lbj:ubj,:)
4843 real(r8),
intent(inout) :: ad_vbar(lbi:ubi,lbj:ubj,:)
4845 real(r8),
intent(inout) :: ad_zeta(lbi:ubi,lbj:ubj,:)
4846# ifdef ADJUST_BOUNDARY
4848 real(r8),
intent(inout) :: tl_t_obc(lbij:ubij,
n(ng),4, &
4849 & Nbrec(ng),2,NT(ng))
4850 real(r8),
intent(inout) :: tl_u_obc(lbij:ubij,
n(ng),4,
nbrec(ng),2)
4851 real(r8),
intent(inout) :: tl_v_obc(lbij:ubij,
n(ng),4,
nbrec(ng),2)
4853 real(r8),
intent(inout) :: tl_ubar_obc(lbij:ubij,4,
nbrec(ng),2)
4854 real(r8),
intent(inout) :: tl_vbar_obc(lbij:ubij,4,
nbrec(ng),2)
4855 real(r8),
intent(inout) :: tl_zeta_obc(lbij:ubij,4,
nbrec(ng),2)
4857# ifdef ADJUST_WSTRESS
4858 real(r8),
intent(inout) :: tl_ustr(lbi:ubi,lbj:ubj,
nfrec(ng),2)
4859 real(r8),
intent(inout) :: tl_vstr(lbi:ubi,lbj:ubj,
nfrec(ng),2)
4862# ifdef ADJUST_STFLUX
4863 real(r8),
intent(inout) :: tl_tflux(lbi:ubi,lbj:ubj, &
4864 & Nfrec(ng),2,NT(ng))
4866 real(r8),
intent(inout) :: tl_t(lbi:ubi,lbj:ubj,
n(ng),3,
nt(ng))
4867 real(r8),
intent(inout) :: tl_u(lbi:ubi,lbj:ubj,
n(ng),2)
4868 real(r8),
intent(inout) :: tl_v(lbi:ubi,lbj:ubj,
n(ng),2)
4870 real(r8),
intent(inout) :: tl_ubar(lbi:ubi,lbj:ubj,:)
4871 real(r8),
intent(inout) :: tl_vbar(lbi:ubi,lbj:ubj,:)
4873 real(r8),
intent(inout) :: tl_zeta(lbi:ubi,lbj:ubj,:)
4880 real(r8) :: fac1, fac2
4882 real(r8),
dimension(0:NstateVar(ng)) :: dot
4883 real(r8),
dimension(0:Ninner) :: dotprod, dot_new, dot_old
4885 character (len=256) :: ncname
4887 character (len=*),
parameter :: myfile = &
4888 & __FILE__//
", new_gradient"
4890# include "set_bounds.h"
4908 & lbi, ubi, lbj, ubj, lbij, ubij, &
4911 & rmask, umask, vmask, &
4913# ifdef ADJUST_BOUNDARY
4915 & ad_t_obc, ad_t_obc, &
4916 & ad_u_obc, ad_u_obc, &
4917 & ad_v_obc, ad_v_obc, &
4919 & ad_ubar_obc, ad_ubar_obc, &
4920 & ad_vbar_obc, ad_vbar_obc, &
4921 & ad_zeta_obc, ad_zeta_obc, &
4923# ifdef ADJUST_WSTRESS
4924 & ad_ustr, ad_ustr, &
4925 & ad_vstr, ad_vstr, &
4928# ifdef ADJUST_STFLUX
4929 & ad_tflux, ad_tflux, &
4935 & ad_ubar, ad_ubar, &
4936 & ad_vbar, ad_vbar, &
4943 WRITE (ncname,10) trim(
adm(ng)%base), outloop
4944 10
FORMAT (a,
'_',i3.3,
'.nc')
4956 & lbi, ubi, lbj, ubj, lbij, ubij, &
4959# if defined PIO_LIB && defined DISTRIBUTE
4960 &
adm(ng)%pioFile, &
4964 & rmask, umask, vmask, &
4966# ifdef ADJUST_BOUNDARY
4968 & tl_t_obc, tl_u_obc, tl_v_obc, &
4970 & tl_ubar_obc, tl_vbar_obc, &
4973# ifdef ADJUST_WSTRESS
4974 & tl_ustr, tl_vstr, &
4977# ifdef ADJUST_STFLUX
4980 & tl_t, tl_u, tl_v, &
4982 & tl_ubar, tl_vbar, &
5000 fac2=-
cg_qg(rec,outloop)
5003 & lbi, ubi, lbj, ubj, lbij, ubij, &
5006 & rmask, umask, vmask, &
5008# ifdef ADJUST_BOUNDARY
5010 & ad_t_obc, tl_t_obc, &
5011 & ad_u_obc, tl_u_obc, &
5012 & ad_v_obc, tl_v_obc, &
5014 & ad_ubar_obc, tl_ubar_obc, &
5015 & ad_vbar_obc, tl_vbar_obc, &
5016 & ad_zeta_obc, tl_zeta_obc, &
5018# ifdef ADJUST_WSTRESS
5019 & ad_ustr, tl_ustr, &
5020 & ad_vstr, tl_vstr, &
5023# ifdef ADJUST_STFLUX
5024 & ad_tflux, tl_tflux, &
5030 & ad_ubar, tl_ubar, &
5031 & ad_vbar, tl_vbar, &
5039 & lbi, ubi, lbj, ubj, lbij, ubij, &
5042 & rmask, umask, vmask, &
5044# ifdef ADJUST_BOUNDARY
5046 & ad_t_obc(:,:,:,:,
lold,:), &
5047 & ad_t_obc(:,:,:,:,
lold,:), &
5048 & ad_u_obc(:,:,:,:,
lold), &
5049 & ad_u_obc(:,:,:,:,
lold), &
5050 & ad_v_obc(:,:,:,:,
lold), &
5051 & ad_v_obc(:,:,:,:,
lold), &
5053 & ad_ubar_obc(:,:,:,
lold), &
5054 & ad_ubar_obc(:,:,:,
lold), &
5055 & ad_vbar_obc(:,:,:,
lold), &
5056 & ad_vbar_obc(:,:,:,
lold), &
5057 & ad_zeta_obc(:,:,:,
lold), &
5058 & ad_zeta_obc(:,:,:,
lold), &
5060# ifdef ADJUST_WSTRESS
5061 & ad_ustr(:,:,:,
lold), ad_ustr(:,:,:,
lold), &
5062 & ad_vstr(:,:,:,
lold), ad_vstr(:,:,:,
lold), &
5065# ifdef ADJUST_STFLUX
5066 & ad_tflux(:,:,:,
lold,:), &
5067 & ad_tflux(:,:,:,
lold,:), &
5069 & ad_t(:,:,:,
lold,:), ad_t(:,:,:,
lold,:), &
5070 & ad_u(:,:,:,
lold), ad_u(:,:,:,
lold), &
5071 & ad_v(:,:,:,
lold), ad_v(:,:,:,
lold), &
5073 & ad_ubar(:,:,
lold), ad_ubar(:,:,
lold), &
5074 & ad_vbar(:,:,
lold), ad_vbar(:,:,
lold), &
5076 & ad_zeta(:,:,
lold), ad_zeta(:,:,
lold))
5085 & LBi, UBi, LBj, UBj, LBij, UBij, &
5086 & IminS, ImaxS, JminS, JmaxS, &
5087 & Lold, Lnew, Lwrk, &
5088 & innLoop, outLoop, &
5090 & rmask, umask, vmask, &
5092# ifdef ADJUST_BOUNDARY
5094 & nl_t_obc, nl_u_obc, nl_v_obc, &
5096 & nl_ubar_obc, nl_vbar_obc, &
5099# ifdef ADJUST_WSTRESS
5100 & nl_ustr, nl_vstr, &
5103# ifdef ADJUST_STFLUX
5106 & nl_t, nl_u, nl_v, &
5108 & nl_ubar, nl_vbar, &
5111# ifdef ADJUST_BOUNDARY
5113 & tl_t_obc, tl_u_obc, tl_v_obc, &
5115 & tl_ubar_obc, tl_vbar_obc, &
5118# ifdef ADJUST_WSTRESS
5119 & tl_ustr, tl_vstr, &
5122# ifdef ADJUST_STFLUX
5125 & tl_t, tl_u, tl_v, &
5127 & tl_ubar, tl_vbar, &
5130# ifdef ADJUST_BOUNDARY
5132 & ad_t_obc, ad_u_obc, ad_v_obc, &
5134 & ad_ubar_obc, ad_vbar_obc, &
5137# ifdef ADJUST_WSTRESS
5138 & ad_ustr, ad_vstr, &
5141# ifdef ADJUST_STFLUX
5144 & ad_t, ad_u, ad_v, &
5146 & ad_ubar, ad_vbar, &
5153 integer,
intent(in) :: ng, tile, model
5154 integer,
intent(in) :: lbi, ubi, lbj, ubj, lbij, ubij
5155 integer,
intent(in) :: imins, imaxs, jmins, jmaxs
5156 integer,
intent(in) ::
lold,
lnew, lwrk
5157 integer,
intent(in) :: innloop, outloop
5159# ifdef ASSUMED_SHAPE
5161 real(r8),
intent(in) :: rmask(lbi:,lbj:)
5162 real(r8),
intent(in) :: umask(lbi:,lbj:)
5163 real(r8),
intent(in) :: vmask(lbi:,lbj:)
5165# ifdef ADJUST_BOUNDARY
5167 real(r8),
intent(inout) :: ad_t_obc(lbij:,:,:,:,:,:)
5168 real(r8),
intent(inout) :: ad_u_obc(lbij:,:,:,:,:)
5169 real(r8),
intent(inout) :: ad_v_obc(lbij:,:,:,:,:)
5171 real(r8),
intent(inout) :: ad_ubar_obc(lbij:,:,:,:)
5172 real(r8),
intent(inout) :: ad_vbar_obc(lbij:,:,:,:)
5173 real(r8),
intent(inout) :: ad_zeta_obc(lbij:,:,:,:)
5175# ifdef ADJUST_WSTRESS
5176 real(r8),
intent(inout) :: ad_ustr(lbi:,lbj:,:,:)
5177 real(r8),
intent(inout) :: ad_vstr(lbi:,lbj:,:,:)
5180# ifdef ADJUST_STFLUX
5181 real(r8),
intent(inout) :: ad_tflux(lbi:,lbj:,:,:,:)
5183 real(r8),
intent(inout) :: ad_t(lbi:,lbj:,:,:,:)
5184 real(r8),
intent(inout) :: ad_u(lbi:,lbj:,:,:)
5185 real(r8),
intent(inout) :: ad_v(lbi:,lbj:,:,:)
5187 real(r8),
intent(inout) :: ad_ubar(lbi:,lbj:,:)
5188 real(r8),
intent(inout) :: ad_vbar(lbi:,lbj:,:)
5190 real(r8),
intent(inout) :: ad_zeta(lbi:,lbj:,:)
5191# ifdef ADJUST_BOUNDARY
5193 real(r8),
intent(inout) :: tl_t_obc(lbij:,:,:,:,:,:)
5194 real(r8),
intent(inout) :: tl_u_obc(lbij:,:,:,:,:)
5195 real(r8),
intent(inout) :: tl_v_obc(lbij:,:,:,:,:)
5197 real(r8),
intent(inout) :: tl_ubar_obc(lbij:,:,:,:)
5198 real(r8),
intent(inout) :: tl_vbar_obc(lbij:,:,:,:)
5199 real(r8),
intent(inout) :: tl_zeta_obc(lbij:,:,:,:)
5201# ifdef ADJUST_WSTRESS
5202 real(r8),
intent(inout) :: tl_ustr(lbi:,lbj:,:,:)
5203 real(r8),
intent(inout) :: tl_vstr(lbi:,lbj:,:,:)
5206# ifdef ADJUST_STFLUX
5207 real(r8),
intent(inout) :: tl_tflux(lbi:,lbj:,:,:,:)
5209 real(r8),
intent(inout) :: tl_t(lbi:,lbj:,:,:,:)
5210 real(r8),
intent(inout) :: tl_u(lbi:,lbj:,:,:)
5211 real(r8),
intent(inout) :: tl_v(lbi:,lbj:,:,:)
5213 real(r8),
intent(inout) :: tl_ubar(lbi:,lbj:,:)
5214 real(r8),
intent(inout) :: tl_vbar(lbi:,lbj:,:)
5216 real(r8),
intent(inout) :: tl_zeta(lbi:,lbj:,:)
5217# ifdef ADJUST_BOUNDARY
5219 real(r8),
intent(inout) :: nl_t_obc(lbij:,:,:,:,:,:)
5220 real(r8),
intent(inout) :: nl_u_obc(lbij:,:,:,:,:)
5221 real(r8),
intent(inout) :: nl_v_obc(lbij:,:,:,:,:)
5223 real(r8),
intent(inout) :: nl_ubar_obc(lbij:,:,:,:)
5224 real(r8),
intent(inout) :: nl_vbar_obc(lbij:,:,:,:)
5225 real(r8),
intent(inout) :: nl_zeta_obc(lbij:,:,:,:)
5227# ifdef ADJUST_WSTRESS
5228 real(r8),
intent(inout) :: nl_ustr(lbi:,lbj:,:,:)
5229 real(r8),
intent(inout) :: nl_vstr(lbi:,lbj:,:,:)
5232# ifdef ADJUST_STFLUX
5233 real(r8),
intent(inout) :: nl_tflux(lbi:,lbj:,:,:,:)
5235 real(r8),
intent(inout) :: nl_t(lbi:,lbj:,:,:,:)
5236 real(r8),
intent(inout) :: nl_u(lbi:,lbj:,:,:)
5237 real(r8),
intent(inout) :: nl_v(lbi:,lbj:,:,:)
5239 real(r8),
intent(inout) :: nl_ubar(lbi:,lbj:,:)
5240 real(r8),
intent(inout) :: nl_vbar(lbi:,lbj:,:)
5242 real(r8),
intent(inout) :: nl_zeta(lbi:,lbj:,:)
5247 real(r8),
intent(in) :: rmask(lbi:ubi,lbj:ubj)
5248 real(r8),
intent(in) :: umask(lbi:ubi,lbj:ubj)
5249 real(r8),
intent(in) :: vmask(lbi:ubi,lbj:ubj)
5251# ifdef ADJUST_BOUNDARY
5253 real(r8),
intent(inout) :: ad_t_obc(lbij:ubij,
n(ng),4, &
5254 & Nbrec(ng),2,NT(ng))
5255 real(r8),
intent(inout) :: ad_u_obc(lbij:ubij,
n(ng),4,
nbrec(ng),2)
5256 real(r8),
intent(inout) :: ad_v_obc(lbij:ubij,
n(ng),4,
nbrec(ng),2)
5258 real(r8),
intent(inout) :: ad_ubar_obc(lbij:ubij,4,
nbrec(ng),2)
5259 real(r8),
intent(inout) :: ad_vbar_obc(lbij:ubij,4,
nbrec(ng),2)
5260 real(r8),
intent(inout) :: ad_zeta_obc(lbij:ubij,4,
nbrec(ng),2)
5262# ifdef ADJUST_WSTRESS
5263 real(r8),
intent(inout) :: ad_ustr(lbi:ubi,lbj:ubj,
nfrec(ng),2)
5264 real(r8),
intent(inout) :: ad_vstr(lbi:ubi,lbj:ubj,
nfrec(ng),2)
5267# ifdef ADJUST_STFLUX
5268 real(r8),
intent(inout) :: ad_tflux(lbi:ubi,lbj:ubj, &
5269 & Nfrec(ng),2,NT(ng))
5271 real(r8),
intent(inout) :: ad_t(lbi:ubi,lbj:ubj,
n(ng),3,
nt(ng))
5272 real(r8),
intent(inout) :: ad_u(lbi:ubi,lbj:ubj,
n(ng),2)
5273 real(r8),
intent(inout) :: ad_v(lbi:ubi,lbj:ubj,
n(ng),2)
5275 real(r8),
intent(inout) :: ad_ubar(lbi:ubi,lbj:ubj,:)
5276 real(r8),
intent(inout) :: ad_vbar(lbi:ubi,lbj:ubj,:)
5278 real(r8),
intent(inout) :: ad_zeta(lbi:ubi,lbj:ubj,:)
5279# ifdef ADJUST_BOUNDARY
5281 real(r8),
intent(inout) :: tl_t_obc(lbij:ubij,
n(ng),4, &
5282 & Nbrec(ng),2,NT(ng))
5283 real(r8),
intent(inout) :: tl_u_obc(lbij:ubij,
n(ng),4,
nbrec(ng),2)
5284 real(r8),
intent(inout) :: tl_v_obc(lbij:ubij,
n(ng),4,
nbrec(ng),2)
5286 real(r8),
intent(inout) :: tl_ubar_obc(lbij:ubij,4,
nbrec(ng),2)
5287 real(r8),
intent(inout) :: tl_vbar_obc(lbij:ubij,4,
nbrec(ng),2)
5288 real(r8),
intent(inout) :: tl_zeta_obc(lbij:ubij,4,
nbrec(ng),2)
5290# ifdef ADJUST_WSTRESS
5291 real(r8),
intent(inout) :: tl_ustr(lbi:ubi,lbj:ubj,
nfrec(ng),2)
5292 real(r8),
intent(inout) :: tl_vstr(lbi:ubi,lbj:ubj,
nfrec(ng),2)
5295# ifdef ADJUST_STFLUX
5296 real(r8),
intent(inout) :: tl_tflux(lbi:ubi,lbj:ubj, &
5297 & Nfrec(ng),2,NT(ng))
5299 real(r8),
intent(inout) :: tl_t(lbi:ubi,lbj:ubj,
n(ng),3,
nt(ng))
5300 real(r8),
intent(inout) :: tl_u(lbi:ubi,lbj:ubj,
n(ng),2)
5301 real(r8),
intent(inout) :: tl_v(lbi:ubi,lbj:ubj,
n(ng),2)
5303 real(r8),
intent(inout) :: tl_ubar(lbi:ubi,lbj:ubj,:)
5304 real(r8),
intent(inout) :: tl_vbar(lbi:ubi,lbj:ubj,:)
5306 real(r8),
intent(inout) :: tl_zeta(lbi:ubi,lbj:ubj,:)
5307# ifdef ADJUST_BOUNDARY
5309 real(r8),
intent(inout) :: nl_t_obc(lbij:ubij,
n(ng),4, &
5310 & Nbrec(ng),2,NT(ng))
5311 real(r8),
intent(inout) :: nl_u_obc(lbij:ubij,
n(ng),4,
nbrec(ng),2)
5312 real(r8),
intent(inout) :: nl_v_obc(lbij:ubij,
n(ng),4,
nbrec(ng),2)
5314 real(r8),
intent(inout) :: nl_ubar_obc(lbij:ubij,4,
nbrec(ng),2)
5315 real(r8),
intent(inout) :: nl_vbar_obc(lbij:ubij,4,
nbrec(ng),2)
5316 real(r8),
intent(inout) :: nl_zeta_obc(lbij:ubij,4,
nbrec(ng),2)
5318# ifdef ADJUST_WSTRESS
5319 real(r8),
intent(inout) :: nl_ustr(lbi:ubi,lbj:ubj,
nfrec(ng),2)
5320 real(r8),
intent(inout) :: nl_vstr(lbi:ubi,lbj:ubj,
nfrec(ng),2)
5323# ifdef ADJUST_STFLUX
5324 real(r8),
intent(inout) :: nl_tflux(lbi:ubi,lbj:ubj, &
5325 & Nfrec(ng),2,NT(ng))
5327 real(r8),
intent(inout) :: nl_t(lbi:ubi,lbj:ubj,
n(ng),3,
nt(ng))
5328 real(r8),
intent(inout) :: nl_u(lbi:ubi,lbj:ubj,
n(ng),2)
5329 real(r8),
intent(inout) :: nl_v(lbi:ubi,lbj:ubj,
n(ng),2)
5331 real(r8),
intent(inout) :: nl_ubar(lbi:ubi,lbj:ubj,:)
5332 real(r8),
intent(inout) :: nl_vbar(lbi:ubi,lbj:ubj,:)
5334 real(r8),
intent(inout) :: nl_zeta(lbi:ubi,lbj:ubj,:)
5339 integer :: i, ingood, nvec, rec, status, varid
5341 integer :: start(4), total(4)
5343 real(r8) :: fac, fac1, fac2
5345 real(r8),
dimension(Ninner) :: ritzerr
5347 real(r8),
dimension(0:NstateVar(ng)) :: dot
5348 real(r8),
dimension(0:Ninner) :: dotprod, dot_new, dot_old
5350 character (len=256) :: ncname
5352 character (len=*),
parameter :: myfile = &
5353 & __FILE__//
", hessian_evecs"
5355# include "set_bounds.h"
5376 SELECT CASE (
hss(ng)%IOtype)
5381 & ncid =
hss(ng)%ncid)
5383# if defined PIO_LIB && defined DISTRIBUTE
5388 & piofile =
hss(ng)%pioFile)
5402 columns :
DO nvec=innloop,1,-1
5409 & lbi, ubi, lbj, ubj, lbij, ubij, &
5412 & rmask, umask, vmask, &
5414# ifdef ADJUST_BOUNDARY
5416 & ad_t_obc, ad_u_obc, ad_v_obc, &
5418 & ad_ubar_obc, ad_vbar_obc, &
5421# ifdef ADJUST_WSTRESS
5422 & ad_ustr, ad_vstr, &
5425# ifdef ADJUST_STFLUX
5428 & ad_t, ad_u, ad_v, &
5430 & ad_ubar, ad_vbar, &
5437 WRITE (ncname,20) trim(
adm(ng)%base), outloop
5442 rows :
DO rec=1,innloop
5448 & lbi, ubi, lbj, ubj, lbij, ubij, &
5451# if defined PIO_LIB && defined DISTRIBUTE
5452 &
adm(ng)%pioFile, &
5456 & rmask, umask, vmask, &
5458# ifdef ADJUST_BOUNDARY
5460 & tl_t_obc, tl_u_obc, tl_v_obc, &
5462 & tl_ubar_obc, tl_vbar_obc, &
5465# ifdef ADJUST_WSTRESS
5466 & tl_ustr, tl_vstr, &
5469# ifdef ADJUST_STFLUX
5472 & tl_t, tl_u, tl_v, &
5474 & tl_ubar, tl_vbar, &
5484 fac2=
cg_zv(rec,nvec)
5487 & lbi, ubi, lbj, ubj, lbij, ubij, &
5490 & rmask, umask, vmask, &
5492# ifdef ADJUST_BOUNDARY
5494 & ad_t_obc, tl_t_obc, &
5495 & ad_u_obc, tl_u_obc, &
5496 & ad_v_obc, tl_v_obc, &
5498 & ad_ubar_obc, tl_ubar_obc, &
5499 & ad_vbar_obc, tl_vbar_obc, &
5500 & ad_zeta_obc, tl_zeta_obc, &
5502# ifdef ADJUST_WSTRESS
5503 & ad_ustr, tl_ustr, &
5504 & ad_vstr, tl_vstr, &
5507# ifdef ADJUST_STFLUX
5508 & ad_tflux, tl_tflux, &
5514 & ad_ubar, tl_ubar, &
5515 & ad_vbar, tl_vbar, &
5543 WRITE (ncname,20) trim(
hss(ng)%base), outloop
5555 & lbi, ubi, lbj, ubj, lbij, ubij, &
5557 & 0,
hss(ng)%ncid, &
5558# if defined PIO_LIB && defined DISTRIBUTE
5559 &
hss(ng)%pioFile, &
5563 & rmask, umask, vmask, &
5565# ifdef ADJUST_BOUNDARY
5567 & ad_t_obc, ad_u_obc, ad_v_obc, &
5569 & ad_ubar_obc, ad_vbar_obc, &
5572# ifdef ADJUST_WSTRESS
5573 & ad_ustr, ad_vstr, &
5576# ifdef ADJUST_STFLUX
5579 & ad_t, ad_u, ad_v, &
5581 & ad_ubar, ad_vbar, &
5594 & lbi, ubi, lbj, ubj, lbij, ubij, &
5596# ifdef ADJUST_BOUNDARY
5598 & nl_t_obc, ad_t_obc, &
5599 & nl_u_obc, ad_u_obc, &
5600 & nl_v_obc, ad_v_obc, &
5602 & nl_ubar_obc, ad_ubar_obc, &
5603 & nl_vbar_obc, ad_vbar_obc, &
5604 & nl_zeta_obc, ad_zeta_obc, &
5606# ifdef ADJUST_WSTRESS
5607 & nl_ustr, ad_ustr, &
5608 & nl_vstr, ad_vstr, &
5611# ifdef ADJUST_STFLUX
5612 & nl_tflux, ad_tflux, &
5618 & nl_ubar, ad_ubar, &
5619 & nl_vbar, ad_vbar, &
5631 & lbi, ubi, lbj, ubj, lbij, ubij, &
5633 & 0,
hss(ng)%ncid, &
5634# if defined PIO_LIB && defined DISTRIBUTE
5635 &
hss(ng)%pioFile, &
5639 & rmask, umask, vmask, &
5641# ifdef ADJUST_BOUNDARY
5643 & tl_t_obc, tl_u_obc, tl_v_obc, &
5645 & tl_ubar_obc, tl_vbar_obc, &
5648# ifdef ADJUST_WSTRESS
5649 & tl_ustr, tl_vstr, &
5652# ifdef ADJUST_STFLUX
5655 & tl_t, tl_u, tl_v, &
5657 & tl_ubar, tl_vbar, &
5665 & lbi, ubi, lbj, ubj, lbij, ubij, &
5668 & rmask, umask, vmask, &
5670# ifdef ADJUST_BOUNDARY
5672 & ad_t_obc(:,:,:,:,
lold,:), &
5673 & tl_t_obc(:,:,:,:,lwrk,:), &
5674 & ad_u_obc(:,:,:,:,
lold), &
5675 & tl_u_obc(:,:,:,:,lwrk), &
5676 & ad_v_obc(:,:,:,:,
lold), &
5677 & tl_v_obc(:,:,:,:,lwrk), &
5679 & ad_ubar_obc(:,:,:,
lold), &
5680 & tl_ubar_obc(:,:,:,lwrk), &
5681 & ad_vbar_obc(:,:,:,
lold), &
5682 & tl_vbar_obc(:,:,:,lwrk), &
5683 & ad_zeta_obc(:,:,:,
lold), &
5684 & tl_zeta_obc(:,:,:,lwrk), &
5686# ifdef ADJUST_WSTRESS
5687 & ad_ustr(:,:,:,
lold), tl_ustr(:,:,:,lwrk), &
5688 & ad_vstr(:,:,:,
lold), tl_vstr(:,:,:,lwrk), &
5691# ifdef ADJUST_STFLUX
5692 & ad_tflux(:,:,:,
lold,:), &
5693 & tl_tflux(:,:,:,lwrk,:), &
5695 & ad_t(:,:,:,
lold,:), tl_t(:,:,:,lwrk,:), &
5696 & ad_u(:,:,:,
lold), tl_u(:,:,:,lwrk), &
5697 & ad_v(:,:,:,
lold), tl_v(:,:,:,lwrk), &
5699 & ad_ubar(:,:,
lold), tl_ubar(:,:,lwrk), &
5700 & ad_vbar(:,:,
lold), tl_vbar(:,:,lwrk), &
5702 & ad_zeta(:,:,
lold), tl_zeta(:,:,lwrk))
5712 & lbi, ubi, lbj, ubj, lbij, ubij, &
5713 & l1, lwrk, l1, fac1, fac2, &
5715 & rmask, umask, vmask, &
5717# ifdef ADJUST_BOUNDARY
5719 & nl_t_obc, tl_t_obc, &
5720 & nl_u_obc, tl_u_obc, &
5721 & nl_v_obc, tl_v_obc, &
5723 & nl_ubar_obc, tl_ubar_obc, &
5724 & nl_vbar_obc, tl_vbar_obc, &
5725 & nl_zeta_obc, tl_zeta_obc, &
5727# ifdef ADJUST_WSTRESS
5728 & nl_ustr, tl_ustr, &
5729 & nl_vstr, tl_vstr, &
5732# ifdef ADJUST_STFLUX
5733 & nl_tflux, tl_tflux, &
5739 & nl_ubar, tl_ubar, &
5740 & nl_vbar, tl_vbar, &
5748 & lbi, ubi, lbj, ubj, lbij, ubij, &
5751 & rmask, umask, vmask, &
5753# ifdef ADJUST_BOUNDARY
5755 & nl_t_obc(:,:,:,:,l1,:), &
5756 & nl_t_obc(:,:,:,:,l1,:), &
5757 & nl_u_obc(:,:,:,:,l1), &
5758 & nl_u_obc(:,:,:,:,l1), &
5759 & nl_v_obc(:,:,:,:,l1), &
5760 & nl_v_obc(:,:,:,:,l1), &
5762 & nl_ubar_obc(:,:,:,l1), &
5763 & nl_ubar_obc(:,:,:,l1), &
5764 & nl_vbar_obc(:,:,:,l1), &
5765 & nl_vbar_obc(:,:,:,l1), &
5766 & nl_zeta_obc(:,:,:,l1), &
5767 & nl_zeta_obc(:,:,:,l1), &
5769# ifdef ADJUST_WSTRESS
5770 & nl_ustr(:,:,:,l1), nl_ustr(:,:,:,l1), &
5771 & nl_vstr(:,:,:,l1), nl_vstr(:,:,:,l1), &
5774# ifdef ADJUST_STFLUX
5775 & nl_tflux(:,:,:,l1,:), &
5776 & nl_tflux(:,:,:,l1,:), &
5778 & nl_t(:,:,:,l1,:), nl_t(:,:,:,l1,:), &
5779 & nl_u(:,:,:,l1), nl_u(:,:,:,l1), &
5780 & nl_v(:,:,:,l1), nl_v(:,:,:,l1), &
5782 & nl_ubar(:,:,l1), nl_ubar(:,:,l1), &
5783 & nl_vbar(:,:,l1), nl_vbar(:,:,l1), &
5785 & nl_zeta(:,:,l1), nl_zeta(:,:,l1))
5791 fac=1.0_r8/sqrt(dot(0))
5794 & lbi, ubi, lbj, ubj, lbij, ubij, &
5797 & rmask, umask, vmask, &
5799# ifdef ADJUST_BOUNDARY
5801 & nl_t_obc, nl_u_obc, nl_v_obc, &
5803 & nl_ubar_obc, nl_vbar_obc, &
5806# ifdef ADJUST_WSTRESS
5807 & nl_ustr, nl_vstr, &
5810# ifdef ADJUST_STFLUX
5813 & nl_t, nl_u, nl_v, &
5815 & nl_ubar, nl_vbar, &
5822 & lbi, ubi, lbj, ubj, lbij, ubij, &
5824# ifdef ADJUST_BOUNDARY
5826 & ad_t_obc, nl_t_obc, &
5827 & ad_u_obc, nl_u_obc, &
5828 & ad_v_obc, nl_v_obc, &
5830 & ad_ubar_obc, nl_ubar_obc, &
5831 & ad_vbar_obc, nl_vbar_obc, &
5832 & ad_zeta_obc, nl_zeta_obc, &
5834# ifdef ADJUST_WSTRESS
5835 & ad_ustr, nl_ustr, &
5836 & ad_vstr, nl_vstr, &
5839# ifdef ADJUST_STFLUX
5840 & ad_tflux, nl_tflux, &
5846 & ad_ubar, nl_ubar, &
5847 & ad_vbar, nl_vbar, &
5853 SELECT CASE (
hss(ng)%IOtype)
5856 &
'Ritz',
ritz(nvec:), &
5857 & (/nvec/), (/1/), &
5858 & ncid =
hss(ng)%ncid)
5862 &
'Ritz_error', ritzerr(nvec:), &
5863 & (/nvec/), (/1/), &
5864 & ncid =
hss(ng)%ncid)
5867# if defined PIO_LIB && defined DISTRIBUTE
5870 &
'Ritz',
ritz(nvec:), &
5871 & (/nvec/), (/1/), &
5872 & piofile =
hss(ng)%pioFile)
5876 &
'Ritz_error', ritzerr(nvec:), &
5877 & (/nvec/), (/1/), &
5878 & piofile =
hss(ng)%pioFile)
5886 hss(ng)%Rindex=nvec-1
5899 10
FORMAT (/,
' Computing converged Hessian eigenvectors...',/)
5900 20
FORMAT (a,
'_',i3.3,
'.nc')
5901 30
FORMAT (/,
' Orthonormalizing converged Hessian eigenvectors...',/)
5908 & LBi, UBi, LBj, UBj, LBij, UBij, &
5909 & IminS, ImaxS, JminS, JmaxS, &
5910 & innLoop, outLoop, &
5912 & rmask, umask, vmask, &
5914# ifdef ADJUST_BOUNDARY
5916 & nl_t_obc, nl_u_obc, nl_v_obc, &
5918 & nl_ubar_obc, nl_vbar_obc, &
5921# ifdef ADJUST_WSTRESS
5922 & nl_ustr, nl_vstr, &
5925# ifdef ADJUST_STFLUX
5928 & nl_t, nl_u, nl_v, &
5930 & nl_ubar, nl_vbar, &
5937 integer,
intent(in) :: ng, tile, model
5938 integer,
intent(in) :: lbi, ubi, lbj, ubj, lbij, ubij
5939 integer,
intent(in) :: imins, imaxs, jmins, jmaxs
5940 integer,
intent(in) :: innloop, outloop
5942# ifdef ASSUMED_SHAPE
5944 real(r8),
intent(in) :: rmask(lbi:,lbj:)
5945 real(r8),
intent(in) :: umask(lbi:,lbj:)
5946 real(r8),
intent(in) :: vmask(lbi:,lbj:)
5948# ifdef ADJUST_BOUNDARY
5950 real(r8),
intent(inout) :: nl_t_obc(lbij:,:,:,:,:,:)
5951 real(r8),
intent(inout) :: nl_u_obc(lbij:,:,:,:,:)
5952 real(r8),
intent(inout) :: nl_v_obc(lbij:,:,:,:,:)
5954 real(r8),
intent(inout) :: nl_ubar_obc(lbij:,:,:,:)
5955 real(r8),
intent(inout) :: nl_vbar_obc(lbij:,:,:,:)
5956 real(r8),
intent(inout) :: nl_zeta_obc(lbij:,:,:,:)
5958# ifdef ADJUST_WSTRESS
5959 real(r8),
intent(inout) :: nl_ustr(lbi:,lbj:,:,:)
5960 real(r8),
intent(inout) :: nl_vstr(lbi:,lbj:,:,:)
5963# ifdef ADJUST_STFLUX
5964 real(r8),
intent(inout) :: nl_tflux(lbi:,lbj:,:,:,:)
5966 real(r8),
intent(inout) :: nl_t(lbi:,lbj:,:,:,:)
5967 real(r8),
intent(inout) :: nl_u(lbi:,lbj:,:,:)
5968 real(r8),
intent(inout) :: nl_v(lbi:,lbj:,:,:)
5970 real(r8),
intent(inout) :: nl_ubar(lbi:,lbj:,:)
5971 real(r8),
intent(inout) :: nl_vbar(lbi:,lbj:,:)
5973 real(r8),
intent(inout) :: nl_zeta(lbi:,lbj:,:)
5978 real(r8),
intent(in) :: rmask(lbi:ubi,lbj:ubj)
5979 real(r8),
intent(in) :: umask(lbi:ubi,lbj:ubj)
5980 real(r8),
intent(in) :: vmask(lbi:ubi,lbj:ubj)
5982# ifdef ADJUST_BOUNDARY
5984 real(r8),
intent(inout) :: nl_t_obc(lbij:ubij,
n(ng),4, &
5985 & Nbrec(ng),2,NT(ng))
5986 real(r8),
intent(inout) :: nl_u_obc(lbij:ubij,
n(ng),4,
nbrec(ng),2)
5987 real(r8),
intent(inout) :: nl_v_obc(lbij:ubij,
n(ng),4,
nbrec(ng),2)
5989 real(r8),
intent(inout) :: nl_ubar_obc(lbij:ubij,4,
nbrec(ng),2)
5990 real(r8),
intent(inout) :: nl_vbar_obc(lbij:ubij,4,
nbrec(ng),2)
5991 real(r8),
intent(inout) :: nl_zeta_obc(lbij:ubij,4,
nbrec(ng),2)
5993# ifdef ADJUST_WSTRESS
5994 real(r8),
intent(inout) :: nl_ustr(lbi:ubi,lbj:ubj,
nfrec(ng),2)
5995 real(r8),
intent(inout) :: nl_vstr(lbi:ubi,lbj:ubj,
nfrec(ng),2)
5998# ifdef ADJUST_STFLUX
5999 real(r8),
intent(inout) :: nl_tflux(lbi:ubi,lbj:ubj, &
6000 & Nfrec(ng),2,NT(ng))
6002 real(r8),
intent(inout) :: nl_t(lbi:ubi,lbj:ubj,
n(ng),3,
nt(ng))
6003 real(r8),
intent(inout) :: nl_u(lbi:ubi,lbj:ubj,
n(ng),2)
6004 real(r8),
intent(inout) :: nl_v(lbi:ubi,lbj:ubj,
n(ng),2)
6006 real(r8),
intent(inout) :: nl_ubar(lbi:ubi,lbj:ubj,:)
6007 real(r8),
intent(inout) :: nl_vbar(lbi:ubi,lbj:ubj,:)
6009 real(r8),
intent(inout) :: nl_zeta(lbi:ubi,lbj:ubj,:)
6016 integer :: i, rec, lscale
6020 real(r8) :: fac, fac1, fac2
6022 real(r8),
dimension(0:NstateVar(ng)) :: dot
6024 character (len=256) :: ncname
6026 character (len=*),
parameter :: myfile = &
6027 & __FILE__//
", new_cost"
6029# include "set_bounds.h"
6059 & lbi, ubi, lbj, ubj, lbij, ubij, &
6062 & rmask, umask, vmask, &
6064# ifdef ADJUST_BOUNDARY
6066 & nl_t_obc, nl_u_obc, nl_v_obc, &
6068 & nl_ubar_obc, nl_vbar_obc, &
6071# ifdef ADJUST_WSTRESS
6072 & nl_ustr, nl_vstr, &
6075# ifdef ADJUST_STFLUX
6078 & nl_t, nl_u, nl_v, &
6080 & nl_ubar, nl_vbar, &
6087 WRITE (ncname,10) trim(
adm(ng)%base), outloop
6088 10
FORMAT (a,
'_',i3.3,
'.nc')
6098 & lbi, ubi, lbj, ubj, lbij, ubij, &
6101# if defined PIO_LIB && defined DISTRIBUTE
6102 &
adm(ng)%pioFile, &
6106 & rmask, umask, vmask, &
6108# ifdef ADJUST_BOUNDARY
6110 & nl_t_obc, nl_u_obc, nl_v_obc, &
6112 & nl_ubar_obc, nl_vbar_obc, &
6115# ifdef ADJUST_WSTRESS
6116 & nl_ustr, nl_vstr, &
6119# ifdef ADJUST_STFLUX
6122 & nl_t, nl_u, nl_v, &
6124 & nl_ubar, nl_vbar, &
6134 fac2=
cg_zu(rec,outloop)
6137 & lbi, ubi, lbj, ubj, lbij, ubij, &
6138 & l1, l2, l1, fac1, fac2, &
6140 & rmask, umask, vmask, &
6142# ifdef ADJUST_BOUNDARY
6144 & nl_t_obc, nl_t_obc, &
6145 & nl_u_obc, nl_u_obc, &
6146 & nl_v_obc, nl_v_obc, &
6148 & nl_ubar_obc, nl_ubar_obc, &
6149 & nl_vbar_obc, nl_vbar_obc, &
6150 & nl_zeta_obc, nl_zeta_obc, &
6152# ifdef ADJUST_WSTRESS
6153 & nl_ustr, nl_ustr, &
6154 & nl_vstr, nl_vstr, &
6157# ifdef ADJUST_STFLUX
6158 & nl_tflux, nl_tflux, &
6164 & nl_ubar, nl_ubar, &
6165 & nl_vbar, nl_vbar, &
6174 WRITE (ncname,10) trim(
adm(ng)%base), outloop
6180 & lbi, ubi, lbj, ubj, lbij, ubij, &
6183# if defined PIO_LIB && defined DISTRIBUTE
6184 &
adm(ng)%pioFile, &
6188 & rmask, umask, vmask, &
6190# ifdef ADJUST_BOUNDARY
6192 & nl_t_obc, nl_u_obc, nl_v_obc, &
6194 & nl_ubar_obc, nl_vbar_obc, &
6197# ifdef ADJUST_WSTRESS
6198 & nl_ustr, nl_vstr, &
6201# ifdef ADJUST_STFLUX
6204 & nl_t, nl_u, nl_v, &
6206 & nl_ubar, nl_vbar, &
6215 & lbi, ubi, lbj, ubj, lbij, ubij, &
6218 & rmask, umask, vmask, &
6220# ifdef ADJUST_BOUNDARY
6222 & nl_t_obc(:,:,:,:,l1,:), &
6223 & nl_t_obc(:,:,:,:,l2,:), &
6224 & nl_u_obc(:,:,:,:,l1), &
6225 & nl_u_obc(:,:,:,:,l2), &
6226 & nl_v_obc(:,:,:,:,l1), &
6227 & nl_v_obc(:,:,:,:,l2), &
6229 & nl_ubar_obc(:,:,:,l1), &
6230 & nl_ubar_obc(:,:,:,l2), &
6231 & nl_vbar_obc(:,:,:,l1), &
6232 & nl_vbar_obc(:,:,:,l2), &
6233 & nl_zeta_obc(:,:,:,l1), &
6234 & nl_zeta_obc(:,:,:,l2), &
6236# ifdef ADJUST_WSTRESS
6237 & nl_ustr(:,:,:,l1), nl_ustr(:,:,:,l2), &
6238 & nl_vstr(:,:,:,l1), nl_vstr(:,:,:,l2), &
6241# ifdef ADJUST_STFLUX
6242 & nl_tflux(:,:,:,l1,:), &
6243 & nl_tflux(:,:,:,l2,:), &
6245 & nl_t(:,:,:,l1,:), nl_t(:,:,:,l2,:), &
6246 & nl_u(:,:,:,l1), nl_u(:,:,:,l2), &
6247 & nl_v(:,:,:,l1), nl_v(:,:,:,l2), &
6249 & nl_ubar(:,:,l1), nl_ubar(:,:,l2), &
6250 & nl_vbar(:,:,l1), nl_vbar(:,:,l2), &
6252 & nl_zeta(:,:,l1), nl_zeta(:,:,l2))
6270 IF (
lprecond.and.(outloop.gt.1))
THEN
6275 CALL precond (ng, tile, model,
'new cost function', &
6276 & lbi, ubi, lbj, ubj, lbij, ubij, &
6277 & imins, imaxs, jmins, jmaxs, &
6279 & innloop, outloop, &
6281 & rmask, umask, vmask, &
6283# ifdef ADJUST_BOUNDARY
6285 & nl_t_obc, nl_u_obc, nl_v_obc, &
6287 & nl_ubar_obc, nl_vbar_obc, &
6290# ifdef ADJUST_WSTRESS
6291 & nl_ustr, nl_vstr, &
6294# ifdef ADJUST_STFLUX
6297 & nl_t, nl_u, nl_v, &
6299 & nl_ubar, nl_vbar, &
6311 & lbi, ubi, lbj, ubj, lbij, ubij, &
6314# if defined PIO_LIB && defined DISTRIBUTE
6315 &
itl(ng)%pioFile, &
6319 & rmask, umask, vmask, &
6321# ifdef ADJUST_BOUNDARY
6323 & nl_t_obc, nl_u_obc, nl_v_obc, &
6325 & nl_ubar_obc, nl_vbar_obc, &
6328# ifdef ADJUST_WSTRESS
6329 & nl_ustr, nl_vstr, &
6332# ifdef ADJUST_STFLUX
6335 & nl_t, nl_u, nl_v, &
6337 & nl_ubar, nl_vbar, &
6350 & lbi, ubi, lbj, ubj, lbij, ubij, &
6351 & l1, l2, l1, fac1, fac2, &
6353 & rmask, umask, vmask, &
6355# ifdef ADJUST_BOUNDARY
6357 & nl_t_obc, nl_t_obc, &
6358 & nl_u_obc, nl_u_obc, &
6359 & nl_v_obc, nl_v_obc, &
6361 & nl_ubar_obc, nl_ubar_obc, &
6362 & nl_vbar_obc, nl_vbar_obc, &
6363 & nl_zeta_obc, nl_zeta_obc, &
6365# ifdef ADJUST_WSTRESS
6366 & nl_ustr, nl_ustr, &
6367 & nl_vstr, nl_vstr, &
6370# ifdef ADJUST_STFLUX
6371 & nl_tflux, nl_tflux, &
6377 & nl_ubar, nl_ubar, &
6378 & nl_vbar, nl_vbar, &
6383 & lbi, ubi, lbj, ubj, lbij, ubij, &
6386 & rmask, umask, vmask, &
6388# ifdef ADJUST_BOUNDARY
6390 & nl_t_obc(:,:,:,:,l1,:), &
6391 & nl_t_obc(:,:,:,:,l1,:), &
6392 & nl_u_obc(:,:,:,:,l1), &
6393 & nl_u_obc(:,:,:,:,l1), &
6394 & nl_v_obc(:,:,:,:,l1), &
6395 & nl_v_obc(:,:,:,:,l1), &
6397 & nl_ubar_obc(:,:,:,l1), &
6398 & nl_ubar_obc(:,:,:,l1), &
6399 & nl_vbar_obc(:,:,:,l1), &
6400 & nl_vbar_obc(:,:,:,l1), &
6401 & nl_zeta_obc(:,:,:,l1), &
6402 & nl_zeta_obc(:,:,:,l1), &
6404# ifdef ADJUST_WSTRESS
6405 & nl_ustr(:,:,:,l1), nl_ustr(:,:,:,l1), &
6406 & nl_vstr(:,:,:,l1), nl_vstr(:,:,:,l1), &
6409# ifdef ADJUST_STFLUX
6410 & nl_tflux(:,:,:,l1,:), &
6411 & nl_tflux(:,:,:,l1,:), &
6413 & nl_t(:,:,:,l1,:), nl_t(:,:,:,l1,:), &
6414 & nl_u(:,:,:,l1), nl_u(:,:,:,l1), &
6415 & nl_v(:,:,:,l1), nl_v(:,:,:,l1), &
6417 & nl_ubar(:,:,l1), nl_ubar(:,:,l1), &
6418 & nl_vbar(:,:,l1), nl_vbar(:,:,l1), &
6420 & nl_zeta(:,:,l1), nl_zeta(:,:,l1))
6422 fourdvar(ng)%BackCost(0)=0.5_r8*dot(0)
6435 & LBi, UBi, LBj, UBj, LBij, UBij, &
6436 & IminS, ImaxS, JminS, JmaxS, &
6437 & NstateVars, Lscale, Ltrans, &
6438 & innLoop, outLoop, &
6440 & rmask, umask, vmask, &
6442# ifdef ADJUST_BOUNDARY
6444 & nl_t_obc, nl_u_obc, nl_v_obc, &
6446 & nl_ubar_obc, nl_vbar_obc, &
6449# ifdef ADJUST_WSTRESS
6450 & nl_ustr, nl_vstr, &
6453# ifdef ADJUST_STFLUX
6456 & nl_t, nl_u, nl_v, &
6458 & nl_ubar, nl_vbar, &
6465 logical,
intent(in) :: ltrans
6467 integer,
intent(in) :: ng, tile, model
6468 integer,
intent(in) :: lbi, ubi, lbj, ubj, lbij, ubij
6469 integer,
intent(in) :: imins, imaxs, jmins, jmaxs
6470 integer,
intent(in) :: nstatevars, lscale
6471 integer,
intent(in) :: innloop, outloop
6473 character (len=*),
intent(in) :: message
6475# ifdef ASSUMED_SHAPE
6477 real(r8),
intent(in) :: rmask(lbi:,lbj:)
6478 real(r8),
intent(in) :: umask(lbi:,lbj:)
6479 real(r8),
intent(in) :: vmask(lbi:,lbj:)
6481# ifdef ADJUST_BOUNDARY
6483 real(r8),
intent(inout) :: nl_t_obc(lbij:,:,:,:,:,:)
6484 real(r8),
intent(inout) :: nl_u_obc(lbij:,:,:,:,:)
6485 real(r8),
intent(inout) :: nl_v_obc(lbij:,:,:,:,:)
6487 real(r8),
intent(inout) :: nl_ubar_obc(lbij:,:,:,:)
6488 real(r8),
intent(inout) :: nl_vbar_obc(lbij:,:,:,:)
6489 real(r8),
intent(inout) :: nl_zeta_obc(lbij:,:,:,:)
6491# ifdef ADJUST_WSTRESS
6492 real(r8),
intent(inout) :: nl_ustr(lbi:,lbj:,:,:)
6493 real(r8),
intent(inout) :: nl_vstr(lbi:,lbj:,:,:)
6496# ifdef ADJUST_STFLUX
6497 real(r8),
intent(inout) :: nl_tflux(lbi:,lbj:,:,:,:)
6499 real(r8),
intent(inout) :: nl_t(lbi:,lbj:,:,:,:)
6500 real(r8),
intent(inout) :: nl_u(lbi:,lbj:,:,:)
6501 real(r8),
intent(inout) :: nl_v(lbi:,lbj:,:,:)
6503 real(r8),
intent(inout) :: nl_ubar(lbi:,lbj:,:)
6504 real(r8),
intent(inout) :: nl_vbar(lbi:,lbj:,:)
6506 real(r8),
intent(inout) :: nl_zeta(lbi:,lbj:,:)
6511 real(r8),
intent(in) :: rmask(lbi:ubi,lbj:ubj)
6512 real(r8),
intent(in) :: umask(lbi:ubi,lbj:ubj)
6513 real(r8),
intent(in) :: vmask(lbi:ubi,lbj:ubj)
6515# ifdef ADJUST_BOUNDARY
6517 real(r8),
intent(inout) :: nl_t_obc(lbij:ubij,
n(ng),4, &
6518 & Nbrec(ng),2,NT(ng))
6519 real(r8),
intent(inout) :: nl_u_obc(lbij:ubij,
n(ng),4,
nbrec(ng),2)
6520 real(r8),
intent(inout) :: nl_v_obc(lbij:ubij,
n(ng),4,
nbrec(ng),2)
6522 real(r8),
intent(inout) :: nl_ubar_obc(lbij:ubij,4,
nbrec(ng),2)
6523 real(r8),
intent(inout) :: nl_vbar_obc(lbij:ubij,4,
nbrec(ng),2)
6524 real(r8),
intent(inout) :: nl_zeta_obc(lbij:ubij,4,
nbrec(ng),2)
6526# ifdef ADJUST_WSTRESS
6527 real(r8),
intent(inout) :: nl_ustr(lbi:ubi,lbj:ubj,
nfrec(ng),2)
6528 real(r8),
intent(inout) :: nl_vstr(lbi:ubi,lbj:ubj,
nfrec(ng),2)
6531# ifdef ADJUST_STFLUX
6532 real(r8),
intent(inout) :: nl_tflux(lbi:ubi,lbj:ubj, &
6533 & Nfrec(ng),2,NT(ng))
6535 real(r8),
intent(inout) :: nl_t(lbi:ubi,lbj:ubj,
n(ng),3,
nt(ng))
6536 real(r8),
intent(inout) :: nl_u(lbi:ubi,lbj:ubj,
n(ng),2)
6537 real(r8),
intent(inout) :: nl_v(lbi:ubi,lbj:ubj,
n(ng),2)
6539 real(r8),
intent(inout) :: nl_ubar(lbi:ubi,lbj:ubj,:)
6540 real(r8),
intent(inout) :: nl_vbar(lbi:ubi,lbj:ubj,:)
6542 real(r8),
intent(inout) :: nl_zeta(lbi:ubi,lbj:ubj,:)
6547 integer :: nsub, i, j, k, l1, l2, nvec, rec, ndeflcz
6548 integer :: is, ie, inc, iss, ncid
6549 integer :: nol, nols, nole, ninc
6555 integer,
parameter :: ndef = 1
6557 real(r8) :: cff, fac, fac1, fac2, facritz
6558 real(r8),
dimension(0:NstateVars) :: dotprod
6559 real(r8),
dimension(1:Ninner+1,Nouter) :: beta_lcz
6560 real(r8),
dimension(Ninner,Ninner) :: zv_lcz
6562 character (len=256) :: ncname
6565 character (len=3) :: op_handle
6568 character (len=*),
parameter :: myfile = &
6569 & __FILE__//
", precond"
6571# include "set_bounds.h"
6605 WRITE (
stdout,10) outloop, innloop,
'Ritz', trim(message)
6607 WRITE (
stdout,10) outloop, innloop,
'Spectral', trim(message)
6614 DO nol=nols,nole,ninc
6618 WRITE (ncname,20) trim(
adm(ng)%base), nol
6620 WRITE (
stdout,30) outloop, innloop, trim(ncname)
6623 SELECT CASE (
hss(ng)%IOtype)
6626 &
'cg_beta', beta_lcz)
6633# if defined PIO_LIB && defined DISTRIBUTE
6636 &
'cg_beta', beta_lcz)
6661 WRITE (
stdout,40) outloop, innloop, ingood
6664 IF (lscale.gt.0)
THEN
6690 IF (.not.ltrans)
THEN
6694 WRITE (ncname,20) trim(
adm(ng)%base), nol
6695 IF (
master.and.(nvec.eq.is))
THEN
6696 WRITE (
stdout,50) outloop, innloop, trim(ncname)
6705 & lbi, ubi, lbj, ubj, lbij, ubij, &
6708# if defined PIO_LIB && defined DISTRIBUTE
6709 &
adm(ng)%pioFile, &
6713 & rmask, umask, vmask, &
6715# ifdef ADJUST_BOUNDARY
6717 & nl_t_obc, nl_u_obc, nl_v_obc, &
6719 & nl_ubar_obc, nl_vbar_obc, &
6722# ifdef ADJUST_WSTRESS
6723 & nl_ustr, nl_vstr, &
6726# ifdef ADJUST_STFLUX
6729 & nl_t, nl_u, nl_v, &
6731 & nl_ubar, nl_vbar, &
6735 & __line__, myfile))
RETURN
6741 & lbi, ubi, lbj, ubj, lbij, ubij, &
6742 & nstatevars, dotprod(0:), &
6744 & rmask, umask, vmask, &
6746# ifdef ADJUST_BOUNDARY
6748 & nl_t_obc(:,:,:,:,l1,:), &
6749 & nl_t_obc(:,:,:,:,l2,:), &
6750 & nl_u_obc(:,:,:,:,l1), &
6751 & nl_u_obc(:,:,:,:,l2), &
6752 & nl_v_obc(:,:,:,:,l1), &
6753 & nl_v_obc(:,:,:,:,l2), &
6755 & nl_ubar_obc(:,:,:,l1), &
6756 & nl_ubar_obc(:,:,:,l2), &
6757 & nl_vbar_obc(:,:,:,l1), &
6758 & nl_vbar_obc(:,:,:,l2), &
6759 & nl_zeta_obc(:,:,:,l1), &
6760 & nl_zeta_obc(:,:,:,l2), &
6762# ifdef ADJUST_WSTRESS
6763 & nl_ustr(:,:,:,l1), nl_ustr(:,:,:,l2), &
6764 & nl_vstr(:,:,:,l1), nl_vstr(:,:,:,l2), &
6767# ifdef ADJUST_STFLUX
6768 & nl_tflux(:,:,:,l1,:), &
6769 & nl_tflux(:,:,:,l2,:), &
6771 & nl_t(:,:,:,l1,:), nl_t(:,:,:,l2,:), &
6772 & nl_u(:,:,:,l1), nl_u(:,:,:,l2), &
6773 & nl_v(:,:,:,l1), nl_v(:,:,:,l2), &
6775 & nl_ubar(:,:,l1), nl_ubar(:,:,l2), &
6776 & nl_vbar(:,:,l1), nl_vbar(:,:,l2), &
6778 & nl_zeta(:,:,l1), nl_zeta(:,:,l2))
6788 IF (.not.ltrans)
THEN
6789 facritz=facritz*dotprod(0)
6797 WRITE (ncname,20) trim(
hss(ng)%base), nol
6798 IF (
master.and.(nvec.eq.is))
THEN
6799 WRITE (
stdout,60) outloop, innloop, trim(ncname)
6803 & lbi, ubi, lbj, ubj, lbij, ubij, &
6806# if defined PIO_LIB && defined DISTRIBUTE
6807 &
hss(ng)%pioFile, &
6811 & rmask, umask, vmask, &
6813# ifdef ADJUST_BOUNDARY
6815 & nl_t_obc, nl_u_obc, nl_v_obc, &
6817 & nl_ubar_obc, nl_vbar_obc, &
6820# ifdef ADJUST_WSTRESS
6821 & nl_ustr, nl_vstr, &
6824# ifdef ADJUST_STFLUX
6827 & nl_t, nl_u, nl_v, &
6829 & nl_ubar, nl_vbar, &
6839 & lbi, ubi, lbj, ubj, lbij, ubij, &
6840 & nstatevars, dotprod(0:), &
6842 & rmask, umask, vmask, &
6844# ifdef ADJUST_BOUNDARY
6846 & nl_t_obc(:,:,:,:,l1,:), &
6847 & nl_t_obc(:,:,:,:,l2,:), &
6848 & nl_u_obc(:,:,:,:,l1), &
6849 & nl_u_obc(:,:,:,:,l2), &
6850 & nl_v_obc(:,:,:,:,l1), &
6851 & nl_v_obc(:,:,:,:,l2), &
6853 & nl_ubar_obc(:,:,:,l1), &
6854 & nl_ubar_obc(:,:,:,l2), &
6855 & nl_vbar_obc(:,:,:,l1), &
6856 & nl_vbar_obc(:,:,:,l2), &
6857 & nl_zeta_obc(:,:,:,l1), &
6858 & nl_zeta_obc(:,:,:,l2), &
6860# ifdef ADJUST_WSTRESS
6861 & nl_ustr(:,:,:,l1), nl_ustr(:,:,:,l2), &
6862 & nl_vstr(:,:,:,l1), nl_vstr(:,:,:,l2), &
6865# ifdef ADJUST_STFLUX
6866 & nl_tflux(:,:,:,l1,:), &
6867 & nl_tflux(:,:,:,l2,:), &
6869 & nl_t(:,:,:,l1,:), nl_t(:,:,:,l2,:), &
6870 & nl_u(:,:,:,l1), nl_u(:,:,:,l2), &
6871 & nl_v(:,:,:,l1), nl_v(:,:,:,l2), &
6873 & nl_ubar(:,:,l1), nl_ubar(:,:,l2), &
6874 & nl_vbar(:,:,l1), nl_vbar(:,:,l2), &
6876 & nl_zeta(:,:,l1), nl_zeta(:,:,l2))
6891 IF (lscale.eq.-1)
THEN
6893 ELSE IF (lscale.eq.1)
THEN
6895 ELSE IF (lscale.eq.-2)
THEN
6897 ELSE IF (lscale.eq.2)
THEN
6902 IF (.not.ltrans)
THEN
6903 IF (
lritz.and.(lscale.eq.-2))
THEN
6906 IF (
lritz.and.(lscale.eq.2))
THEN
6912 & lbi, ubi, lbj, ubj, lbij, ubij, &
6913 & l1, l2, l1, fac1, fac2, &
6915 & rmask, umask, vmask, &
6917# ifdef ADJUST_BOUNDARY
6919 & nl_t_obc, nl_t_obc, &
6920 & nl_u_obc, nl_u_obc, &
6921 & nl_v_obc, nl_v_obc, &
6923 & nl_ubar_obc, nl_ubar_obc, &
6924 & nl_vbar_obc, nl_vbar_obc, &
6925 & nl_zeta_obc, nl_zeta_obc, &
6927# ifdef ADJUST_WSTRESS
6928 & nl_ustr, nl_ustr, &
6929 & nl_vstr, nl_vstr, &
6932# ifdef ADJUST_STFLUX
6933 & nl_tflux, nl_tflux, &
6939 & nl_ubar, nl_ubar, &
6940 & nl_vbar, nl_vbar, &
6944 IF (
lritz.and.ltrans)
THEN
6946 WRITE (ncname,20) trim(
adm(ng)%base), nol
6947 IF (
master.and.(nvec.eq.is))
THEN
6948 WRITE (
stdout,50) outloop, innloop, trim(ncname)
6957 & lbi, ubi, lbj, ubj, lbij, ubij, &
6960# if defined PIO_LIB && defined DISTRIBUTE
6961 &
adm(ng)%pioFile, &
6965 & rmask, umask, vmask, &
6967# ifdef ADJUST_BOUNDARY
6969 & nl_t_obc, nl_u_obc, nl_v_obc, &
6971 & nl_ubar_obc, nl_vbar_obc, &
6974# ifdef ADJUST_WSTRESS
6975 & nl_ustr, nl_vstr, &
6978# ifdef ADJUST_STFLUX
6981 & nl_t, nl_u, nl_v, &
6983 & nl_ubar, nl_vbar, &
6988 IF (lscale.eq.2)
THEN
6991 IF (lscale.eq.-2)
THEN
6996 & lbi, ubi, lbj, ubj, lbij, ubij, &
6997 & l1, l2, l1, fac1, fac2, &
6999 & rmask, umask, vmask, &
7001# ifdef ADJUST_BOUNDARY
7003 & nl_t_obc, nl_t_obc, &
7004 & nl_u_obc, nl_u_obc, &
7005 & nl_v_obc, nl_v_obc, &
7007 & nl_ubar_obc, nl_ubar_obc, &
7008 & nl_vbar_obc, nl_vbar_obc, &
7009 & nl_zeta_obc, nl_zeta_obc, &
7011# ifdef ADJUST_WSTRESS
7012 & nl_ustr, nl_ustr, &
7013 & nl_vstr, nl_vstr, &
7016# ifdef ADJUST_STFLUX
7017 & nl_tflux, nl_tflux, &
7023 & nl_ubar, nl_ubar, &
7024 & nl_vbar, nl_vbar, &
7033 10
FORMAT (/,1x,
'(',i3.3,
',',i3.3,
'): PRECOND -',1x, &
7034 & a,1x,
'preconditioning:',1x,a/)
7035 20
FORMAT (a,
'_',i3.3,
'.nc')
7036 30
FORMAT (1x,
'(',i3.3,
',',i3.3,
'): PRECOND -',1x, &
7037 &
'Reading Lanczos eigenpairs from:',t58,a)
7038 40
FORMAT (1x,
'(',i3.3,
',',i3.3,
'): PRECOND -',1x, &
7039 &
'Number of good Ritz eigenvalues,',t58,
'ingood = ',i3)
7040 50
FORMAT (1x,
'(',i3.3,
',',i3.3,
'): PRECOND -',1x, &
7041 &
'Processing Lanczos vectors from:',t58,a)
7042 60
FORMAT (1x,
'(',i3.3,
',',i3.3,
'): PRECOND -',1x, &
7043 &
'Processing Hessian vectors from:',t58,a)