Changeset 15054
- Timestamp:
- 2021-06-24T19:05:38+02:00 (3 years ago)
- Location:
- NEMO/branches/2021/dev_r14447_HPC-07_Irrmann_try_new_pt2pt/src/OCE
- Files:
-
- 4 edited
-
DYN/dynspg_ts.F90 (modified) (6 diffs)
-
LBC/lbc_lnk_persistent.h90 (modified) (2 diffs)
-
LBC/lbclnk.F90 (modified) (3 diffs)
-
LBC/lib_mpp.F90 (modified) (2 diffs)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2021/dev_r14447_HPC-07_Irrmann_try_new_pt2pt/src/OCE/DYN/dynspg_ts.F90
r14899 r15054 517 517 ENDIF 518 518 ! 519 ! In loop_ssha_e 519 520 ! 520 521 ! Compute Sea Level at step jit+1 … … 522 523 !-- ssh = ssh - delta_t' * [ frc + div( flux ) ] --! 523 524 !-------------------------------------------------------------------------! 524 525 525 ! 526 526 IF( ln_async ) THEN 527 CALL lbc_lnk( 'dynspg_ts', ssha_e, 'T', 1._wp, zhU, 'U', -1._wp, zhV, 'V', -1._wp, loop_fct=loop_ fct1)527 CALL lbc_lnk( 'dynspg_ts', ssha_e, 'T', 1._wp, zhU, 'U', -1._wp, zhV, 'V', -1._wp, loop_fct=loop_ssha_e ) 528 528 ELSE 529 DO_2D( 0, 0, 0, 0 ) 530 zhdiv = ( zhU(ji,jj) - zhU(ji-1,jj) + zhV(ji,jj) - zhV(ji,jj-1) ) * r1_e1e2t(ji,jj) 531 ssha_e(ji,jj) = ( sshn_e(ji,jj) - rDt_e * ( zssh_frc(ji,jj) + zhdiv ) ) * ssmask(ji,jj) 532 END_2D 529 CALL loop_ssha_e( 2, jpi-1, 2, jpj-1, 1, jpkm1 ) ! arguments are useless in that case 533 530 CALL lbc_lnk( 'dynspg_ts', ssha_e, 'T', 1._wp, zhU, 'U', -1._wp, zhV, 'V', -1._wp ) 534 531 END IF … … 614 611 ENDIF 615 612 ! 613 ! In loop_velocity 614 ! 616 615 ! Set next velocities: 617 616 ! Compute barotropic speeds at step jit+1 (h : total height of the water colomn) … … 620 619 !-- u = u + delta_t' * \ (1-r)*g * grad_x( ssh') - f * k vect u + frc / --! 621 620 !-- --! 622 !-- FLUX FORM--!621 !-- FLUX FORM --! 623 622 !-- m+1 __1__ / m m / m+1/2 m+1/2 m+1/2 n \ \ --! 624 623 !-- u = m+1 | h * u + delta_t' * \ h * (1-r)*g * grad_x( ssh') - h * f * k vect u + h * frc / | --! 625 624 !-- h \ / --! 626 625 !------------------------------------------------------------------------------------------------------------------------! 627 IF( ln_dynadv_vec .OR. ln_linssh ) THEN !* Vector form 628 DO_2D( 0, 0, 0, 0 ) 626 627 IF( ln_async ) THEN 628 IF( .NOT.ln_linssh ) THEN !* Update ocean depth (variable volume case only) 629 CALL lbc_lnk( 'dynspg_ts', ua_e , 'U', -1._wp, va_e , 'V', -1._wp & 630 & , hu_e , 'U', 1._wp, hv_e , 'V', 1._wp & 631 & , hur_e, 'U', 1._wp, hvr_e, 'V', 1._wp, loop_fct=loop_velocity ) 632 ELSE 633 CALL lbc_lnk( 'dynspg_ts', ua_e , 'U', -1._wp, va_e , 'V', -1._wp, loop_fct=loop_velocity ) 634 ENDIF 635 ELSE 636 CALL loop_velocity( 2, jpi-1, 2, jpj-1, 1, jpkm1 ) ! arguments are useless in that case 637 IF( .NOT.ln_linssh ) THEN !* Update ocean depth (variable volume case only) 638 CALL lbc_lnk( 'dynspg_ts', ua_e , 'U', -1._wp, va_e , 'V', -1._wp & 639 & , hu_e , 'U', 1._wp, hv_e , 'V', 1._wp & 640 & , hur_e, 'U', 1._wp, hvr_e, 'V', 1._wp ) 641 ELSE 642 CALL lbc_lnk( 'dynspg_ts', ua_e , 'U', -1._wp, va_e , 'V', -1._wp ) 643 ENDIF 644 END IF 645 646 ! ! open boundaries 647 IF( ln_bdy ) CALL bdy_dyn2d( jn, ua_e, va_e, un_e, vn_e, hur_e, hvr_e, ssha_e ) 648 #if defined key_agrif 649 IF( .NOT.Agrif_Root() ) CALL agrif_dyn_ts( jn ) ! Agrif 650 #endif 651 ! !* Swap 652 ! ! ---- 653 ubb_e (:,:) = ub_e (:,:) 654 ub_e (:,:) = un_e (:,:) 655 un_e (:,:) = ua_e (:,:) 656 ! 657 vbb_e (:,:) = vb_e (:,:) 658 vb_e (:,:) = vn_e (:,:) 659 vn_e (:,:) = va_e (:,:) 660 ! 661 sshbb_e(:,:) = sshb_e(:,:) 662 sshb_e (:,:) = sshn_e(:,:) 663 sshn_e (:,:) = ssha_e(:,:) 664 665 ! !* Sum over whole bt loop 666 ! ! ---------------------- 667 za1 = wgtbtp1(jn) 668 IF( ln_dynadv_vec .OR. ln_linssh ) THEN ! Sum velocities 669 puu_b (:,:,Kaa) = puu_b (:,:,Kaa) + za1 * ua_e (:,:) 670 pvv_b (:,:,Kaa) = pvv_b (:,:,Kaa) + za1 * va_e (:,:) 671 ELSE ! Sum transports 672 IF ( .NOT.ln_wd_dl ) THEN 673 puu_b (:,:,Kaa) = puu_b (:,:,Kaa) + za1 * ua_e (:,:) * hu_e (:,:) 674 pvv_b (:,:,Kaa) = pvv_b (:,:,Kaa) + za1 * va_e (:,:) * hv_e (:,:) 675 ELSE 676 puu_b (:,:,Kaa) = puu_b (:,:,Kaa) + za1 * ua_e (:,:) * hu_e (:,:) * zuwdmask(:,:) 677 pvv_b (:,:,Kaa) = pvv_b (:,:,Kaa) + za1 * va_e (:,:) * hv_e (:,:) * zvwdmask(:,:) 678 END IF 679 ENDIF 680 ! ! Sum sea level 681 pssh(:,:,Kaa) = pssh(:,:,Kaa) + za1 * ssha_e(:,:) 682 683 ! ! ==================== ! 684 END DO ! end loop ! 685 ! ! ==================== ! 686 lints = .FALSE. 687 ! ----------------------------------------------------------------------------- 688 ! Phase 3. update the general trend with the barotropic trend 689 ! ----------------------------------------------------------------------------- 690 ! 691 ! Set advection velocity correction: 692 IF (ln_bt_fw) THEN 693 IF( .NOT.( kt == nit000 .AND. l_1st_euler ) ) THEN 694 DO_2D( 1, 1, 1, 1 ) 695 zun_save = un_adv(ji,jj) 696 zvn_save = vn_adv(ji,jj) 697 ! ! apply the previously computed correction 698 un_adv(ji,jj) = r1_2 * ( ub2_b(ji,jj) + zun_save - rn_atfp * un_bf(ji,jj) ) 699 vn_adv(ji,jj) = r1_2 * ( vb2_b(ji,jj) + zvn_save - rn_atfp * vn_bf(ji,jj) ) 700 ! ! Update corrective fluxes for next time step 701 un_bf(ji,jj) = rn_atfp * un_bf(ji,jj) + ( zun_save - ub2_b(ji,jj) ) 702 vn_bf(ji,jj) = rn_atfp * vn_bf(ji,jj) + ( zvn_save - vb2_b(ji,jj) ) 703 ! ! Save integrated transport for next computation 704 ub2_b(ji,jj) = zun_save 705 vb2_b(ji,jj) = zvn_save 706 END_2D 707 ELSE 708 un_bf(:,:) = 0._wp ! corrective fluxes for next time step set to zero 709 vn_bf(:,:) = 0._wp 710 ub2_b(:,:) = un_adv(:,:) ! Save integrated transport for next computation 711 vb2_b(:,:) = vn_adv(:,:) 712 END IF 713 ENDIF 714 715 716 ! 717 ! Update barotropic trend: 718 IF( ln_dynadv_vec .OR. ln_linssh ) THEN 719 DO jk=1,jpkm1 720 puu(:,:,jk,Krhs) = puu(:,:,jk,Krhs) + ( puu_b(:,:,Kaa) - puu_b(:,:,Kbb) ) * r1_Dt_b 721 pvv(:,:,jk,Krhs) = pvv(:,:,jk,Krhs) + ( pvv_b(:,:,Kaa) - pvv_b(:,:,Kbb) ) * r1_Dt_b 722 END DO 723 ELSE 724 ! At this stage, pssh(:,:,:,Krhs) has been corrected: compute new depths at velocity points 725 #if defined key_qcoTest_FluxForm 726 ! ! 'key_qcoTest_FluxForm' : simple ssh average 727 DO_2D( 1, 0, 1, 0 ) 728 zsshu_a(ji,jj) = r1_2 * ( pssh(ji,jj,Kaa) + pssh(ji+1,jj ,Kaa) ) * ssumask(ji,jj) 729 zsshv_a(ji,jj) = r1_2 * ( pssh(ji,jj,Kaa) + pssh(ji ,jj+1,Kaa) ) * ssvmask(ji,jj) 730 END_2D 731 #else 732 DO_2D( 1, 0, 1, 0 ) 733 zsshu_a(ji,jj) = r1_2 * r1_e1e2u(ji,jj) * ( e1e2t(ji ,jj) * pssh(ji ,jj,Kaa) & 734 & + e1e2t(ji+1,jj) * pssh(ji+1,jj,Kaa) ) * ssumask(ji,jj) 735 zsshv_a(ji,jj) = r1_2 * r1_e1e2v(ji,jj) * ( e1e2t(ji,jj ) * pssh(ji,jj ,Kaa) & 736 & + e1e2t(ji,jj+1) * pssh(ji,jj+1,Kaa) ) * ssvmask(ji,jj) 737 END_2D 738 #endif 739 CALL lbc_lnk( 'dynspg_ts', zsshu_a, 'U', 1._wp, zsshv_a, 'V', 1._wp ) ! Boundary conditions 740 ! 741 DO jk=1,jpkm1 742 puu(:,:,jk,Krhs) = puu(:,:,jk,Krhs) + r1_hu(:,:,Kmm) & 743 & * ( puu_b(:,:,Kaa) - puu_b(:,:,Kbb) * hu(:,:,Kbb) ) * r1_Dt_b 744 pvv(:,:,jk,Krhs) = pvv(:,:,jk,Krhs) + r1_hv(:,:,Kmm) & 745 & * ( pvv_b(:,:,Kaa) - pvv_b(:,:,Kbb) * hv(:,:,Kbb) ) * r1_Dt_b 746 END DO 747 ! Save barotropic velocities not transport: 748 puu_b(:,:,Kaa) = puu_b(:,:,Kaa) / ( hu_0(:,:) + zsshu_a(:,:) + 1._wp - ssumask(:,:) ) 749 pvv_b(:,:,Kaa) = pvv_b(:,:,Kaa) / ( hv_0(:,:) + zsshv_a(:,:) + 1._wp - ssvmask(:,:) ) 750 ENDIF 751 752 753 ! Correct velocities so that the barotropic velocity equals (un_adv, vn_adv) (in all cases) 754 DO jk = 1, jpkm1 755 puu(:,:,jk,Kmm) = ( puu(:,:,jk,Kmm) + un_adv(:,:)*r1_hu(:,:,Kmm) - puu_b(:,:,Kmm) ) * umask(:,:,jk) 756 pvv(:,:,jk,Kmm) = ( pvv(:,:,jk,Kmm) + vn_adv(:,:)*r1_hv(:,:,Kmm) - pvv_b(:,:,Kmm) ) * vmask(:,:,jk) 757 END DO 758 759 IF ( ln_wd_dl .and. ln_wd_dl_bc) THEN 760 DO jk = 1, jpkm1 761 puu(:,:,jk,Kmm) = ( un_adv(:,:)*r1_hu(:,:,Kmm) & 762 & + zuwdav2(:,:)*(puu(:,:,jk,Kmm) - un_adv(:,:)*r1_hu(:,:,Kmm)) ) * umask(:,:,jk) 763 pvv(:,:,jk,Kmm) = ( vn_adv(:,:)*r1_hv(:,:,Kmm) & 764 & + zvwdav2(:,:)*(pvv(:,:,jk,Kmm) - vn_adv(:,:)*r1_hv(:,:,Kmm)) ) * vmask(:,:,jk) 765 END DO 766 END IF 767 768 769 CALL iom_put( "ubar", un_adv(:,:)*r1_hu(:,:,Kmm) ) ! barotropic i-current 770 CALL iom_put( "vbar", vn_adv(:,:)*r1_hv(:,:,Kmm) ) ! barotropic i-current 771 ! 772 #if defined key_agrif 773 ! Save time integrated fluxes during child grid integration 774 ! (used to update coarse grid transports at next time step) 775 ! 776 IF( .NOT.Agrif_Root() .AND. ln_bt_fw ) THEN 777 IF( Agrif_NbStepint() == 0 ) THEN 778 ub2_i_b(:,:) = 0._wp 779 vb2_i_b(:,:) = 0._wp 780 END IF 781 ! 782 za1 = 1._wp / REAL(Agrif_rhot(), wp) 783 ub2_i_b(:,:) = ub2_i_b(:,:) + za1 * ub2_b(:,:) 784 vb2_i_b(:,:) = vb2_i_b(:,:) + za1 * vb2_b(:,:) 785 ENDIF 786 #endif 787 ! !* write time-spliting arrays in the restart 788 IF( lrst_oce .AND.ln_bt_fw ) CALL ts_rst( kt, 'WRITE' ) 789 ! 790 IF( ln_wd_il ) DEALLOCATE( zcpx, zcpy ) 791 IF( ln_wd_dl ) DEALLOCATE( ztwdmask, zuwdmask, zvwdmask, zuwdav2, zvwdav2 ) 792 ! 793 CALL iom_put( "baro_u" , puu_b(:,:,Kmm) ) ! Barotropic U Velocity 794 CALL iom_put( "baro_v" , pvv_b(:,:,Kmm) ) ! Barotropic V Velocity 795 ! 796 ! 797 CONTAINS 798 SUBROUTINE loop_ssha_e(i0, i1, j0, j1, k0, k1, buf) 799 !!--------------------------------------------------------------------- 800 !! *** SUBROUTINE loop_ssha_e *** 801 !! 802 !! ** Purpose : Set ssha_e for next sub time step 803 !!---------------------------------------------------------------------- 804 INTEGER, INTENT(in) :: i0, i1, j0, j1, k0, k1 805 REAL*8, DIMENSION(:,:,:,:,:,:), OPTIONAL, INTENT(out) :: buf 806 ! Compute Sea Level at step jit+1 807 !-- m+1 m m+1/2 --! 808 !-- ssh = ssh - delta_t' * [ frc + div( flux ) ] --! 809 !-------------------------------------------------------------------------! 810 DO_2D( 0, 0, 0, 0 ) 811 zhdiv = ( zhU(ji,jj) - zhU(ji-1,jj) + zhV(ji,jj) - zhV(ji,jj-1) ) * r1_e1e2t(ji,jj) 812 ssha_e(ji,jj) = ( sshn_e(ji,jj) - rDt_e * ( zssh_frc(ji,jj) + zhdiv ) ) * ssmask(ji,jj) 813 END_2D 814 END SUBROUTINE loop_ssha_e 815 ! 816 SUBROUTINE loop_velocity(i0, i1, j0, j1, k0, k1, buf) 817 !!--------------------------------------------------------------------- 818 !! *** SUBROUTINE loop_velocity *** 819 !! 820 !! ** Purpose : Set velocities for next sub time step 821 !!---------------------------------------------------------------------- 822 INTEGER, INTENT(in) :: i0, i1, j0, j1, k0, k1 823 REAL*8, DIMENSION(:,:,:,:,:,:), OPTIONAL, INTENT(out) :: buf 824 ! 825 ! Set next velocities: 826 ! Compute barotropic speeds at step jit+1 (h : total height of the water colomn) 827 !-- VECTOR FORM 828 !-- m+1 m / m+1/2 \ --! 829 !-- u = u + delta_t' * \ (1-r)*g * grad_x( ssh') - f * k vect u + frc / --! 830 !-- --! 831 !-- FLUX FORM --! 832 !-- m+1 __1__ / m m / m+1/2 m+1/2 m+1/2 n \ \ --! 833 !-- u = m+1 | h * u + delta_t' * \ h * (1-r)*g * grad_x( ssh') - h * f * k vect u + h * frc / | --! 834 !-- h \ / --! 835 !------------------------------------------------------------------------------------------------------------------------! 836 IF( ln_dynadv_vec .OR. ln_linssh ) THEN !* Vector form 837 DO_2D( 0, 0, 0, 0 ) 629 838 ua_e(ji,jj) = ( un_e(ji,jj) & 630 839 & + rDt_e * ( zu_spg(ji,jj) & … … 638 847 & + zv_frc(ji,jj) ) & 639 848 & ) * ssvmask(ji,jj) 640 641 642 643 849 END_2D 850 ! 851 ELSE !* Flux form 852 DO_2D( 0, 0, 0, 0 ) 644 853 ! ! hu_e, hv_e hold depth at jn, zhup2_e, zhvp2_e hold extrapolated depth at jn+1/2 645 854 ! ! backward interpolated depth used in spg terms at jn+1/2 … … 667 876 & + zhvp2_e(ji,jj) * zv_trd (ji,jj) & ! 668 877 & + hv(ji,jj,Kmm) * zv_frc (ji,jj) ) ) * z1_hv 669 670 878 END_2D 879 ENDIF 671 880 !jth implicit bottom friction: 672 673 674 675 676 677 881 IF ( ll_wd ) THEN ! revert to explicit for bit comparison tests in non wad runs 882 DO_2D( 0, 0, 0, 0 ) 883 ua_e(ji,jj) = ua_e(ji,jj) / ( 1._wp - rDt_e * zCdU_u(ji,jj) * hur_e(ji,jj) ) 884 va_e(ji,jj) = va_e(ji,jj) / ( 1._wp - rDt_e * zCdU_v(ji,jj) * hvr_e(ji,jj) ) 885 END_2D 886 ENDIF 678 887 679 IF( .NOT.ln_linssh ) THEN !* Update ocean depth (variable volume case only) 680 hu_e (2:jpim1,2:jpjm1) = hu_0(2:jpim1,2:jpjm1) + zsshu_a(2:jpim1,2:jpjm1) 681 hur_e(2:jpim1,2:jpjm1) = ssumask(2:jpim1,2:jpjm1) / ( hu_e(2:jpim1,2:jpjm1) + 1._wp - ssumask(2:jpim1,2:jpjm1) ) 682 hv_e (2:jpim1,2:jpjm1) = hv_0(2:jpim1,2:jpjm1) + zsshv_a(2:jpim1,2:jpjm1) 683 hvr_e(2:jpim1,2:jpjm1) = ssvmask(2:jpim1,2:jpjm1) / ( hv_e(2:jpim1,2:jpjm1) + 1._wp - ssvmask(2:jpim1,2:jpjm1) ) 684 ENDIF 685 ! 686 IF( .NOT.ln_linssh ) THEN !* Update ocean depth (variable volume case only) 687 CALL lbc_lnk( 'dynspg_ts', ua_e , 'U', -1._wp, va_e , 'V', -1._wp & 688 & , hu_e , 'U', 1._wp, hv_e , 'V', 1._wp & 689 & , hur_e, 'U', 1._wp, hvr_e, 'V', 1._wp ) 690 ELSE 691 CALL lbc_lnk( 'dynspg_ts', ua_e , 'U', -1._wp, va_e , 'V', -1._wp ) 692 ENDIF 693 ! ! open boundaries 694 IF( ln_bdy ) CALL bdy_dyn2d( jn, ua_e, va_e, un_e, vn_e, hur_e, hvr_e, ssha_e ) 695 #if defined key_agrif 696 IF( .NOT.Agrif_Root() ) CALL agrif_dyn_ts( jn ) ! Agrif 697 #endif 698 ! !* Swap 699 ! ! ---- 700 ubb_e (:,:) = ub_e (:,:) 701 ub_e (:,:) = un_e (:,:) 702 un_e (:,:) = ua_e (:,:) 703 ! 704 vbb_e (:,:) = vb_e (:,:) 705 vb_e (:,:) = vn_e (:,:) 706 vn_e (:,:) = va_e (:,:) 707 ! 708 sshbb_e(:,:) = sshb_e(:,:) 709 sshb_e (:,:) = sshn_e(:,:) 710 sshn_e (:,:) = ssha_e(:,:) 711 712 ! !* Sum over whole bt loop 713 ! ! ---------------------- 714 za1 = wgtbtp1(jn) 715 IF( ln_dynadv_vec .OR. ln_linssh ) THEN ! Sum velocities 716 puu_b (:,:,Kaa) = puu_b (:,:,Kaa) + za1 * ua_e (:,:) 717 pvv_b (:,:,Kaa) = pvv_b (:,:,Kaa) + za1 * va_e (:,:) 718 ELSE ! Sum transports 719 IF ( .NOT.ln_wd_dl ) THEN 720 puu_b (:,:,Kaa) = puu_b (:,:,Kaa) + za1 * ua_e (:,:) * hu_e (:,:) 721 pvv_b (:,:,Kaa) = pvv_b (:,:,Kaa) + za1 * va_e (:,:) * hv_e (:,:) 722 ELSE 723 puu_b (:,:,Kaa) = puu_b (:,:,Kaa) + za1 * ua_e (:,:) * hu_e (:,:) * zuwdmask(:,:) 724 pvv_b (:,:,Kaa) = pvv_b (:,:,Kaa) + za1 * va_e (:,:) * hv_e (:,:) * zvwdmask(:,:) 725 END IF 726 ENDIF 727 ! ! Sum sea level 728 pssh(:,:,Kaa) = pssh(:,:,Kaa) + za1 * ssha_e(:,:) 729 730 ! ! ==================== ! 731 END DO ! end loop ! 732 ! ! ==================== ! 733 lints = .FALSE. 734 ! ----------------------------------------------------------------------------- 735 ! Phase 3. update the general trend with the barotropic trend 736 ! ----------------------------------------------------------------------------- 737 ! 738 ! Set advection velocity correction: 739 IF (ln_bt_fw) THEN 740 IF( .NOT.( kt == nit000 .AND. l_1st_euler ) ) THEN 741 DO_2D( 1, 1, 1, 1 ) 742 zun_save = un_adv(ji,jj) 743 zvn_save = vn_adv(ji,jj) 744 ! ! apply the previously computed correction 745 un_adv(ji,jj) = r1_2 * ( ub2_b(ji,jj) + zun_save - rn_atfp * un_bf(ji,jj) ) 746 vn_adv(ji,jj) = r1_2 * ( vb2_b(ji,jj) + zvn_save - rn_atfp * vn_bf(ji,jj) ) 747 ! ! Update corrective fluxes for next time step 748 un_bf(ji,jj) = rn_atfp * un_bf(ji,jj) + ( zun_save - ub2_b(ji,jj) ) 749 vn_bf(ji,jj) = rn_atfp * vn_bf(ji,jj) + ( zvn_save - vb2_b(ji,jj) ) 750 ! ! Save integrated transport for next computation 751 ub2_b(ji,jj) = zun_save 752 vb2_b(ji,jj) = zvn_save 753 END_2D 754 ELSE 755 un_bf(:,:) = 0._wp ! corrective fluxes for next time step set to zero 756 vn_bf(:,:) = 0._wp 757 ub2_b(:,:) = un_adv(:,:) ! Save integrated transport for next computation 758 vb2_b(:,:) = vn_adv(:,:) 759 END IF 760 ENDIF 761 762 763 ! 764 ! Update barotropic trend: 765 IF( ln_dynadv_vec .OR. ln_linssh ) THEN 766 DO jk=1,jpkm1 767 puu(:,:,jk,Krhs) = puu(:,:,jk,Krhs) + ( puu_b(:,:,Kaa) - puu_b(:,:,Kbb) ) * r1_Dt_b 768 pvv(:,:,jk,Krhs) = pvv(:,:,jk,Krhs) + ( pvv_b(:,:,Kaa) - pvv_b(:,:,Kbb) ) * r1_Dt_b 769 END DO 770 ELSE 771 ! At this stage, pssh(:,:,:,Krhs) has been corrected: compute new depths at velocity points 772 #if defined key_qcoTest_FluxForm 773 ! ! 'key_qcoTest_FluxForm' : simple ssh average 774 DO_2D( 1, 0, 1, 0 ) 775 zsshu_a(ji,jj) = r1_2 * ( pssh(ji,jj,Kaa) + pssh(ji+1,jj ,Kaa) ) * ssumask(ji,jj) 776 zsshv_a(ji,jj) = r1_2 * ( pssh(ji,jj,Kaa) + pssh(ji ,jj+1,Kaa) ) * ssvmask(ji,jj) 777 END_2D 778 #else 779 DO_2D( 1, 0, 1, 0 ) 780 zsshu_a(ji,jj) = r1_2 * r1_e1e2u(ji,jj) * ( e1e2t(ji ,jj) * pssh(ji ,jj,Kaa) & 781 & + e1e2t(ji+1,jj) * pssh(ji+1,jj,Kaa) ) * ssumask(ji,jj) 782 zsshv_a(ji,jj) = r1_2 * r1_e1e2v(ji,jj) * ( e1e2t(ji,jj ) * pssh(ji,jj ,Kaa) & 783 & + e1e2t(ji,jj+1) * pssh(ji,jj+1,Kaa) ) * ssvmask(ji,jj) 784 END_2D 785 #endif 786 CALL lbc_lnk( 'dynspg_ts', zsshu_a, 'U', 1._wp, zsshv_a, 'V', 1._wp ) ! Boundary conditions 787 ! 788 DO jk=1,jpkm1 789 puu(:,:,jk,Krhs) = puu(:,:,jk,Krhs) + r1_hu(:,:,Kmm) & 790 & * ( puu_b(:,:,Kaa) - puu_b(:,:,Kbb) * hu(:,:,Kbb) ) * r1_Dt_b 791 pvv(:,:,jk,Krhs) = pvv(:,:,jk,Krhs) + r1_hv(:,:,Kmm) & 792 & * ( pvv_b(:,:,Kaa) - pvv_b(:,:,Kbb) * hv(:,:,Kbb) ) * r1_Dt_b 793 END DO 794 ! Save barotropic velocities not transport: 795 puu_b(:,:,Kaa) = puu_b(:,:,Kaa) / ( hu_0(:,:) + zsshu_a(:,:) + 1._wp - ssumask(:,:) ) 796 pvv_b(:,:,Kaa) = pvv_b(:,:,Kaa) / ( hv_0(:,:) + zsshv_a(:,:) + 1._wp - ssvmask(:,:) ) 797 ENDIF 798 799 800 ! Correct velocities so that the barotropic velocity equals (un_adv, vn_adv) (in all cases) 801 DO jk = 1, jpkm1 802 puu(:,:,jk,Kmm) = ( puu(:,:,jk,Kmm) + un_adv(:,:)*r1_hu(:,:,Kmm) - puu_b(:,:,Kmm) ) * umask(:,:,jk) 803 pvv(:,:,jk,Kmm) = ( pvv(:,:,jk,Kmm) + vn_adv(:,:)*r1_hv(:,:,Kmm) - pvv_b(:,:,Kmm) ) * vmask(:,:,jk) 804 END DO 805 806 IF ( ln_wd_dl .and. ln_wd_dl_bc) THEN 807 DO jk = 1, jpkm1 808 puu(:,:,jk,Kmm) = ( un_adv(:,:)*r1_hu(:,:,Kmm) & 809 & + zuwdav2(:,:)*(puu(:,:,jk,Kmm) - un_adv(:,:)*r1_hu(:,:,Kmm)) ) * umask(:,:,jk) 810 pvv(:,:,jk,Kmm) = ( vn_adv(:,:)*r1_hv(:,:,Kmm) & 811 & + zvwdav2(:,:)*(pvv(:,:,jk,Kmm) - vn_adv(:,:)*r1_hv(:,:,Kmm)) ) * vmask(:,:,jk) 812 END DO 813 END IF 814 815 816 CALL iom_put( "ubar", un_adv(:,:)*r1_hu(:,:,Kmm) ) ! barotropic i-current 817 CALL iom_put( "vbar", vn_adv(:,:)*r1_hv(:,:,Kmm) ) ! barotropic i-current 818 ! 819 #if defined key_agrif 820 ! Save time integrated fluxes during child grid integration 821 ! (used to update coarse grid transports at next time step) 822 ! 823 IF( .NOT.Agrif_Root() .AND. ln_bt_fw ) THEN 824 IF( Agrif_NbStepint() == 0 ) THEN 825 ub2_i_b(:,:) = 0._wp 826 vb2_i_b(:,:) = 0._wp 827 END IF 828 ! 829 za1 = 1._wp / REAL(Agrif_rhot(), wp) 830 ub2_i_b(:,:) = ub2_i_b(:,:) + za1 * ub2_b(:,:) 831 vb2_i_b(:,:) = vb2_i_b(:,:) + za1 * vb2_b(:,:) 832 ENDIF 833 #endif 834 ! !* write time-spliting arrays in the restart 835 IF( lrst_oce .AND.ln_bt_fw ) CALL ts_rst( kt, 'WRITE' ) 836 ! 837 IF( ln_wd_il ) DEALLOCATE( zcpx, zcpy ) 838 IF( ln_wd_dl ) DEALLOCATE( ztwdmask, zuwdmask, zvwdmask, zuwdav2, zvwdav2 ) 839 ! 840 CALL iom_put( "baro_u" , puu_b(:,:,Kmm) ) ! Barotropic U Velocity 841 CALL iom_put( "baro_v" , pvv_b(:,:,Kmm) ) ! Barotropic V Velocity 842 ! 843 CONTAINS 844 subroutine loop_fct1(i0, i1, j0, j1, k0, k1, buf) 845 integer, intent(in) :: i0, i1, j0, j1, k0, k1 846 REAL*8, dimension(:,:,:,:,:,:), optional, intent(out) :: buf 847 DO_2D( 0, 0, 0, 0 ) 848 zhdiv = ( zhU(ji,jj) - zhU(ji-1,jj) + zhV(ji,jj) - zhV(ji,jj-1) ) * r1_e1e2t(ji,jj) 849 ssha_e(ji,jj) = ( sshn_e(ji,jj) - rDt_e * ( zssh_frc(ji,jj) + zhdiv ) ) * ssmask(ji,jj) 850 END_2D 851 end subroutine loop_fct1 888 IF( .NOT.ln_linssh ) THEN !* Update ocean depth (variable volume case only) 889 hu_e (2:jpim1,2:jpjm1) = hu_0(2:jpim1,2:jpjm1) + zsshu_a(2:jpim1,2:jpjm1) 890 hur_e(2:jpim1,2:jpjm1) = ssumask(2:jpim1,2:jpjm1) / ( hu_e(2:jpim1,2:jpjm1) + 1._wp - ssumask(2:jpim1,2:jpjm1) ) 891 hv_e (2:jpim1,2:jpjm1) = hv_0(2:jpim1,2:jpjm1) + zsshv_a(2:jpim1,2:jpjm1) 892 hvr_e(2:jpim1,2:jpjm1) = ssvmask(2:jpim1,2:jpjm1) / ( hv_e(2:jpim1,2:jpjm1) + 1._wp - ssvmask(2:jpim1,2:jpjm1) ) 893 ENDIF 894 ! 895 END SUBROUTINE loop_velocity 896 ! 852 897 END SUBROUTINE dyn_spg_ts 853 898 -
NEMO/branches/2021/dev_r14447_HPC-07_Irrmann_try_new_pt2pt/src/OCE/LBC/lbc_lnk_persistent.h90
r14835 r15054 143 143 ! Size of region 144 144 ifldmax = 6 ! 6 arrays updated max in a single call in dynspg_ts, hypothesis : 1 halo in time splitting 145 icount(1:2) = ifldmax * (jp i-2) ! west - east146 icount(3:4) = ifldmax * (jp j-2) ! south - north145 icount(1:2) = ifldmax * (jpj-2) ! west - east 146 icount(3:4) = ifldmax * (jpi-2) ! south - north 147 147 icount(5:8) = ifldmax ! diagonals 148 148 ! … … 185 185 ! ----------------------- ! 186 186 ! 187 CALL MPI_WAITALL( 16, nreq_pers, MPI_STATUSES_IGNORE, ierr)187 CALL MPI_WAITALL( isnd+ircv, nreq_pers, MPI_STATUSES_IGNORE, ierr) 188 188 DO jn = 1, 8 189 189 #define MPI_FILL -
NEMO/branches/2021/dev_r14447_HPC-07_Irrmann_try_new_pt2pt/src/OCE/LBC/lbclnk.F90
r14899 r15054 66 66 PUBLIC lbc_lnk_icb ! iceberg lateral boundary conditions 67 67 68 REAL(dp), DIMENSION(:), ALLOCATABLE :: buffsnd_dp, buffrcv_dp ! MPI send/recv buffers 69 REAL(sp), DIMENSION(:), ALLOCATABLE :: buffsnd_sp, buffrcv_sp ! 68 REAL(sp), DIMENSION(:), ALLOCATABLE :: buffsnd_sp , buffrcv_sp ! MPI send/recv buffers 69 REAL(sp), DIMENSION(:), ALLOCATABLE :: buffsnd_async_sp, buffrcv_async_sp ! MPI send/recv buffers 70 REAL(dp), DIMENSION(:), ALLOCATABLE :: buffsnd_dp , buffrcv_dp ! MPI send/recv buffers 71 REAL(dp), DIMENSION(:), ALLOCATABLE :: buffsnd_async_dp, buffrcv_async_dp ! MPI send/recv buffers 70 72 INTEGER, DIMENSION(8) :: nreq_p2p ! request id for MPI_Isend in point-2-point communication 71 73 … … 153 155 # include "lbc_lnk_oldpt2pt_generic.h90" 154 156 # include "lbc_lnk_neicoll_generic.h90" 157 # undef BUFFSND 158 # undef BUFFRCV 159 # define BUFFSND buffsnd_async_sp 160 # define BUFFRCV buffrcv_async_sp 161 # include "lbc_lnk_pt2pt_async.h90" 162 # undef BUFFSND 163 # undef BUFFRCV 155 164 # include "lbc_lnk_persistent.h90" 156 # include "lbc_lnk_pt2pt_async.h90"157 165 # undef MPI_TYPE 158 # undef BUFFSND159 # undef BUFFRCV160 166 #undef PRECISION 161 167 !! … … 170 176 # include "lbc_lnk_oldpt2pt_generic.h90" 171 177 # include "lbc_lnk_neicoll_generic.h90" 178 # undef BUFFSND 179 # undef BUFFRCV 180 # define BUFFSND buffsnd_async_dp 181 # define BUFFRCV buffrcv_async_dp 182 # include "lbc_lnk_pt2pt_async.h90" 183 # undef BUFFSND 184 # undef BUFFRCV 172 185 # include "lbc_lnk_persistent.h90" 173 # include "lbc_lnk_pt2pt_async.h90"174 186 # undef MPI_TYPE 175 # undef BUFFSND176 # undef BUFFRCV177 187 #undef PRECISION 178 188 -
NEMO/branches/2021/dev_r14447_HPC-07_Irrmann_try_new_pt2pt/src/OCE/LBC/lib_mpp.F90
r14899 r15054 1179 1179 !!---------------------------------------------------------------------- 1180 1180 1181 if ( wp == dp ) then1181 if ( wp == dp ) then 1182 1182 MPI_TYPE = MPI_DOUBLE_PRECISION 1183 else if 1183 else if( wp == sp ) then 1184 1184 MPI_TYPE = MPI_REAL 1185 1185 else … … 1190 1190 ! Size of region 1191 1191 ifldmax = 6 ! 6 arrays updated max in a single call in dynspg_ts 1192 icount(1:2) = ifldmax * (jp i-2) ! west - east1193 icount(3:4) = ifldmax * (jp j-2) ! south - north1192 icount(1:2) = ifldmax * (jpj-2) ! west - east 1193 icount(3:4) = ifldmax * (jpi-2) ! south - north 1194 1194 icount(5:8) = ifldmax ! diagonals 1195 1195 !
Note: See TracChangeset
for help on using the changeset viewer.
