268
269
274
276# ifdef SOLVE3D
278# endif
279# ifdef ADJUST_BOUNDARY
281# ifdef SOLVE3D
283# endif
284# endif
285# ifdef DISTRIBUTE
287# endif
289
290
291
292 logical, intent(in) :: Lweak
293
294 integer, intent(in) :: ng, tile
295 integer, intent(in) :: LBi, UBi, LBj, UBj, LBij, UBij
296 integer, intent(in) :: IminS, ImaxS, JminS, JmaxS
297 integer, intent(in) :: nstp, nnew, Linp, ifac
298
299# ifdef ASSUMED_SHAPE
300 real(r8), intent(in) :: pm(LBi:,LBj:)
301 real(r8), intent(in) :: om_p(LBi:,LBj:)
302 real(r8), intent(in) :: om_r(LBi:,LBj:)
303 real(r8), intent(in) :: om_u(LBi:,LBj:)
304 real(r8), intent(in) :: om_v(LBi:,LBj:)
305 real(r8), intent(in) :: pn(LBi:,LBj:)
306 real(r8), intent(in) :: on_p(LBi:,LBj:)
307 real(r8), intent(in) :: on_r(LBi:,LBj:)
308 real(r8), intent(in) :: on_u(LBi:,LBj:)
309 real(r8), intent(in) :: on_v(LBi:,LBj:)
310 real(r8), intent(in) :: pmon_p(LBi:,LBj:)
311 real(r8), intent(in) :: pmon_r(LBi:,LBj:)
312 real(r8), intent(in) :: pmon_u(LBi:,LBj:)
313 real(r8), intent(in) :: pnom_p(LBi:,LBj:)
314 real(r8), intent(in) :: pnom_r(LBi:,LBj:)
315 real(r8), intent(in) :: pnom_v(LBi:,LBj:)
316# ifdef MASKING
317 real(r8), intent(in) :: rmask(LBi:,LBj:)
318 real(r8), intent(in) :: pmask(LBi:,LBj:)
319 real(r8), intent(in) :: umask(LBi:,LBj:)
320 real(r8), intent(in) :: vmask(LBi:,LBj:)
321# endif
322 real(r8), intent(in) :: Kh(LBi:,LBj:)
323# ifdef SOLVE3D
324 real(r8), intent(in) :: Kv(LBi:,LBj:,0:)
325# ifdef ICESHELF
326 real(r8), intent(in) :: zice(LBi:,LBj:)
327# endif
328# if defined SEDIMENT && defined SED_MORPH
329 real(r8), intent(inout):: bed_thick(LBi:,LBj:,:)
330# endif
331 real(r8), intent(inout) :: h(LBi:,LBj:)
332# endif
333# ifdef ADJUST_BOUNDARY
334# ifdef SOLVE3D
335 real(r8), intent (in) :: VnormRobc(LBij:,:,:,:)
336 real(r8), intent (in) :: VnormUobc(LBij:,:,:)
337 real(r8), intent (in) :: VnormVobc(LBij:,:,:)
338# endif
339 real(r8), intent (in) :: HnormRobc(LBij:,:)
340 real(r8), intent (in) :: HnormUobc(LBij:,:)
341 real(r8), intent (in) :: HnormVobc(LBij:,:)
342# endif
343# ifdef ADJUST_WSTRESS
344 real(r8), intent(in) :: HnormSUS(LBi:,LBj:)
345 real(r8), intent(in) :: HnormSVS(LBi:,LBj:)
346# endif
347# if defined ADJUST_STFLUX && defined SOLVE3D
348 real(r8), intent(in) :: HnormSTF(LBi:,LBj:,:)
349# endif
350# ifdef SOLVE3D
351 real(r8), intent(in) :: VnormR(LBi:,LBj:,:,:,:)
352 real(r8), intent(in) :: VnormU(LBi:,LBj:,:,:)
353 real(r8), intent(in) :: VnormV(LBi:,LBj:,:,:)
354# endif
355 real(r8), intent(in) :: HnormR(LBi:,LBj:,:)
356 real(r8), intent(in) :: HnormU(LBi:,LBj:,:)
357 real(r8), intent(in) :: HnormV(LBi:,LBj:,:)
358# ifdef ADJUST_BOUNDARY
359# ifdef SOLVE3D
360 real(r8), intent(inout) :: tl_t_obc(LBij:,:,:,:,:,:)
361 real(r8), intent(inout) :: tl_u_obc(LBij:,:,:,:,:)
362 real(r8), intent(inout) :: tl_v_obc(LBij:,:,:,:,:)
363# endif
364 real(r8), intent(inout) :: tl_ubar_obc(LBij:,:,:,:)
365 real(r8), intent(inout) :: tl_vbar_obc(LBij:,:,:,:)
366 real(r8), intent(inout) :: tl_zeta_obc(LBij:,:,:,:)
367# endif
368# ifdef ADJUST_WSTRESS
369 real(r8), intent(inout) :: tl_ustr(LBi:,LBj:,:,:)
370 real(r8), intent(inout) :: tl_vstr(LBi:,LBj:,:,:)
371# endif
372# if defined ADJUST_STFLUX && defined SOLVE3D
373 real(r8), intent(inout) :: tl_tflux(LBi:,LBj:,:,:,:)
374# endif
375# ifdef SOLVE3D
376 real(r8), intent(inout) :: tl_t(LBi:,LBj:,:,:,:)
377 real(r8), intent(inout) :: tl_u(LBi:,LBj:,:,:)
378 real(r8), intent(inout) :: tl_v(LBi:,LBj:,:,:)
379# endif
380 real(r8), intent(inout) :: tl_ubar(LBi:,LBj:,:)
381 real(r8), intent(inout) :: tl_vbar(LBi:,LBj:,:)
382 real(r8), intent(inout) :: tl_zeta(LBi:,LBj:,:)
383# ifdef SOLVE3D
384 real(r8), intent(out) :: Hz(LBi:,LBj:,:)
385 real(r8), intent(out) :: z_r(LBi:,LBj:,:)
386 real(r8), intent(out) :: z_w(LBi:,LBj:,0:)
387# endif
388# else
389 real(r8), intent(in) :: pm(LBi:UBi,LBj:UBj)
390 real(r8), intent(in) :: om_p(LBi:UBi,LBj:UBj)
391 real(r8), intent(in) :: om_r(LBi:UBi,LBj:UBj)
392 real(r8), intent(in) :: om_u(LBi:UBi,LBj:UBj)
393 real(r8), intent(in) :: om_v(LBi:UBi,LBj:UBj)
394 real(r8), intent(in) :: pn(LBi:UBi,LBj:UBj)
395 real(r8), intent(in) :: on_p(LBi:UBi,LBj:UBj)
396 real(r8), intent(in) :: on_r(LBi:UBi,LBj:UBj)
397 real(r8), intent(in) :: on_u(LBi:UBi,LBj:UBj)
398 real(r8), intent(in) :: on_v(LBi:UBi,LBj:UBj)
399 real(r8), intent(in) :: pmon_p(LBi:UBi,LBj:UBj)
400 real(r8), intent(in) :: pmon_r(LBi:UBi,LBj:UBj)
401 real(r8), intent(in) :: pmon_u(LBi:UBi,LBj:UBj)
402 real(r8), intent(in) :: pnom_p(LBi:UBi,LBj:UBj)
403 real(r8), intent(in) :: pnom_r(LBi:UBi,LBj:UBj)
404 real(r8), intent(in) :: pnom_v(LBi:UBi,LBj:UBj)
405# ifdef MASKING
406 real(r8), intent(in) :: rmask(LBi:UBi,LBj:UBj)
407 real(r8), intent(in) :: pmask(LBi:UBi,LBj:UBj)
408 real(r8), intent(in) :: umask(LBi:UBi,LBj:UBj)
409 real(r8), intent(in) :: vmask(LBi:UBi,LBj:UBj)
410# endif
411 real(r8), intent(in) :: Kh(LBi:UBi,LBj:UBj)
412# ifdef SOLVE3D
413 real(r8), intent(in) :: Kv(LBi:UBi,LBj:UBj,0:N(ng))
414# ifdef ICESHELF
415 real(r8), intent(in) :: zice(LBi:UBi,LBj:UBj)
416# endif
417# if defined SEDIMENT && defined SED_MORPH
418 real(r8), intent(inout):: bed_thick(LBi:UBi,LBj:UBj,:)
419# endif
420 real(r8), intent(inout) :: h(LBi:UBi,LBj:UBj)
421# endif
422# ifdef ADJUST_BOUNDARY
423# ifdef SOLVE3D
424 real(r8), intent (in) :: VnormRobc(LBij:UBij,N(ng),4,NT(ng))
425 real(r8), intent (in) :: VnormUobc(LBij:UBij,N(ng),4)
426 real(r8), intent (in) :: VnormVobc(LBij:UBij,N(ng),4)
427# endif
428 real(r8), intent (in) :: HnormRobc(LBij:UBij,4)
429 real(r8), intent (in) :: HnormUobc(LBij:UBij,4)
430 real(r8), intent (in) :: HnormVobc(LBij:UBij,4)
431# endif
432# ifdef ADJUST_WSTRESS
433 real(r8), intent(in) :: HnormSUS(LBi:UBi,LBj:UBj)
434 real(r8), intent(in) :: HnormSVS(LBi:UBi,LBj:UBj)
435# endif
436# if defined ADJUST_STFLUX && defined SOLVE3D
437 real(r8), intent(in) :: HnormSTF(LBi:UBi,LBj:UBj,NT(ng))
438# endif
439# ifdef SOLVE3D
440 real(r8), intent(in) :: VnormR(LBi:UBi,LBj:UBj,N(ng),NSA,NT(ng))
441 real(r8), intent(in) :: VnormU(LBi:UBi,LBj:UBj,NSA,N(ng))
442 real(r8), intent(in) :: VnormV(LBi:UBi,LBj:UBj,NSA,N(ng))
443# endif
444 real(r8), intent(in) :: HnormR(LBi:UBi,LBj:UBj,NSA)
445 real(r8), intent(in) :: HnormU(LBi:UBi,LBj:UBj,NSA)
446 real(r8), intent(in) :: HnormV(LBi:UBi,LBj:UBj,NSA)
447# ifdef ADJUST_BOUNDARY
448# ifdef SOLVE3D
449 real(r8), intent(inout) :: tl_t_obc(LBij:UBij,N(ng),4, &
450 & Nbrec(ng),2,NT(ng))
451 real(r8), intent(inout) :: tl_u_obc(LBij:UBij,N(ng),4,Nbrec(ng),2)
452 real(r8), intent(inout) :: tl_v_obc(LBij:UBij,N(ng),4,Nbrec(ng),2)
453# endif
454 real(r8), intent(inout) :: tl_ubar_obc(LBij:UBij,4,Nbrec(ng),2)
455 real(r8), intent(inout) :: tl_vbar_obc(LBij:UBij,4,Nbrec(ng),2)
456 real(r8), intent(inout) :: tl_zeta_obc(LBij:UBij,4,Nbrec(ng),2)
457# endif
458# ifdef ADJUST_WSTRESS
459 real(r8), intent(inout) :: tl_ustr(LBi:UBi,LBj:UBj,Nfrec(ng),2)
460 real(r8), intent(inout) :: tl_vstr(LBi:UBi,LBj:UBj,Nfrec(ng),2)
461# endif
462# if defined ADJUST_STFLUX && defined SOLVE3D
463 real(r8), intent(inout) :: tl_tflux(LBi:UBi,LBj:UBj, &
464 & Nfrec(ng),2,NT(ng))
465# endif
466# ifdef SOLVE3D
467 real(r8), intent(inout) :: tl_t(LBi:UBi,LBj:UBj,N(ng),3,NT(ng))
468 real(r8), intent(inout) :: tl_u(LBi:UBi,LBj:UBj,N(ng),2)
469 real(r8), intent(inout) :: tl_v(LBi:UBi,LBj:UBj,N(ng),2)
470# endif
471 real(r8), intent(inout) :: tl_ubar(LBi:UBi,LBj:UBj,:)
472 real(r8), intent(inout) :: tl_vbar(LBi:UBi,LBj:UBj,:)
473 real(r8), intent(inout) :: tl_zeta(LBi:UBi,LBj:UBj,:)
474# ifdef SOLVE3D
475 real(r8), intent(out) :: Hz(LBi:UBi,LBj:UBj,N(ng))
476 real(r8), intent(out) :: z_r(LBi:UBi,LBj:UBj,N(ng))
477 real(r8), intent(out) :: z_w(LBi:UBi,LBj:UBj,0:N(ng))
478# endif
479# endif
480
481
482
483# ifdef ADJUST_BOUNDARY
484 logical, dimension(4) :: Lconvolve
485# endif
486 integer :: i, ib, ir, is, it, j, k, rec
487 real(r8) :: cff
488# ifdef SOLVE3D
489 real(r8) :: fac
490# endif
491# ifdef SOLVE3D
492 real(r8), dimension(LBi:UBi,LBj:UBj) :: work
493# endif
494
495# include "set_bounds.h"
496
497
498
499
500
501 IF (lweak) THEN
502 rec=2
503 ELSE
504 rec=1
505 END IF
506
507# ifdef ADJUST_BOUNDARY
508
509
510
511
516# endif
517
518# ifdef SOLVE3D
519
520
521
522
523
524 DO i=lbi,ubi
525 DO j=lbj,ubj
526 work(i,j)=0.0_r8
527 END DO
528 END DO
529
531 & lbi, ubi, lbj, ubj, &
532 & imins, imaxs, jmins, jmaxs, &
533 & nstp, nnew, &
534 & h, &
535# ifdef ICESHELF
536 & zice, &
537# endif
538# if defined SEDIMENT && defined SED_MORPH
539 & bed_thick, &
540# endif
541 & work, &
542 & hz, z_r, z_w)
543# endif
544
545
546
547
548
549
550
551
552 DO j=jstrt,jendt
553 DO i=istrt,iendt
554 tl_zeta(i,j,linp)=tl_zeta(i,j,linp)/ &
555 & sqrt(om_r(i,j)*on_r(i,j))
556 END DO
557 END DO
558
559
560
561 DO j=jstrt,jendt
562 DO i=istrp,iendt
563 tl_ubar(i,j,linp)=tl_ubar(i,j,linp)/ &
564 & sqrt(om_u(i,j)*on_u(i,j))
565 END DO
566 END DO
567 DO j=jstrp,jendt
568 DO i=istrt,iendt
569 tl_vbar(i,j,linp)=tl_vbar(i,j,linp)/ &
570 & sqrt(om_v(i,j)*on_v(i,j))
571 END DO
572 END DO
573# ifdef DISTRIBUTE
575 & lbi, ubi, lbj, ubj, &
578 & tl_zeta(:,:,linp), &
579 & tl_ubar(:,:,linp), &
580 & tl_vbar(:,:,linp))
581# endif
582# ifdef SOLVE3D
583
584
585
586 DO j=jstrt,jendt
587 DO i=istrp,iendt
588 cff=om_u(i,j)*on_u(i,j)*0.5_r8
590 tl_u(i,j,k,linp)=tl_u(i,j,k,linp)/ &
591 & sqrt(cff*(hz(i-1,j,k)+hz(i,j,k)))
592 END DO
593 END DO
594 END DO
595 DO j=jstrp,jendt
596 DO i=istrt,iendt
597 cff=om_v(i,j)*on_v(i,j)*0.5_r8
599 tl_v(i,j,k,linp)=tl_v(i,j,k,linp)/ &
600 & sqrt(cff*(hz(i,j-1,k)+hz(i,j,k)))
601 END DO
602 END DO
603 END DO
604# ifdef DISTRIBUTE
606 & lbi, ubi, lbj, ubj, 1,
n(ng), &
609 & tl_u(:,:,:,linp), &
610 & tl_v(:,:,:,linp))
611# endif
612
613
614
615 DO j=jstrt,jendt
616 DO i=istrt,iendt
617 cff=om_r(i,j)*on_r(i,j)
619 fac=1.0_r8/sqrt(cff*hz(i,j,k))
621 tl_t(i,j,k,linp,it)=fac*tl_t(i,j,k,linp,it)
622 END DO
623 END DO
624 END DO
625 END DO
626# ifdef DISTRIBUTE
628 & lbi, ubi, lbj, ubj, 1,
n(ng), 1,
nt(ng), &
631 & tl_t(:,:,:,linp,:))
632# endif
633# endif
634
635# ifdef ADJUST_BOUNDARY
636
637
638
640 DO ib=1,4
642 IF (lconvolve(ib)) THEN
645 DO j=jstrt,jendt
646 tl_zeta_obc(j,ib,ir,linp)=tl_zeta_obc(j,ib,ir,linp)/ &
647 & sqrt(on_r(i,j))
648 END DO
651 DO i=istrt,iendt
652 tl_zeta_obc(i,ib,ir,linp)=tl_zeta_obc(i,ib,ir,linp)/ &
653 & sqrt(om_r(i,j))
654
655 END DO
656 END IF
657 END IF
658# ifdef DISTRIBUTE
660 & lbij, ubij, &
663 & tl_zeta_obc(:,ib,ir,linp))
664# endif
665 END IF
666 END DO
667 END DO
668
669
670
672 DO ib=1,4
674 IF (lconvolve(ib)) THEN
677 DO j=jstrt,jendt
678 tl_ubar_obc(j,ib,ir,linp)=tl_ubar_obc(j,ib,ir,linp)/ &
679 & sqrt(on_u(i,j))
680 END DO
683 DO i=istrp,iendt
684 tl_ubar_obc(i,ib,ir,linp)=tl_ubar_obc(i,ib,ir,linp)/ &
685 & sqrt(om_u(i,j))
686 END DO
687 END IF
688 END IF
689# ifdef DISTRIBUTE
691 & lbij, ubij, &
694 & tl_ubar_obc(:,ib,ir,linp))
695# endif
696 END IF
697 END DO
698 END DO
699
700
701
703 DO ib=1,4
705 IF (lconvolve(ib)) THEN
708 DO j=jstrp,jendt
709 tl_vbar_obc(j,ib,ir,linp)=tl_vbar_obc(j,ib,ir,linp)/ &
710 & sqrt(on_v(i,j))
711 END DO
714 DO i=istrt,iendt
715 tl_vbar_obc(i,ib,ir,linp)=tl_vbar_obc(i,ib,ir,linp)/ &
716 & sqrt(om_v(i,j))
717 END DO
718 END IF
719 END IF
720# ifdef DISTRIBUTE
722 & lbij, ubij, &
725 & tl_vbar_obc(:,ib,ir,linp))
726# endif
727 END IF
728 END DO
729 END DO
730
731# ifdef SOLVE3D
732
733
734
736 DO ib=1,4
738 IF (lconvolve(ib)) THEN
741 DO j=jstrt,jendt
742 cff=on_u(i,j)*0.5_r8
744 tl_u_obc(j,k,ib,ir,linp)=tl_u_obc(j,k,ib,ir,linp)/ &
745 & sqrt(cff* &
746 & (hz(i-1,j,k)+ &
747 & hz(i ,j,k)))
748 END DO
749 END DO
752 DO i=istrp,iendt
753 cff=om_u(i,j)*0.5_r8
755 tl_u_obc(i,k,ib,ir,linp)=tl_u_obc(i,k,ib,ir,linp)/ &
756 & sqrt(cff* &
757 & (hz(i-1,j,k)+ &
758 & hz(i ,j,k)))
759 END DO
760 END DO
761 END IF
762 END IF
763# ifdef DISTRIBUTE
765 & lbij, ubij, 1,
n(ng), &
768 & tl_u_obc(:,:,ib,ir,linp))
769# endif
770 END IF
771 END DO
772 END DO
773
774
775
777 DO ib=1,4
779 IF (lconvolve(ib)) THEN
782 DO j=jstrp,jendt
783 cff=on_v(i,j)*0.5_r8
785 tl_v_obc(j,k,ib,ir,linp)=tl_v_obc(j,k,ib,ir,linp)/ &
786 & sqrt(cff* &
787 & (hz(i,j-1,k)+ &
788 & hz(i,j ,k)))
789 END DO
790 END DO
793 DO i=istrt,iendt
794 cff=om_v(i,j)*0.5_r8
796 tl_v_obc(i,k,ib,ir,linp)=tl_v_obc(i,k,ib,ir,linp)/ &
797 & sqrt(cff* &
798 & (hz(i,j-1,k)+ &
799 & hz(i,j ,k)))
800 END DO
801 END DO
802 END IF
803 END IF
804# ifdef DISTRIBUTE
806 & lbij, ubij, 1,
n(ng), &
809 & tl_v_obc(:,:,ib,ir,linp))
810# endif
811 END IF
812 END DO
813 END DO
814
815
816
819 DO ib=1,4
820 IF (.not.lweak.and.
lobc(ib,
istvar(it),ng))
THEN
821 IF (lconvolve(ib)) THEN
824 DO j=jstrt,jendt
825 cff=on_r(i,j)
827 tl_t_obc(j,k,ib,ir,linp,it)= &
828 & tl_t_obc(j,k,ib,ir,linp,it)/ &
829 & sqrt(cff*hz(i,j,k))
830 END DO
831 END DO
834 DO i=istrt,iendt
835 cff=om_r(i,j)
837 tl_t_obc(i,k,ib,ir,linp,it)= &
838 & tl_t_obc(i,k,ib,ir,linp,it)/ &
839 & sqrt(cff*hz(i,j,k))
840 END DO
841 END DO
842 END IF
843 END IF
844# ifdef DISTRIBUTE
846 & lbij, ubij, 1,
n(ng), &
849 & tl_t_obc(:,:,ib,ir,linp,it))
850# endif
851 END IF
852 END DO
853 END DO
854 END DO
855# endif
856# endif
857
858# ifdef ADJUST_WSTRESS
859
860
861
862 IF (.not.lweak) THEN
864 DO j=jstrt,jendt
865 DO i=istrp,iendt
866 tl_ustr(i,j,ir,linp)=tl_ustr(i,j,ir,linp)/ &
867 & sqrt(om_u(i,j)*on_u(i,j))
868 END DO
869 END DO
870 DO j=jstrp,jendt
871 DO i=istrt,iendt
872 tl_vstr(i,j,ir,linp)=tl_vstr(i,j,ir,linp)/ &
873 & sqrt(om_v(i,j)*on_v(i,j))
874 END DO
875 END DO
876 END DO
877# ifdef DISTRIBUTE
879 & lbi, ubi, lbj, ubj, 1,
nfrec(ng), &
882 & tl_ustr(:,:,:,linp), &
883 & tl_vstr(:,:,:,linp))
884# endif
885 END IF
886# endif
887# if defined ADJUST_STFLUX && defined SOLVE3D
888
889
890
891 IF (.not.lweak) THEN
892 DO j=jstrt,jendt
893 DO i=istrt,iendt
894 fac=1.0_r8/sqrt(om_r(i,j)*on_r(i,j))
898 tl_tflux(i,j,ir,linp,it)=fac*tl_tflux(i,j,ir,linp,it)
899 END DO
900 END IF
901 END DO
902 END DO
903 END DO
904# ifdef DISTRIBUTE
908 & lbi, ubi, lbj, ubj, 1,
nfrec(ng), &
911 & tl_tflux(:,:,:,linp,it))
912 END IF
913 END DO
914# endif
915 END IF
916# endif
917
918
919
920
921
922
923
924
925
926
928 & lbi, ubi, lbj, ubj, &
929 & imins, imaxs, jmins, jmaxs, &
933 & kh, &
934 & pm, pn, pmon_u, pnom_v, &
935# ifdef MASKING
936 & rmask, umask, vmask, &
937# endif
938 & tl_zeta(:,:,linp))
939
940
941
943 & lbi, ubi, lbj, ubj, &
944 & imins, imaxs, jmins, jmaxs, &
948 & kh, &
949 & pm, pn, pmon_r, pnom_p, &
950# ifdef MASKING
951 & umask, pmask, &
952# endif
953 & tl_ubar(:,:,linp))
954
956 & lbi, ubi, lbj, ubj, &
957 & imins, imaxs, jmins, jmaxs, &
961 & kh, &
962 & pm, pn, pmon_p, pnom_r, &
963# ifdef MASKING
964 & vmask, pmask, &
965# endif
966 & tl_vbar(:,:,linp))
967# ifdef SOLVE3D
968
969
970
972 & lbi, ubi, lbj, ubj, 1,
n(ng), &
973 & imins, imaxs, jmins, jmaxs, &
979 & kh, kv, &
980 & pm, pn, &
981# ifdef GEOPOTENTIAL_HCONV
982 & on_r, om_p, &
983# else
984 & pmon_r, pnom_p, &
985# endif
986# ifdef MASKING
987# ifdef GEOPOTENTIAL_HCONV
988 & pmask, rmask, umask, vmask, &
989# else
990 & umask, pmask, &
991# endif
992# endif
993 & hz, z_r, &
994 & tl_u(:,:,:,linp))
995
997 & lbi, ubi, lbj, ubj, 1,
n(ng), &
998 & imins, imaxs, jmins, jmaxs, &
1004 & kh, kv, &
1005 & pm, pn, &
1006# ifdef GEOPOTENTIAL_HCONV
1007 & on_p, om_r, &
1008# else
1009 & pmon_p, pnom_r, &
1010# endif
1011# ifdef MASKING
1012# ifdef GEOPOTENTIAL_HCONV
1013 & pmask, rmask, umask, vmask, &
1014# else
1015 & vmask, pmask, &
1016# endif
1017# endif
1018 & hz, z_r, &
1019 & tl_v(:,:,:,linp))
1020
1021
1022
1026 & lbi, ubi, lbj, ubj, 1,
n(ng), &
1027 & imins, imaxs, jmins, jmaxs, &
1033 & kh, kv, &
1034 & pm, pn, &
1035# ifdef GEOPOTENTIAL_HCONV
1036 & on_u, om_v, &
1037# else
1038 & pmon_u, pnom_v, &
1039# endif
1040# ifdef MASKING
1041 & rmask, umask, vmask, &
1042# endif
1043 & hz, z_r, &
1044 & tl_t(:,:,:,linp,it))
1045 END DO
1046# endif
1047
1048# ifdef ADJUST_BOUNDARY
1049
1050
1051
1052
1053
1054
1055
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_u, pnom_v, &
1072# ifdef MASKING
1073 & rmask, umask, vmask, &
1074# endif
1075 & tl_zeta_obc(:,ib,ir,linp))
1076 END IF
1077 END DO
1078 END DO
1079
1080
1081
1083 DO ib=1,4
1087 & lbij, ubij, &
1088 & lbi, ubi, lbj, ubj, &
1089 & imins, imaxs, jmins, jmaxs, &
1093 & kh, &
1094 & pm, pn, pmon_r, pnom_p, &
1095# ifdef MASKING
1096 & umask, pmask, &
1097# endif
1098 & tl_ubar_obc(:,ib,ir,linp))
1099 END IF
1100 END DO
1101 END DO
1102
1103
1104
1106 DO ib=1,4
1110 & lbij, ubij, &
1111 & lbi, ubi, lbj, ubj, &
1112 & imins, imaxs, jmins, jmaxs, &
1116 & kh, &
1117 & pm, pn, pmon_p, pnom_r, &
1118# ifdef MASKING
1119 & vmask, pmask, &
1120# endif
1121 & tl_vbar_obc(:,ib,ir,linp))
1122 END IF
1123 END DO
1124 END DO
1125
1126# ifdef SOLVE3D
1127
1128
1129
1131 DO ib=1,4
1135 & lbij, ubij, &
1136 & lbi, ubi, lbj, ubj, 1,
n(ng), &
1137 & imins, imaxs, jmins, jmaxs, &
1143 & kh, kv, &
1144 & pm, pn, pmon_r, pnom_p, &
1145# ifdef MASKING
1146 & umask, pmask, &
1147# endif
1148 & hz, z_r, &
1149 & tl_u_obc(:,:,ib,ir,linp))
1150 END IF
1151 END DO
1152 END DO
1153
1154
1155
1157 DO ib=1,4
1161 & lbij, ubij, &
1162 & lbi, ubi, lbj, ubj, 1,
n(ng), &
1163 & imins, imaxs, jmins, jmaxs, &
1169 & kh, kv, &
1170 & pm, pn, pmon_p, pnom_r, &
1171# ifdef MASKING
1172 & vmask, pmask, &
1173# endif
1174 & hz, z_r, &
1175 & tl_v_obc(:,:,ib,ir,linp))
1176 END IF
1177 END DO
1178 END DO
1179
1180
1181
1185 DO ib=1,4
1186 IF (.not.lweak.and.
lobc(ib,is,ng))
THEN
1189 & lbij, ubij, &
1190 & lbi, ubi, lbj, ubj, 1,
n(ng), &
1191 & imins, imaxs, jmins, jmaxs, &
1197 & kh, kv, &
1198 & pm, pn, pmon_u, pnom_v, &
1199# ifdef MASKING
1200 & rmask, umask, vmask, &
1201# endif
1202 & hz, z_r, &
1203 & tl_t_obc(:,:,ib,ir,linp,it))
1204 END IF
1205 END DO
1206 END DO
1207 END DO
1208# endif
1209# endif
1210
1211# if defined ADJUST_WSTRESS || defined ADJUST_STFLUX
1212
1213
1214
1215
1216
1217
1218
1219
1220# ifdef ADJUST_WSTRESS
1221
1222
1223
1224 IF (.not.lweak) THEN
1227 & lbi, ubi, lbj, ubj, &
1228 & imins, imaxs, jmins, jmaxs, &
1232 & kh, &
1233 & pm, pn, pmon_r, pnom_p, &
1234# ifdef MASKING
1235 & umask, pmask, &
1236# endif
1237 & tl_ustr(:,:,k,linp))
1238
1240 & lbi, ubi, lbj, ubj, &
1241 & imins, imaxs, jmins, jmaxs, &
1245 & kh, &
1246 & pm, pn, pmon_p, pnom_r, &
1247# ifdef MASKING
1248 & vmask, pmask, &
1249# endif
1250 & tl_vstr(:,:,k,linp))
1251 END DO
1252 END IF
1253# endif
1254# if defined ADJUST_STFLUX && defined SOLVE3D
1255
1256
1257
1258 IF (.not.lweak) THEN
1264 & lbi, ubi, lbj, ubj, &
1265 & imins, imaxs, jmins, jmaxs, &
1269 & kh, &
1270 & pm, pn, pmon_u, pnom_v, &
1271# ifdef MASKING
1272 & rmask, umask, vmask, &
1273# endif
1274 & tl_tflux(:,:,k,linp,it))
1275 END DO
1276 END IF
1277 END DO
1278 END IF
1279# endif
1280# endif
1281
1282
1283
1284
1285
1286
1287
1288
1289 DO j=jstrt,jendt
1290 DO i=istrt,iendt
1291 tl_zeta(i,j,linp)=tl_zeta(i,j,linp)*hnormr(i,j,rec)
1292 END DO
1293 END DO
1294
1295
1296
1297 DO j=jstrt,jendt
1298 DO i=istrp,iendt
1299 tl_ubar(i,j,linp)=tl_ubar(i,j,linp)*hnormu(i,j,rec)
1300 END DO
1301 END DO
1302 DO j=jstrp,jendt
1303 DO i=istrt,iendt
1304 tl_vbar(i,j,linp)=tl_vbar(i,j,linp)*hnormv(i,j,rec)
1305 END DO
1306 END DO
1307# ifdef DISTRIBUTE
1309 & lbi, ubi, lbj, ubj, &
1312 & tl_zeta(:,:,linp), &
1313 & tl_ubar(:,:,linp), &
1314 & tl_vbar(:,:,linp))
1315# endif
1316# ifdef SOLVE3D
1317
1318
1319
1321 DO j=jstrt,jendt
1322 DO i=istrp,iendt
1323 tl_u(i,j,k,linp)=tl_u(i,j,k,linp)*vnormu(i,j,k,rec)
1324 END DO
1325 END DO
1326 DO j=jstrp,jendt
1327 DO i=istrt,iendt
1328 tl_v(i,j,k,linp)=tl_v(i,j,k,linp)*vnormv(i,j,k,rec)
1329 END DO
1330 END DO
1331 END DO
1332# ifdef DISTRIBUTE
1334 & lbi, ubi, lbj, ubj, 1,
n(ng), &
1337 & tl_u(:,:,:,linp), &
1338 & tl_v(:,:,:,linp))
1339# endif
1340
1341
1342
1345 DO j=jstrt,jendt
1346 DO i=istrt,iendt
1347 tl_t(i,j,k,linp,it)=tl_t(i,j,k,linp,it)* &
1348 & vnormr(i,j,k,rec,it)
1349 END DO
1350 END DO
1351 END DO
1352 END DO
1353# ifdef DISTRIBUTE
1355 & lbi, ubi, lbj, ubj, 1,
n(ng), 1,
nt(ng), &
1358 & tl_t(:,:,:,linp,:))
1359# endif
1360# endif
1361
1362# ifdef ADJUST_BOUNDARY
1363
1364
1365
1367 DO ib=1,4
1369 IF (lconvolve(ib)) THEN
1371 DO j=jstrt,jendt
1372 tl_zeta_obc(j,ib,ir,linp)=tl_zeta_obc(j,ib,ir,linp)* &
1373 & hnormrobc(j,ib)
1374 END DO
1376 DO i=istrt,iendt
1377 tl_zeta_obc(i,ib,ir,linp)=tl_zeta_obc(i,ib,ir,linp)* &
1378 & hnormrobc(i,ib)
1379 END DO
1380 END IF
1381 END IF
1382# ifdef DISTRIBUTE
1384 & lbij, ubij, &
1387 & tl_zeta_obc(:,ib,ir,linp))
1388# endif
1389 END IF
1390 END DO
1391 END DO
1392
1393
1394
1396 DO ib=1,4
1398 IF (lconvolve(ib)) THEN
1400 DO j=jstrt,jendt
1401 tl_ubar_obc(j,ib,ir,linp)=tl_ubar_obc(j,ib,ir,linp)* &
1402 & hnormuobc(j,ib)
1403 END DO
1405 DO i=istrp,iendt
1406 tl_ubar_obc(i,ib,ir,linp)=tl_ubar_obc(i,ib,ir,linp)* &
1407 & hnormuobc(i,ib)
1408 END DO
1409 END IF
1410 END IF
1411# ifdef DISTRIBUTE
1413 & lbij, ubij, &
1416 & tl_ubar_obc(:,ib,ir,linp))
1417# endif
1418 END IF
1419 END DO
1420 END DO
1421
1422
1423
1425 DO ib=1,4
1427 IF (lconvolve(ib)) THEN
1429 DO j=jstrp,jendt
1430 tl_vbar_obc(j,ib,ir,linp)=tl_vbar_obc(j,ib,ir,linp)* &
1431 & hnormvobc(j,ib)
1432 END DO
1434 DO i=istrt,iendt
1435 tl_vbar_obc(i,ib,ir,linp)=tl_vbar_obc(i,ib,ir,linp)* &
1436 & hnormvobc(i,ib)
1437 END DO
1438 END IF
1439 END IF
1440# ifdef DISTRIBUTE
1442 & lbij, ubij, &
1445 & tl_vbar_obc(:,ib,ir,linp))
1446# endif
1447 END IF
1448 END DO
1449 END DO
1450
1451# ifdef SOLVE3D
1452
1453
1454
1456 DO ib=1,4
1458 IF (lconvolve(ib)) THEN
1461 DO j=jstrt,jendt
1462 tl_u_obc(j,k,ib,ir,linp)=tl_u_obc(j,k,ib,ir,linp)* &
1463 & vnormuobc(j,k,ib)
1464 END DO
1465 END DO
1468 DO i=istrp,iendt
1469 tl_u_obc(i,k,ib,ir,linp)=tl_u_obc(i,k,ib,ir,linp)* &
1470 & vnormuobc(i,k,ib)
1471 END DO
1472 END DO
1473 END IF
1474 END IF
1475# ifdef DISTRIBUTE
1477 & lbij, ubij, 1,
n(ng), &
1480 & tl_u_obc(:,:,ib,ir,linp))
1481# endif
1482 END IF
1483 END DO
1484 END DO
1485
1486
1487
1489 DO ib=1,4
1491 IF (lconvolve(ib)) THEN
1494 DO j=jstrp,jendt
1495 tl_v_obc(j,k,ib,ir,linp)=tl_v_obc(j,k,ib,ir,linp)* &
1496 & vnormvobc(j,k,ib)
1497 END DO
1498 END DO
1501 DO i=istrt,iendt
1502 tl_v_obc(i,k,ib,ir,linp)=tl_v_obc(i,k,ib,ir,linp)* &
1503 & vnormvobc(i,k,ib)
1504 END DO
1505 END DO
1506 END IF
1507 END IF
1508# ifdef DISTRIBUTE
1510 & lbij, ubij, 1,
n(ng), &
1513 & tl_v_obc(:,:,ib,ir,linp))
1514# endif
1515 END IF
1516 END DO
1517 END DO
1518
1519
1520
1523 DO ib=1,4
1524 IF (.not.lweak.and.
lobc(ib,
istvar(it),ng))
THEN
1525 IF (lconvolve(ib)) THEN
1528 DO j=jstrt,jendt
1529 tl_t_obc(j,k,ib,ir,linp,it)= &
1530 & tl_t_obc(j,k,ib,ir,linp,it)* &
1531 & vnormrobc(j,k,ib,it)
1532 END DO
1533 END DO
1536 DO i=istrt,iendt
1537 tl_t_obc(i,k,ib,ir,linp,it)= &
1538 & tl_t_obc(i,k,ib,ir,linp,it)* &
1539 & vnormrobc(i,k,ib,it)
1540 END DO
1541 END DO
1542 END IF
1543 END IF
1544# ifdef DISTRIBUTE
1546 & lbij, ubij, 1,
n(ng), &
1549 & tl_t_obc(:,:,ib,ir,linp,it))
1550# endif
1551 END IF
1552 END DO
1553 END DO
1554 END DO
1555# endif
1556# endif
1557
1558# ifdef ADJUST_WSTRESS
1559
1560
1561
1562 IF (.not.lweak) THEN
1564 DO j=jstrt,jendt
1565 DO i=istrp,iendt
1566 tl_ustr(i,j,k,linp)=tl_ustr(i,j,k,linp)*hnormsus(i,j)
1567 END DO
1568 END DO
1569 DO j=jstrp,jendt
1570 DO i=istrt,iendt
1571 tl_vstr(i,j,k,linp)=tl_vstr(i,j,k,linp)*hnormsvs(i,j)
1572 END DO
1573 END DO
1574 END DO
1575# ifdef DISTRIBUTE
1577 & lbi, ubi, lbj, ubj, 1,
nfrec(ng), &
1580 & tl_ustr(:,:,:,linp), &
1581 & tl_vstr(:,:,:,linp))
1582# endif
1583 END IF
1584# endif
1585
1586# if defined ADJUST_STFLUX && defined SOLVE3D
1587
1588
1589
1590 IF (.not.lweak) THEN
1594 DO j=jstrt,jendt
1595 DO i=istrt,iendt
1596 tl_tflux(i,j,k,linp,it)=tl_tflux(i,j,k,linp,it)* &
1597 & hnormstf(i,j,it)
1598 END DO
1599 END DO
1600 END DO
1601# ifdef DISTRIBUTE
1603 & lbi, ubi, lbj, ubj, 1,
nfrec(ng), &
1606 & tl_tflux(:,:,:,linp,it))
1607# endif
1608 END IF
1609 END DO
1610 END IF
1611# endif
1612
1613 RETURN
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 mp_exchange2d_bry(ng, tile, model, nvar, boundary, lbij, ubij, nghost, ew_periodic, ns_periodic, a, b, c, d)
subroutine mp_exchange4d(ng, tile, model, nvar, lbi, ubi, lbj, ubj, lbk, ubk, lbt, ubt, nghost, ew_periodic, ns_periodic, a, b, c)
subroutine mp_exchange2d(ng, tile, model, nvar, lbi, ubi, lbj, ubj, nghost, ew_periodic, ns_periodic, a, b, c, d)
subroutine mp_exchange3d(ng, tile, model, nvar, lbi, ubi, lbj, ubj, lbk, ubk, nghost, ew_periodic, ns_periodic, a, b, c, d)
subroutine mp_exchange3d_bry(ng, tile, model, nvar, boundary, lbij, ubij, lbk, ubk, nghost, ew_periodic, ns_periodic, a, b, c, 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)
subroutine tl_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, tl_a)
subroutine tl_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, tl_a)
subroutine tl_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, tl_a)
subroutine tl_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, tl_a)
subroutine tl_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, tl_a)
subroutine tl_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, tl_a)
subroutine tl_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, tl_a)
subroutine tl_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, tl_a)
subroutine tl_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, tl_a)
subroutine tl_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, tl_a)
subroutine tl_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, tl_a)
subroutine tl_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, tl_a)