265
266
271
273# ifdef SOLVE3D
275# endif
276# ifdef ADJUST_BOUNDARY
278# ifdef SOLVE3D
280# endif
281# endif
282# ifdef DISTRIBUTE
284# endif
286
287
288
289 logical, intent(in) :: Lweak
290
291 integer, intent(in) :: ng, tile
292 integer, intent(in) :: LBi, UBi, LBj, UBj, LBij, UBij
293 integer, intent(in) :: IminS, ImaxS, JminS, JmaxS
294 integer, intent(in) :: nstp, nnew, Linp, ifac
295
296# ifdef ASSUMED_SHAPE
297 real(r8), intent(in) :: pm(LBi:,LBj:)
298 real(r8), intent(in) :: om_p(LBi:,LBj:)
299 real(r8), intent(in) :: om_r(LBi:,LBj:)
300 real(r8), intent(in) :: om_u(LBi:,LBj:)
301 real(r8), intent(in) :: om_v(LBi:,LBj:)
302 real(r8), intent(in) :: pn(LBi:,LBj:)
303 real(r8), intent(in) :: on_p(LBi:,LBj:)
304 real(r8), intent(in) :: on_r(LBi:,LBj:)
305 real(r8), intent(in) :: on_u(LBi:,LBj:)
306 real(r8), intent(in) :: on_v(LBi:,LBj:)
307 real(r8), intent(in) :: pmon_p(LBi:,LBj:)
308 real(r8), intent(in) :: pmon_r(LBi:,LBj:)
309 real(r8), intent(in) :: pmon_u(LBi:,LBj:)
310 real(r8), intent(in) :: pnom_p(LBi:,LBj:)
311 real(r8), intent(in) :: pnom_r(LBi:,LBj:)
312 real(r8), intent(in) :: pnom_v(LBi:,LBj:)
313# ifdef MASKING
314 real(r8), intent(in) :: rmask(LBi:,LBj:)
315 real(r8), intent(in) :: pmask(LBi:,LBj:)
316 real(r8), intent(in) :: umask(LBi:,LBj:)
317 real(r8), intent(in) :: vmask(LBi:,LBj:)
318# endif
319 real(r8), intent(in) :: Kh(LBi:,LBj:)
320# ifdef SOLVE3D
321 real(r8), intent(in) :: Kv(LBi:,LBj:,0:)
322# ifdef ICESHELF
323 real(r8), intent(in) :: zice(LBi:,LBj:)
324# endif
325# if defined SEDIMENT && defined SED_MORPH
326 real(r8), intent(inout):: bed_thick(LBi:,LBj:,:)
327# endif
328 real(r8), intent(inout) :: h(LBi:,LBj:)
329# endif
330# ifdef ADJUST_BOUNDARY
331# ifdef SOLVE3D
332 real(r8), intent (in) :: VnormRobc(LBij:,:,:,:)
333 real(r8), intent (in) :: VnormUobc(LBij:,:,:)
334 real(r8), intent (in) :: VnormVobc(LBij:,:,:)
335# endif
336 real(r8), intent (in) :: HnormRobc(LBij:,:)
337 real(r8), intent (in) :: HnormUobc(LBij:,:)
338 real(r8), intent (in) :: HnormVobc(LBij:,:)
339# endif
340# ifdef ADJUST_WSTRESS
341 real(r8), intent(in) :: HnormSUS(LBi:,LBj:)
342 real(r8), intent(in) :: HnormSVS(LBi:,LBj:)
343# endif
344# if defined ADJUST_STFLUX && defined SOLVE3D
345 real(r8), intent(in) :: HnormSTF(LBi:,LBj:,:)
346# endif
347# ifdef SOLVE3D
348 real(r8), intent(in) :: VnormR(LBi:,LBj:,:,:,:)
349 real(r8), intent(in) :: VnormU(LBi:,LBj:,:,:)
350 real(r8), intent(in) :: VnormV(LBi:,LBj:,:,:)
351# endif
352 real(r8), intent(in) :: HnormR(LBi:,LBj:,:)
353 real(r8), intent(in) :: HnormU(LBi:,LBj:,:)
354 real(r8), intent(in) :: HnormV(LBi:,LBj:,:)
355# ifdef ADJUST_BOUNDARY
356# ifdef SOLVE3D
357 real(r8), intent(inout) :: ad_t_obc(LBij:,:,:,:,:,:)
358 real(r8), intent(inout) :: ad_u_obc(LBij:,:,:,:,:)
359 real(r8), intent(inout) :: ad_v_obc(LBij:,:,:,:,:)
360# endif
361 real(r8), intent(inout) :: ad_ubar_obc(LBij:,:,:,:)
362 real(r8), intent(inout) :: ad_vbar_obc(LBij:,:,:,:)
363 real(r8), intent(inout) :: ad_zeta_obc(LBij:,:,:,:)
364# endif
365# ifdef ADJUST_WSTRESS
366 real(r8), intent(inout) :: ad_ustr(LBi:,LBj:,:,:)
367 real(r8), intent(inout) :: ad_vstr(LBi:,LBj:,:,:)
368# endif
369# if defined ADJUST_STFLUX && defined SOLVE3D
370 real(r8), intent(inout) :: ad_tflux(LBi:,LBj:,:,:,:)
371# endif
372# ifdef SOLVE3D
373 real(r8), intent(inout) :: ad_t(LBi:,LBj:,:,:,:)
374 real(r8), intent(inout) :: ad_u(LBi:,LBj:,:,:)
375 real(r8), intent(inout) :: ad_v(LBi:,LBj:,:,:)
376# endif
377 real(r8), intent(inout) :: ad_ubar(LBi:,LBj:,:)
378 real(r8), intent(inout) :: ad_vbar(LBi:,LBj:,:)
379 real(r8), intent(inout) :: ad_zeta(LBi:,LBj:,:)
380# ifdef SOLVE3D
381 real(r8), intent(out) :: Hz(LBi:,LBj:,:)
382 real(r8), intent(out) :: z_r(LBi:,LBj:,:)
383 real(r8), intent(out) :: z_w(LBi:,LBj:,0:)
384# endif
385# else
386 real(r8), intent(in) :: pm(LBi:UBi,LBj:UBj)
387 real(r8), intent(in) :: om_p(LBi:UBi,LBj:UBj)
388 real(r8), intent(in) :: om_r(LBi:UBi,LBj:UBj)
389 real(r8), intent(in) :: om_u(LBi:UBi,LBj:UBj)
390 real(r8), intent(in) :: om_v(LBi:UBi,LBj:UBj)
391 real(r8), intent(in) :: pn(LBi:UBi,LBj:UBj)
392 real(r8), intent(in) :: on_p(LBi:UBi,LBj:UBj)
393 real(r8), intent(in) :: on_r(LBi:UBi,LBj:UBj)
394 real(r8), intent(in) :: on_u(LBi:UBi,LBj:UBj)
395 real(r8), intent(in) :: on_v(LBi:UBi,LBj:UBj)
396 real(r8), intent(in) :: pmon_p(LBi:UBi,LBj:UBj)
397 real(r8), intent(in) :: pmon_r(LBi:UBi,LBj:UBj)
398 real(r8), intent(in) :: pmon_u(LBi:UBi,LBj:UBj)
399 real(r8), intent(in) :: pnom_p(LBi:UBi,LBj:UBj)
400 real(r8), intent(in) :: pnom_r(LBi:UBi,LBj:UBj)
401 real(r8), intent(in) :: pnom_v(LBi:UBi,LBj:UBj)
402# ifdef MASKING
403 real(r8), intent(in) :: rmask(LBi:UBi,LBj:UBj)
404 real(r8), intent(in) :: pmask(LBi:UBi,LBj:UBj)
405 real(r8), intent(in) :: umask(LBi:UBi,LBj:UBj)
406 real(r8), intent(in) :: vmask(LBi:UBi,LBj:UBj)
407# endif
408 real(r8), intent(in) :: Kh(LBi:UBi,LBj:UBj)
409# ifdef SOLVE3D
410 real(r8), intent(in) :: Kv(LBi:UBi,LBj:UBj,0:N(ng))
411# ifdef ICESHELF
412 real(r8), intent(in) :: zice(LBi:UBi,LBj:UBj)
413# endif
414# if defined SEDIMENT && defined SED_MORPH
415 real(r8), intent(inout):: bed_thick(LBi:UBi,LBj:UBj,3)
416# endif
417 real(r8), intent(inout) :: h(LBi:UBi,LBj:UBj)
418# endif
419# ifdef ADJUST_BOUNDARY
420# ifdef SOLVE3D
421 real(r8), intent (in) :: VnormRobc(LBij:UBij,N(ng),4,NT(ng))
422 real(r8), intent (in) :: VnormUobc(LBij:UBij,N(ng),4)
423 real(r8), intent (in) :: VnormVobc(LBij:UBij,N(ng),4)
424# endif
425 real(r8), intent (in) :: HnormRobc(LBij:UBij,4)
426 real(r8), intent (in) :: HnormUobc(LBij:UBij,4)
427 real(r8), intent (in) :: HnormVobc(LBij:UBij,4)
428# endif
429# ifdef ADJUST_WSTRESS
430 real(r8), intent(in) :: HnormSUS(LBi:UBi,LBj:UBj)
431 real(r8), intent(in) :: HnormSVS(LBi:UBi,LBj:UBj)
432# endif
433# if defined ADJUST_STFLUX && defined SOLVE3D
434 real(r8), intent(in) :: HnormSTF(LBi:UBi,LBj:UBj,NT(ng))
435# endif
436# ifdef SOLVE3D
437 real(r8), intent(in) :: VnormR(LBi:UBi,LBj:UBj,N(ng),NSA,NT(ng))
438 real(r8), intent(in) :: VnormU(LBi:UBi,LBj:UBj,NSA,N(ng))
439 real(r8), intent(in) :: VnormV(LBi:UBi,LBj:UBj,NSA,N(ng))
440# endif
441 real(r8), intent(in) :: HnormR(LBi:UBi,LBj:UBj,NSA)
442 real(r8), intent(in) :: HnormU(LBi:UBi,LBj:UBj,NSA)
443 real(r8), intent(in) :: HnormV(LBi:UBi,LBj:UBj,NSA)
444# ifdef ADJUST_BOUNDARY
445# ifdef SOLVE3D
446 real(r8), intent(inout) :: ad_t_obc(LBij:UBij,N(ng),4, &
447 & Nbrec(ng),2,NT(ng))
448 real(r8), intent(inout) :: ad_u_obc(LBij:UBij,N(ng),4,Nbrec(ng),2)
449 real(r8), intent(inout) :: ad_v_obc(LBij:UBij,N(ng),4,Nbrec(ng),2)
450# endif
451 real(r8), intent(inout) :: ad_ubar_obc(LBij:UBij,4,Nbrec(ng),2)
452 real(r8), intent(inout) :: ad_vbar_obc(LBij:UBij,4,Nbrec(ng),2)
453 real(r8), intent(inout) :: ad_zeta_obc(LBij:UBij,4,Nbrec(ng),2)
454# endif
455# ifdef ADJUST_WSTRESS
456 real(r8), intent(inout) :: ad_ustr(LBi:UBi,LBj:UBj,Nfrec(ng),2)
457 real(r8), intent(inout) :: ad_vstr(LBi:UBi,LBj:UBj,Nfrec(ng),2)
458# endif
459# if defined ADJUST_STFLUX && defined SOLVE3D
460 real(r8), intent(inout) :: ad_tflux(LBi:UBi,LBj:UBj, &
461 & Nfrec(ng),2,NT(ng))
462# endif
463# ifdef SOLVE3D
464 real(r8), intent(inout) :: ad_t(LBi:UBi,LBj:UBj,N(ng),3,NT(ng))
465 real(r8), intent(inout) :: ad_u(LBi:UBi,LBj:UBj,N(ng),2)
466 real(r8), intent(inout) :: ad_v(LBi:UBi,LBj:UBj,N(ng),2)
467# endif
468 real(r8), intent(inout) :: ad_ubar(LBi:UBi,LBj:UBj,:)
469 real(r8), intent(inout) :: ad_vbar(LBi:UBi,LBj:UBj,:)
470 real(r8), intent(inout) :: ad_zeta(LBi:UBi,LBj:UBj,:)
471# ifdef SOLVE3D
472 real(r8), intent(out) :: Hz(LBi:UBi,LBj:UBj,N(ng))
473 real(r8), intent(out) :: z_r(LBi:UBi,LBj:UBj,N(ng))
474 real(r8), intent(out) :: z_w(LBi:UBi,LBj:UBj,0:N(ng))
475# endif
476# endif
477
478
479
480# ifdef ADJUST_BOUNDARY
481 logical, dimension(4) :: Lconvolve
482# endif
483 integer :: i, ib, ir, is, it, j, k, rec
484 real(r8) :: cff
485# ifdef SOLVE3D
486 real(r8) :: fac
487# endif
488# ifdef SOLVE3D
489 real(r8), dimension(LBi:UBi,LBj:UBj) :: work
490# endif
491
492# include "set_bounds.h"
493
494
495
496
497
498 IF (lweak) THEN
499 rec=2
500 ELSE
501 rec=1
502 END IF
503
504# ifdef ADJUST_BOUNDARY
505
506
507
508
513# endif
514
515# ifdef SOLVE3D
516
517
518
519
520
521 DO i=lbi,ubi
522 DO j=lbj,ubj
523 work(i,j)=0.0_r8
524 END DO
525 END DO
526
528 & lbi, ubi, lbj, ubj, &
529 & imins, imaxs, jmins, jmaxs, &
530 & nstp, nnew, &
531 & h, &
532# ifdef ICESHELF
533 & zice, &
534# endif
535# if defined SEDIMENT && defined SED_MORPH
536 & bed_thick, &
537# endif
538 & work, &
539 & hz, z_r, z_w)
540# endif
541
542
543
544
545
546# ifdef DISTRIBUTE
548 & lbi, ubi, lbj, ubj, &
551 & ad_zeta(:,:,linp), &
552 & ad_ubar(:,:,linp), &
553 & ad_vbar(:,:,linp))
554# endif
555
556
557
558 DO j=jstrt,jendt
559 DO i=istrt,iendt
560 ad_zeta(i,j,linp)=ad_zeta(i,j,linp)*hnormr(i,j,rec)
561 END DO
562 END DO
563
564
565
566 DO j=jstrt,jendt
567 DO i=istrp,iendt
568 ad_ubar(i,j,linp)=ad_ubar(i,j,linp)*hnormu(i,j,rec)
569 END DO
570 END DO
571 DO j=jstrp,jendt
572 DO i=istrt,iendt
573 ad_vbar(i,j,linp)=ad_vbar(i,j,linp)*hnormv(i,j,rec)
574 END DO
575 END DO
576# ifdef SOLVE3D
577
578
579
580# ifdef DISTRIBUTE
582 & lbi, ubi, lbj, ubj, 1,
n(ng), &
585 & ad_u(:,:,:,linp), &
586 & ad_v(:,:,:,linp))
587# endif
589 DO j=jstrt,jendt
590 DO i=istrp,iendt
591 ad_u(i,j,k,linp)=ad_u(i,j,k,linp)*vnormu(i,j,k,rec)
592 END DO
593 END DO
594 DO j=jstrp,jendt
595 DO i=istrt,iendt
596 ad_v(i,j,k,linp)=ad_v(i,j,k,linp)*vnormv(i,j,k,rec)
597 END DO
598 END DO
599 END DO
600
601
602
603# ifdef DISTRIBUTE
605 & lbi, ubi, lbj, ubj, 1,
n(ng), 1,
nt(ng), &
608 & ad_t(:,:,:,linp,:))
609# endif
612 DO j=jstrt,jendt
613 DO i=istrt,iendt
614 ad_t(i,j,k,linp,it)=ad_t(i,j,k,linp,it)* &
615 & vnormr(i,j,k,rec,it)
616 END DO
617 END DO
618 END DO
619 END DO
620# endif
621
622# ifdef ADJUST_BOUNDARY
623
624
625
627 DO ib=1,4
629# ifdef DISTRIBUTE
631 & lbij, ubij, &
634 & ad_zeta_obc(:,ib,ir,linp))
635# endif
636 IF (lconvolve(ib)) THEN
638 DO j=jstrt,jendt
639 ad_zeta_obc(j,ib,ir,linp)=ad_zeta_obc(j,ib,ir,linp)* &
640 & hnormrobc(j,ib)
641 END DO
643 DO i=istrt,iendt
644 ad_zeta_obc(i,ib,ir,linp)=ad_zeta_obc(i,ib,ir,linp)* &
645 & hnormrobc(i,ib)
646 END DO
647 END IF
648 END IF
649 END IF
650 END DO
651 END DO
652
653
654
656 DO ib=1,4
658# ifdef DISTRIBUTE
660 & lbij, ubij, &
663 & ad_ubar_obc(:,ib,ir,linp))
664# endif
665 IF (lconvolve(ib)) THEN
667 DO j=jstrt,jendt
668 ad_ubar_obc(j,ib,ir,linp)=ad_ubar_obc(j,ib,ir,linp)* &
669 & hnormuobc(j,ib)
670 END DO
672 DO i=istrp,iendt
673 ad_ubar_obc(i,ib,ir,linp)=ad_ubar_obc(i,ib,ir,linp)* &
674 & hnormuobc(i,ib)
675 END DO
676 END IF
677 END IF
678 END IF
679 END DO
680 END DO
681
682
683
685 DO ib=1,4
687# ifdef DISTRIBUTE
689 & lbij, ubij, &
692 & ad_vbar_obc(:,ib,ir,linp))
693# endif
694 IF (lconvolve(ib)) THEN
696 DO j=jstrp,jendt
697 ad_vbar_obc(j,ib,ir,linp)=ad_vbar_obc(j,ib,ir,linp)* &
698 & hnormvobc(j,ib)
699 END DO
701 DO i=istrt,iendt
702 ad_vbar_obc(i,ib,ir,linp)=ad_vbar_obc(i,ib,ir,linp)* &
703 & hnormvobc(i,ib)
704 END DO
705 END IF
706 END IF
707 END IF
708 END DO
709 END DO
710
711# ifdef SOLVE3D
712
713
714
716 DO ib=1,4
718# ifdef DISTRIBUTE
720 & lbij, ubij, 1,
n(ng), &
723 & ad_u_obc(:,:,ib,ir,linp))
724# endif
725 IF (lconvolve(ib)) THEN
728 DO j=jstrt,jendt
729 ad_u_obc(j,k,ib,ir,linp)=ad_u_obc(j,k,ib,ir,linp)* &
730 & vnormuobc(j,k,ib)
731 END DO
732 END DO
735 DO i=istrp,iendt
736 ad_u_obc(i,k,ib,ir,linp)=ad_u_obc(i,k,ib,ir,linp)* &
737 & vnormuobc(i,k,ib)
738 END DO
739 END DO
740 END IF
741 END IF
742 END IF
743 END DO
744 END DO
745
746
747
749 DO ib=1,4
751# ifdef DISTRIBUTE
753 & lbij, ubij, 1,
n(ng), &
756 & ad_v_obc(:,:,ib,ir,linp))
757# endif
758 IF (lconvolve(ib)) THEN
761 DO j=jstrp,jendt
762 ad_v_obc(j,k,ib,ir,linp)=ad_v_obc(j,k,ib,ir,linp)* &
763 & vnormvobc(j,k,ib)
764 END DO
765 END DO
768 DO i=istrt,iendt
769 ad_v_obc(i,k,ib,ir,linp)=ad_v_obc(i,k,ib,ir,linp)* &
770 & vnormvobc(i,k,ib)
771 END DO
772 END DO
773 END IF
774 END IF
775 END IF
776 END DO
777 END DO
778
779
780
783 DO ib=1,4
784 IF (.not.lweak.and.
lobc(ib,
istvar(it),ng))
THEN
785# ifdef DISTRIBUTE
787 & lbij, ubij, 1,
n(ng), &
790 & ad_t_obc(:,:,ib,ir,linp,it))
791# endif
792 IF (lconvolve(ib)) THEN
795 DO j=jstrt,jendt
796 ad_t_obc(j,k,ib,ir,linp,it)= &
797 & ad_t_obc(j,k,ib,ir,linp,it)* &
798 & vnormrobc(j,k,ib,it)
799 END DO
800 END DO
803 DO i=istrt,iendt
804 ad_t_obc(i,k,ib,ir,linp,it)= &
805 & ad_t_obc(i,k,ib,ir,linp,it)* &
806 & vnormrobc(i,k,ib,it)
807 END DO
808 END DO
809 END IF
810 END IF
811 END IF
812 END DO
813 END DO
814 END DO
815# endif
816# endif
817
818# ifdef ADJUST_WSTRESS
819
820
821
822 IF (.not.lweak) THEN
823# ifdef DISTRIBUTE
825 & lbi, ubi, lbj, ubj, 1,
nfrec(ng), &
828 & ad_ustr(:,:,:,linp), &
829 & ad_vstr(:,:,:,linp))
830# endif
832 DO j=jstrt,jendt
833 DO i=istrp,iendt
834 ad_ustr(i,j,k,linp)=ad_ustr(i,j,k,linp)*hnormsus(i,j)
835 END DO
836 END DO
837 DO j=jstrp,jendt
838 DO i=istrt,iendt
839 ad_vstr(i,j,k,linp)=ad_vstr(i,j,k,linp)*hnormsvs(i,j)
840 END DO
841 END DO
842 END DO
843 END IF
844# endif
845# ifdef ADJUST_STFLUX
846
847
848
849 IF (.not.lweak) THEN
852# ifdef DISTRIBUTE
854 & lbi, ubi, lbj, ubj, 1,
nfrec(ng), &
857 & ad_tflux(:,:,:,linp,it))
858# endif
860 DO j=jstrt,jendt
861 DO i=istrt,iendt
862 ad_tflux(i,j,k,linp,it)=ad_tflux(i,j,k,linp,it)* &
863 & hnormstf(i,j,it)
864 END DO
865 END DO
866 END DO
867 END IF
868 END DO
869 END IF
870# endif
871
872
873
874
875
876
877
878
879
880
882 & lbi, ubi, lbj, ubj, &
883 & imins, imaxs, jmins, jmaxs, &
887 & kh, &
888 & pm, pn, pmon_u, pnom_v, &
889# ifdef MASKING
890 & rmask, umask, vmask, &
891# endif
892 & ad_zeta(:,:,linp))
893
894
895
897 & lbi, ubi, lbj, ubj, &
898 & imins, imaxs, jmins, jmaxs, &
902 & kh, &
903 & pm, pn, pmon_r, pnom_p, &
904# ifdef MASKING
905 & umask, pmask, &
906# endif
907 & ad_ubar(:,:,linp))
908
910 & lbi, ubi, lbj, ubj, &
911 & imins, imaxs, jmins, jmaxs, &
915 & kh, &
916 & pm, pn, pmon_p, pnom_r, &
917# ifdef MASKING
918 & vmask, pmask, &
919# endif
920 & ad_vbar(:,:,linp))
921# ifdef SOLVE3D
922
923
924
926 & lbi, ubi, lbj, ubj, 1,
n(ng), &
927 & imins, imaxs, jmins, jmaxs, &
933 & kh, kv, &
934 & pm, pn, &
935# ifdef GEOPOTENTIAL_HCONV
936 & on_r, om_p, &
937# else
938 & pmon_r, pnom_p, &
939# endif
940# ifdef MASKING
941# ifdef GEOPOTENTIAL_HCONV
942 & pmask, rmask, umask, vmask, &
943# else
944 & umask, pmask, &
945# endif
946# endif
947 & hz, z_r, &
948 & ad_u(:,:,:,linp))
949
951 & lbi, ubi, lbj, ubj, 1,
n(ng), &
952 & imins, imaxs, jmins, jmaxs, &
958 & kh, kv, &
959 & pm, pn, &
960# ifdef GEOPOTENTIAL_HCONV
961 & on_p, om_r, &
962# else
963 & pmon_p, pnom_r, &
964# endif
965# ifdef MASKING
966# ifdef GEOPOTENTIAL_HCONV
967 & pmask, rmask, umask, vmask, &
968# else
969 & vmask, pmask, &
970# endif
971# endif
972 & hz, z_r, &
973 & ad_v(:,:,:,linp))
974
975
976
980 & lbi, ubi, lbj, ubj, 1,
n(ng), &
981 & imins, imaxs, jmins, jmaxs, &
987 & kh, kv, &
988 & pm, pn, &
989# ifdef GEOPOTENTIAL_HCONV
990 & on_u, om_v, &
991# else
992 & pmon_u, pnom_v, &
993# endif
994# ifdef MASKING
995 & rmask, umask, vmask, &
996# endif
997 & hz, z_r, &
998 & ad_t(:,:,:,linp,it))
999 END DO
1000# endif
1001
1002# ifdef ADJUST_BOUNDARY
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1014 DO ib=1,4
1018 & lbij, ubij, &
1019 & lbi, ubi, lbj, ubj, &
1020 & imins, imaxs, jmins, jmaxs, &
1024 & kh, &
1025 & pm, pn, pmon_u, pnom_v, &
1026# ifdef MASKING
1027 & rmask, umask, vmask, &
1028# endif
1029 & ad_zeta_obc(:,ib,ir,linp))
1030 END IF
1031 END DO
1032 END DO
1033
1034
1035
1037 DO ib=1,4
1041 & lbij, ubij, &
1042 & lbi, ubi, lbj, ubj, &
1043 & imins, imaxs, jmins, jmaxs, &
1047 & kh, &
1048 & pm, pn, pmon_r, pnom_p, &
1049# ifdef MASKING
1050 & umask, pmask, &
1051# endif
1052 & ad_ubar_obc(:,ib,ir,linp))
1053 END IF
1054 END DO
1055 END DO
1056
1057
1058
1060 DO ib=1,4
1064 & lbij, ubij, &
1065 & lbi, ubi, lbj, ubj, &
1066 & imins, imaxs, jmins, jmaxs, &
1070 & kh, &
1071 & pm, pn, pmon_p, pnom_r, &
1072# ifdef MASKING
1073 & vmask, pmask, &
1074# endif
1075 & ad_vbar_obc(:,ib,ir,linp))
1076 END IF
1077 END DO
1078 END DO
1079
1080# ifdef SOLVE3D
1081
1082
1083
1085 DO ib=1,4
1089 & lbij, ubij, &
1090 & lbi, ubi, lbj, ubj, 1,
n(ng), &
1091 & imins, imaxs, jmins, jmaxs, &
1097 & kh, kv, &
1098 & pm, pn, pmon_r, pnom_p, &
1099# ifdef MASKING
1100 & umask, pmask, &
1101# endif
1102 & hz, z_r, &
1103 & ad_u_obc(:,:,ib,ir,linp))
1104 END IF
1105 END DO
1106 END DO
1107
1108
1109
1111 DO ib=1,4
1115 & lbij, ubij, &
1116 & lbi, ubi, lbj, ubj, 1,
n(ng), &
1117 & imins, imaxs, jmins, jmaxs, &
1123 & kh, kv, &
1124 & pm, pn, pmon_p, pnom_r, &
1125# ifdef MASKING
1126 & vmask, pmask, &
1127# endif
1128 & hz, z_r, &
1129 & ad_v_obc(:,:,ib,ir,linp))
1130 END IF
1131 END DO
1132 END DO
1133
1134
1135
1139 DO ib=1,4
1140 IF (.not.lweak.and.
lobc(ib,is,ng))
THEN
1143 & lbij, ubij, &
1144 & lbi, ubi, lbj, ubj, 1,
n(ng), &
1145 & imins, imaxs, jmins, jmaxs, &
1151 & kh, kv, &
1152 & pm, pn, pmon_u, pnom_v, &
1153# ifdef MASKING
1154 & rmask, umask, vmask, &
1155# endif
1156 & hz, z_r, &
1157 & ad_t_obc(:,:,ib,ir,linp,it))
1158 END IF
1159 END DO
1160 END DO
1161 END DO
1162# endif
1163# endif
1164
1165# if defined ADJUST_WSTRESS || defined ADJUST_STFLUX
1166
1167
1168
1169
1170
1171
1172
1173
1174# ifdef ADJUST_WSTRESS
1175
1176
1177
1178 IF (.not.lweak) THEN
1181 & lbi, ubi, lbj, ubj, &
1182 & imins, imaxs, jmins, jmaxs, &
1186 & kh, &
1187 & pm, pn, pmon_r, pnom_p, &
1188# ifdef MASKING
1189 & umask, pmask, &
1190# endif
1191 & ad_ustr(:,:,k,linp))
1192
1194 & lbi, ubi, lbj, ubj, &
1195 & imins, imaxs, jmins, jmaxs, &
1199 & kh, &
1200 & pm, pn, pmon_p, pnom_r, &
1201# ifdef MASKING
1202 & vmask, pmask, &
1203# endif
1204 & ad_vstr(:,:,k,linp))
1205 END DO
1206 END IF
1207# endif
1208# if defined ADJUST_STFLUX && defined SOLVE3D
1209
1210
1211
1212 IF (.not.lweak) THEN
1218 & lbi, ubi, lbj, ubj, &
1219 & imins, imaxs, jmins, jmaxs, &
1223 & kh, &
1224 & pm, pn, pmon_u, pnom_v, &
1225# ifdef MASKING
1226 & rmask, umask, vmask, &
1227# endif
1228 & ad_tflux(:,:,k,linp,it))
1229 END DO
1230 END IF
1231 END DO
1232 END IF
1233# endif
1234# endif
1235
1236
1237
1238
1239
1240
1241
1242
1243# ifdef DISTRIBUTE
1245 & lbi, ubi, lbj, ubj, &
1248 & ad_zeta(:,:,linp), &
1249 & ad_ubar(:,:,linp), &
1250 & ad_vbar(:,:,linp))
1251# endif
1252 DO j=jstrt,jendt
1253 DO i=istrt,iendt
1254 ad_zeta(i,j,linp)=ad_zeta(i,j,linp)/ &
1255 & sqrt(om_r(i,j)*on_r(i,j))
1256 END DO
1257 END DO
1258
1259
1260
1261 DO j=jstrt,jendt
1262 DO i=istrp,iendt
1263 ad_ubar(i,j,linp)=ad_ubar(i,j,linp)/ &
1264 & sqrt(om_u(i,j)*on_u(i,j))
1265 END DO
1266 END DO
1267 DO j=jstrp,jendt
1268 DO i=istrt,iendt
1269 ad_vbar(i,j,linp)=ad_vbar(i,j,linp)/ &
1270 & sqrt(om_v(i,j)*on_v(i,j))
1271 END DO
1272 END DO
1273# ifdef SOLVE3D
1274
1275
1276
1277# ifdef DISTRIBUTE
1279 & lbi, ubi, lbj, ubj, 1,
n(ng), &
1282 & ad_u(:,:,:,linp), &
1283 & ad_v(:,:,:,linp))
1284# endif
1285 DO j=jstrt,jendt
1286 DO i=istrp,iendt
1287 cff=om_u(i,j)*on_u(i,j)*0.5_r8
1289 ad_u(i,j,k,linp)=ad_u(i,j,k,linp)/ &
1290 & sqrt(cff*(hz(i-1,j,k)+hz(i,j,k)))
1291 END DO
1292 END DO
1293 END DO
1294 DO j=jstrp,jendt
1295 DO i=istrt,iendt
1296 cff=om_v(i,j)*on_v(i,j)*0.5_r8
1298 ad_v(i,j,k,linp)=ad_v(i,j,k,linp)/ &
1299 & sqrt(cff*(hz(i,j-1,k)+hz(i,j,k)))
1300 END DO
1301 END DO
1302 END DO
1303
1304
1305
1306# ifdef DISTRIBUTE
1308 & lbi, ubi, lbj, ubj, 1,
n(ng), 1,
nt(ng), &
1311 & ad_t(:,:,:,linp,:))
1312# endif
1313 DO j=jstrt,jendt
1314 DO i=istrt,iendt
1315 cff=om_r(i,j)*on_r(i,j)
1317 fac=1.0_r8/sqrt(cff*hz(i,j,k))
1319 ad_t(i,j,k,linp,it)=fac*ad_t(i,j,k,linp,it)
1320 END DO
1321 END DO
1322 END DO
1323 END DO
1324# endif
1325
1326# ifdef ADJUST_BOUNDARY
1327
1328
1329
1331 DO ib=1,4
1333# ifdef DISTRIBUTE
1335 & lbij, ubij, &
1338 & ad_zeta_obc(:,ib,ir,linp))
1339# endif
1340 IF (lconvolve(ib)) THEN
1343 DO j=jstrt,jendt
1344 ad_zeta_obc(j,ib,ir,linp)=ad_zeta_obc(j,ib,ir,linp)/ &
1345 & sqrt(on_r(i,j))
1346 END DO
1349 DO i=istrt,iendt
1350 ad_zeta_obc(i,ib,ir,linp)=ad_zeta_obc(i,ib,ir,linp)/ &
1351 & sqrt(om_r(i,j))
1352 END DO
1353 END IF
1354 END IF
1355 END IF
1356 END DO
1357 END DO
1358
1359
1360
1362 DO ib=1,4
1364# ifdef DISTRIBUTE
1366 & lbij, ubij, &
1369 & ad_ubar_obc(:,ib,ir,linp))
1370# endif
1371 IF (lconvolve(ib)) THEN
1374 DO j=jstrt,jendt
1375 ad_ubar_obc(j,ib,ir,linp)=ad_ubar_obc(j,ib,ir,linp)/ &
1376 & sqrt(on_u(i,j))
1377 END DO
1380 DO i=istrp,iendt
1381 ad_ubar_obc(i,ib,ir,linp)=ad_ubar_obc(i,ib,ir,linp)/ &
1382 & sqrt(om_u(i,j))
1383 END DO
1384 END IF
1385 END IF
1386 END IF
1387 END DO
1388 END DO
1389
1390
1391
1393 DO ib=1,4
1395# ifdef DISTRIBUTE
1397 & lbij, ubij, &
1400 & ad_vbar_obc(:,ib,ir,linp))
1401# endif
1402 IF (lconvolve(ib)) THEN
1405 DO j=jstrp,jendt
1406 ad_vbar_obc(j,ib,ir,linp)=ad_vbar_obc(j,ib,ir,linp)/ &
1407 & sqrt(on_v(i,j))
1408 END DO
1411 DO i=istrt,iendt
1412 ad_vbar_obc(i,ib,ir,linp)=ad_vbar_obc(i,ib,ir,linp)/ &
1413 & sqrt(om_v(i,j))
1414 END DO
1415 END IF
1416 END IF
1417 END IF
1418 END DO
1419 END DO
1420
1421# ifdef SOLVE3D
1422
1423
1424
1426 DO ib=1,4
1428# ifdef DISTRIBUTE
1430 & lbij, ubij, 1,
n(ng), &
1433 & ad_u_obc(:,:,ib,ir,linp))
1434# endif
1435 IF (lconvolve(ib)) THEN
1438 DO j=jstrt,jendt
1439 cff=on_u(i,j)*0.5_r8
1441 ad_u_obc(j,k,ib,ir,linp)=ad_u_obc(j,k,ib,ir,linp)/ &
1442 & sqrt(cff* &
1443 & (hz(i-1,j,k)+ &
1444 & hz(i ,j,k)))
1445 END DO
1446 END DO
1449 DO i=istrp,iendt
1450 cff=om_u(i,j)*0.5_r8
1452 ad_u_obc(i,k,ib,ir,linp)=ad_u_obc(i,k,ib,ir,linp)/ &
1453 & sqrt(cff* &
1454 & (hz(i-1,j,k)+ &
1455 & hz(i ,j,k)))
1456 END DO
1457 END DO
1458 END IF
1459 END IF
1460 END IF
1461 END DO
1462 END DO
1463
1464
1465
1467 DO ib=1,4
1469# ifdef DISTRIBUTE
1471 & lbij, ubij, 1,
n(ng), &
1474 & ad_v_obc(:,:,ib,ir,linp))
1475# endif
1476 IF (lconvolve(ib)) THEN
1479 DO j=jstrp,jendt
1480 cff=on_v(i,j)*0.5_r8
1482 ad_v_obc(j,k,ib,ir,linp)=ad_v_obc(j,k,ib,ir,linp)/ &
1483 & sqrt(cff* &
1484 & (hz(i,j-1,k)+ &
1485 & hz(i,j ,k)))
1486 END DO
1487 END DO
1490 DO i=istrt,iendt
1491 cff=om_v(i,j)*0.5_r8
1493 ad_v_obc(i,k,ib,ir,linp)=ad_v_obc(i,k,ib,ir,linp)/ &
1494 & sqrt(cff* &
1495 & (hz(i,j-1,k)+ &
1496 & hz(i,j ,k)))
1497 END DO
1498 END DO
1499 END IF
1500 END IF
1501 END IF
1502 END DO
1503 END DO
1504
1505
1506
1509 DO ib=1,4
1510 IF (.not.lweak.and.
lobc(ib,
istvar(it),ng))
THEN
1511# ifdef DISTRIBUTE
1513 & lbij, ubij, 1,
n(ng), &
1516 & ad_t_obc(:,:,ib,ir,linp,it))
1517# endif
1518 IF (lconvolve(ib)) THEN
1521 DO j=jstrt,jendt
1522 cff=on_r(i,j)
1524 ad_t_obc(j,k,ib,ir,linp,it)= &
1525 & ad_t_obc(j,k,ib,ir,linp,it)/ &
1526 & sqrt(cff*hz(i,j,k))
1527 END DO
1528 END DO
1531 DO i=istrt,iendt
1532 cff=om_r(i,j)
1534 ad_t_obc(i,k,ib,ir,linp,it)= &
1535 & ad_t_obc(i,k,ib,ir,linp,it)/ &
1536 & sqrt(cff*hz(i,j,k))
1537 END DO
1538 END DO
1539 END IF
1540 END IF
1541 END IF
1542 END DO
1543 END DO
1544 END DO
1545# endif
1546# endif
1547
1548# ifdef ADJUST_WSTRESS
1549
1550
1551
1552 IF (.not.lweak) THEN
1553# ifdef DISTRIBUTE
1555 & lbi, ubi, lbj, ubj, 1,
nfrec(ng), &
1558 & ad_ustr(:,:,:,linp), &
1559 & ad_vstr(:,:,:,linp))
1560# endif
1562 DO j=jstrt,jendt
1563 DO i=istrp,iendt
1564 ad_ustr(i,j,k,linp)=ad_ustr(i,j,k,linp)/ &
1565 & sqrt(om_u(i,j)*on_u(i,j))
1566 END DO
1567 END DO
1568 DO j=jstrp,jendt
1569 DO i=istrt,iendt
1570 ad_vstr(i,j,k,linp)=ad_vstr(i,j,k,linp)/ &
1571 & sqrt(om_v(i,j)*on_v(i,j))
1572 END DO
1573 END DO
1574 END DO
1575 END IF
1576# endif
1577
1578# if defined ADJUST_STFLUX && defined SOLVE3D
1579
1580
1581
1582 IF (.not.lweak) THEN
1583# ifdef DISTRIBUTE
1587 & lbi, ubi, lbj, ubj, 1,
nfrec(ng), &
1590 & ad_tflux(:,:,:,linp,it))
1591 END IF
1592 END DO
1593# endif
1594 DO j=jstrt,jendt
1595 DO i=istrt,iendt
1596 fac=1.0_r8/sqrt(om_r(i,j)*on_r(i,j))
1600 ad_tflux(i,j,k,linp,it)=fac*ad_tflux(i,j,k,linp,it)
1601 END DO
1602 END IF
1603 END DO
1604 END DO
1605 END DO
1606 END IF
1607# endif
1608
1609 RETURN
subroutine ad_conv_u2d_tile(ng, tile, model, lbi, ubi, lbj, ubj, imins, imaxs, jmins, jmaxs, nghost, nhsteps, dtsizeh, kh, pm, pn, pmon_r, pnom_p, umask, pmask, ad_a)
subroutine ad_conv_r2d_tile(ng, tile, model, lbi, ubi, lbj, ubj, imins, imaxs, jmins, jmaxs, nghost, nhsteps, dtsizeh, kh, pm, pn, pmon_u, pnom_v, rmask, umask, vmask, ad_a)
subroutine ad_conv_v2d_tile(ng, tile, model, lbi, ubi, lbj, ubj, imins, imaxs, jmins, jmaxs, nghost, nhsteps, dtsizeh, kh, pm, pn, pmon_p, pnom_r, vmask, pmask, ad_a)
subroutine ad_conv_v3d_tile(ng, tile, model, lbi, ubi, lbj, ubj, lbk, ubk, imins, imaxs, jmins, jmaxs, nghost, nhsteps, nvsteps, dtsizeh, dtsizev, kh, kv, pm, pn, on_p, om_r, pmask, rmask, umask, vmask, hz, z_r, ad_a)
subroutine ad_conv_u3d_tile(ng, tile, model, lbi, ubi, lbj, ubj, lbk, ubk, imins, imaxs, jmins, jmaxs, nghost, nhsteps, nvsteps, dtsizeh, dtsizev, kh, kv, pm, pn, on_r, om_p, pmask, rmask, umask, vmask, hz, z_r, ad_a)
subroutine ad_conv_r3d_tile(ng, tile, model, lbi, ubi, lbj, ubj, lbk, ubk, imins, imaxs, jmins, jmaxs, nghost, nhsteps, nvsteps, dtsizeh, dtsizev, kh, kv, pm, pn, on_u, om_v, rmask, umask, vmask, hz, z_r, ad_a)
subroutine ad_conv_v2d_bry_tile(ng, tile, model, boundary, edge, lbij, ubij, lbi, ubi, lbj, ubj, imins, imaxs, jmins, jmaxs, nghost, nhsteps, dtsizeh, kh, pm, pn, pmon_p, pnom_r, vmask, pmask, ad_a)
subroutine ad_conv_u2d_bry_tile(ng, tile, model, boundary, edge, lbij, ubij, lbi, ubi, lbj, ubj, imins, imaxs, jmins, jmaxs, nghost, nhsteps, dtsizeh, kh, pm, pn, pmon_r, pnom_p, umask, pmask, ad_a)
subroutine ad_conv_r2d_bry_tile(ng, tile, model, boundary, edge, lbij, ubij, lbi, ubi, lbj, ubj, imins, imaxs, jmins, jmaxs, nghost, nhsteps, dtsizeh, kh, pm, pn, pmon_u, pnom_v, rmask, umask, vmask, ad_a)
subroutine ad_conv_r3d_bry_tile(ng, tile, model, boundary, edge, lbij, ubij, lbi, ubi, lbj, ubj, lbk, ubk, imins, imaxs, jmins, jmaxs, nghost, nhsteps, nvsteps, dtsizeh, dtsizev, kh, kv, pm, pn, pmon_u, pnom_v, rmask, umask, vmask, hz, z_r, ad_a)
subroutine ad_conv_u3d_bry_tile(ng, tile, model, boundary, edge, lbij, ubij, lbi, ubi, lbj, ubj, lbk, ubk, imins, imaxs, jmins, jmaxs, nghost, nhsteps, nvsteps, dtsizeh, dtsizev, kh, kv, pm, pn, pmon_r, pnom_p, umask, pmask, hz, z_r, ad_a)
subroutine ad_conv_v3d_bry_tile(ng, tile, model, boundary, edge, lbij, ubij, lbi, ubi, lbj, ubj, lbk, ubk, imins, imaxs, jmins, jmaxs, nghost, nhsteps, nvsteps, dtsizeh, dtsizev, kh, kv, pm, pn, pmon_p, pnom_r, vmask, pmask, hz, z_r, ad_a)
integer, dimension(:,:), allocatable nhsteps
integer, dimension(:,:), allocatable nvsteps
real(r8), dimension(:,:), allocatable dtsizehb
real(r8), dimension(:,:), allocatable dtsizeh
integer, dimension(:,:), allocatable nvstepsb
real(r8), dimension(:,:), allocatable dtsizevb
real(r8), dimension(:,:), allocatable dtsizev
integer, dimension(:,:), allocatable nhstepsb
integer, dimension(:), allocatable istvar
integer, dimension(:), allocatable istsur
integer, dimension(:), allocatable n
type(t_bounds), dimension(:), allocatable bounds
type(t_domain), dimension(:), allocatable domain
integer, parameter u2dvar
integer, dimension(:), allocatable nt
integer, parameter r2dvar
integer, parameter v2dvar
logical, dimension(:,:,:), allocatable lobc
logical, dimension(:), allocatable ewperiodic
logical, dimension(:), allocatable nsperiodic
logical, dimension(:,:), allocatable lstflux
integer, dimension(:), allocatable nfrec
integer, parameter isouth
integer, parameter inorth
integer, dimension(:), allocatable nbrec
subroutine ad_mp_exchange3d(ng, tile, model, nvar, lbi, ubi, lbj, ubj, lbk, ubk, nghost, ew_periodic, ns_periodic, ad_a, ad_b, ad_c, ad_d)
subroutine ad_mp_exchange4d(ng, tile, model, nvar, lbi, ubi, lbj, ubj, lbk, ubk, lbt, ubt, nghost, ew_periodic, ns_periodic, ad_a, ad_b, ad_c)
subroutine ad_mp_exchange2d(ng, tile, model, nvar, lbi, ubi, lbj, ubj, nghost, ew_periodic, ns_periodic, ad_a, ad_b, ad_c, ad_d)
subroutine ad_mp_exchange3d_bry(ng, tile, model, nvar, boundary, lbij, ubij, lbk, ubk, nghost, ew_periodic, ns_periodic, ad_a, ad_b, ad_c, ad_d)
subroutine ad_mp_exchange2d_bry(ng, tile, model, nvar, boundary, lbij, ubij, nghost, ew_periodic, ns_periodic, ad_a, ad_b, ad_c, ad_d)
subroutine, public set_depth_tile(ng, tile, model, lbi, ubi, lbj, ubj, imins, imaxs, jmins, jmaxs, nstp, nnew, h, zice, zt_avg1, hz, z_r, z_w)