Changeset 10060 for NEMO/branches/2018/dev_r10057_ENHANCE03_ZTILDE
- Timestamp:
- 2018-08-22T11:48:35+02:00 (6 years ago)
- Location:
- NEMO/branches/2018/dev_r10057_ENHANCE03_ZTILDE/src
- Files:
-
- 6 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2018/dev_r10057_ENHANCE03_ZTILDE/src/NST/agrif_oce_update.F90
r9780 r10060 244 244 CALL dom_vvl_interpol( e3t_n(:,:,:), e3u_n(:,:,:) , 'U' ) 245 245 CALL dom_vvl_interpol( e3t_n(:,:,:), e3v_n(:,:,:) , 'V' ) 246 CALL dom_vvl_interpol( e3 u_n(:,:,:), e3f_n(:,:,:) , 'F' )246 CALL dom_vvl_interpol( e3t_n(:,:,:), e3f_n(:,:,:) , 'F' ) 247 247 248 248 CALL dom_vvl_interpol( e3u_n(:,:,:), e3uw_n(:,:,:), 'UW' ) -
NEMO/branches/2018/dev_r10057_ENHANCE03_ZTILDE/src/OCE/DOM/dom_oce.F90
r9667 r10060 145 145 ! ! ref. ! before ! now ! after ! 146 146 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: ht_0 , ht_n !: t-depth [m] 147 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hf_0 !: f-depth [m] 147 148 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hu_0 , hu_b , hu_n , hu_a !: u-depth [m] 148 149 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hv_0 , hv_b , hv_n , hv_a !: v-depth [m] … … 269 270 & e3uw_n(jpi,jpj,jpk) , e3vw_n(jpi,jpj,jpk) , STAT=ierr(5) ) 270 271 ! 271 ALLOCATE( ht_0(jpi,jpj) , hu_0(jpi,jpj) , hv_0(jpi,jpj) , 272 ALLOCATE( ht_0(jpi,jpj) , hu_0(jpi,jpj) , hv_0(jpi,jpj) , hf_0(jpi,jpj) , & 272 273 & hu_b(jpi,jpj) , hv_b(jpi,jpj) , r1_hu_b(jpi,jpj) , r1_hv_b(jpi,jpj) , & 273 274 & ht_n(jpi,jpj) , hu_n(jpi,jpj) , hv_n(jpi,jpj) , r1_hu_n(jpi,jpj) , r1_hv_n(jpi,jpj) , & -
NEMO/branches/2018/dev_r10057_ENHANCE03_ZTILDE/src/OCE/DOM/domain.F90
r9919 r10060 150 150 hu_0(:,:) = 0._wp 151 151 hv_0(:,:) = 0._wp 152 hf_0(:,:) = 0._wp 152 153 DO jk = 1, jpk 153 154 ht_0(:,:) = ht_0(:,:) + e3t_0(:,:,jk) * tmask(:,:,jk) … … 155 156 hv_0(:,:) = hv_0(:,:) + e3v_0(:,:,jk) * vmask(:,:,jk) 156 157 END DO 158 ! 159 DO jj=1, jpjm1 160 DO jk = 1, jpk 161 hf_0(:,jj) = hf_0(:,jj) + e3f_0(:,jj,jk) * umask(:,jj,jk)*umask(:,jj+1,jk) 162 END DO 163 END DO 164 CALL lbc_lnk( hf_0, 'F', 1._wp ) 157 165 ! 158 166 ! !== time varying part of coordinate system ==! -
NEMO/branches/2018/dev_r10057_ENHANCE03_ZTILDE/src/OCE/DOM/domvvl.F90
r9598 r10060 139 139 CALL dom_vvl_interpol( e3t_b(:,:,:), e3v_b(:,:,:), 'V' ) ! from T to V 140 140 CALL dom_vvl_interpol( e3t_n(:,:,:), e3v_n(:,:,:), 'V' ) 141 CALL dom_vvl_interpol( e3 u_n(:,:,:), e3f_n(:,:,:), 'F' ) ! from U to F141 CALL dom_vvl_interpol( e3t_n(:,:,:), e3f_n(:,:,:), 'F' ) ! from U to F 142 142 ! ! Vertical interpolation of e3t,u,v 143 143 CALL dom_vvl_interpol( e3t_n(:,:,:), e3w_n (:,:,:), 'W' ) ! from T to W … … 627 627 ! - JC - hu_b, hv_b, hur_b, hvr_b also 628 628 629 CALL dom_vvl_interpol( e3 u_n(:,:,:), e3f_n(:,:,:), 'F' )629 CALL dom_vvl_interpol( e3t_n(:,:,:), e3f_n(:,:,:), 'F' ) 630 630 631 631 ! Vertical scale factor interpolations … … 689 689 ! ! = 'U', 'V', 'W, 'F', 'UW' or 'VW' 690 690 ! 691 INTEGER :: ji, jj, jk ! dummy loop indices 691 INTEGER :: ji, jj, jk, jkbot ! dummy loop indices 692 INTEGER :: nmet ! horizontal interpolation method 692 693 REAL(wp) :: zlnwd ! =1./0. when ln_wd_il = T/F 693 !!---------------------------------------------------------------------- 694 REAL(wp) :: ztap, zsmall ! Parameters defining minimum thicknesses UVF-points 695 REAL(wp) :: zmin 696 REAL(wp) :: zdo, zup ! Lower and upper interfaces depths anomalies 697 REAL(wp), DIMENSION(jpi,jpj) :: zs ! Surface interface depth anomaly 698 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zw ! Interface depth anomaly 699 !!---------------------------------------------------------------------- 700 ! 701 nmet = 0 ! Original method (Surely wrong) 702 ! nmet = 1 ! Interface interpolation 703 ! nmet = 2 ! Internal interfaces interpolation only, spread barotropic increment 704 ! Note that we kept surface weighted interpolation for barotropic increment to be compliant 705 ! with what is done in surface pressure module. 694 706 ! 695 707 IF(ln_wd_il) THEN … … 699 711 END IF 700 712 ! 713 ztap = 0.0_wp ! Minimum fraction of T-point thickness at cell interfaces 714 zsmall = 1.e-3_wp ! Minimum thickness at U or V points (m) 715 ! 716 IF ( (nmet==1).OR.(nmet==2) ) THEN 717 SELECT CASE ( pout ) 718 ! 719 CASE( 'U', 'V', 'F' ) 720 ! Compute interface depth anomaly at T-points 721 ! 722 zw(:,:,:) = 0._wp 723 ! 724 DO jk=2,jpk 725 zw(:,:,jk) = zw(:,:,jk-1) + pe3_in(:,:,jk-1)*tmask(:,:,jk-1) 726 END DO 727 ! Interface depth anomalies: 728 DO jk=1,jpkm1 729 zw(:,:,jk) = zw(:,:,jk) - zw(:,:,jpk) + ht_0(:,:) 730 END DO 731 zw(:,:,jpk) = ht_0(:,:) 732 ! 733 IF (nmet==2) THEN ! Consider "internal" interfaces only 734 zs(:,:) = - zw(:,:,1) ! Save surface anomaly (ssh) 735 ! 736 DO jj = 1, jpj 737 DO ji = 1, jpi 738 DO jk=1,jpk 739 zw(ji,jj,jk) = (zw(ji,jj,jk) + zs(ji,jj)) & 740 & * ht_0(ji,jj) / (ht_0(ji,jj) + zs(ji,jj) + 1._wp - tmask(ji,jj,1)) & 741 & * tmask(ji,jj,jk) 742 END DO 743 END DO 744 END DO 745 ENDIF 746 ! 747 END SELECT 748 END IF 749 ! 750 pe3_out(:,:,:) = 0.0_wp 751 ! 701 752 SELECT CASE ( pout ) !== type of interpolation ==! 702 753 ! 703 754 CASE( 'U' ) !* from T- to U-point : hor. surface weighted mean 704 DO jk = 1, jpk 755 IF (nmet==0) THEN 756 DO jk = 1, jpk 757 DO jj = 1, jpjm1 758 DO ji = 1, fs_jpim1 ! vector opt. 759 pe3_out(ji,jj,jk) = 0.5_wp * ( umask(ji,jj,jk) * (1.0_wp - zlnwd) + zlnwd ) * r1_e1e2u(ji,jj) & 760 & * ( e1e2t(ji ,jj) * ( pe3_in(ji ,jj,jk) - e3t_0(ji ,jj,jk) ) & 761 & + e1e2t(ji+1,jj) * ( pe3_in(ji+1,jj,jk) - e3t_0(ji+1,jj,jk) ) ) 762 END DO 763 END DO 764 END DO 765 ELSE 705 766 DO jj = 1, jpjm1 706 767 DO ji = 1, fs_jpim1 ! vector opt. 707 pe3_out(ji,jj,jk) = 0.5_wp * ( umask(ji,jj,jk) * (1.0_wp - zlnwd) + zlnwd ) * r1_e1e2u(ji,jj) & 708 & * ( e1e2t(ji ,jj) * ( pe3_in(ji ,jj,jk) - e3t_0(ji ,jj,jk) ) & 709 & + e1e2t(ji+1,jj) * ( pe3_in(ji+1,jj,jk) - e3t_0(ji+1,jj,jk) ) ) 710 END DO 711 END DO 712 END DO 768 ! Correction at last level: 769 jkbot = mbku(ji,jj) 770 zdo = hu_0(ji,jj) 771 DO jk=jkbot,1,-1 772 zup = 0.5_wp * ( zw(ji ,jj,jk) + zw(ji+1,jj,jk) ) 773 ! 774 ! If there is a step, taper bottom interface: 775 IF ((hu_0(ji,jj) < 0.5_wp * ( ht_0(ji,jj) + ht_0(ji+1,jj) ) ).AND.(zup>zdo)) THEN 776 IF ( ht_0(ji+1,jj) < ht_0(ji,jj) ) THEN 777 zmin = ztap * (zw(ji+1,jj,jk+1)-zw(ji+1,jj,jk)) 778 ELSE 779 zmin = ztap * (zw(ji ,jj,jk+1)-zw(ji ,jj,jk)) 780 ENDIF 781 zup = MIN(zup, zdo-zmin) 782 ENDIF 783 zup = MIN(zup, zdo-zsmall) 784 pe3_out(ji,jj,jk) = (zdo - zup - e3u_0(ji,jj,jk)) * ( umask(ji,jj,jk) * (1.0_wp - zlnwd) + zlnwd ) 785 zdo = zup 786 END DO 787 END DO 788 END DO 789 END IF 790 ! 791 IF (nmet==2) THEN ! Spread sea level anomaly 792 DO jj = 1, jpjm1 793 DO ji = 1, fs_jpim1 ! vector opt. 794 DO jk=1,jpk 795 pe3_out(ji,jj,jk) = pe3_out(ji,jj,jk) & 796 & + ( pe3_out(ji,jj,jk) + e3u_0(ji,jj,jk) ) & 797 & / ( hu_0(ji,jj) + 1._wp - umask(ji,jj,1) ) & 798 & * 0.5_wp * r1_e1e2u(ji,jj) & 799 & * ( umask(ji,jj,jk) * (1.0_wp - zlnwd) + zlnwd ) & 800 & * ( e1e2t(ji,jj)*zs(ji,jj) + e1e2t(ji+1,jj)*zs(ji+1,jj) ) 801 END DO 802 END DO 803 END DO 804 ! 805 ENDIF 806 ! 713 807 CALL lbc_lnk( pe3_out(:,:,:), 'U', 1._wp ) 714 808 pe3_out(:,:,:) = pe3_out(:,:,:) + e3u_0(:,:,:) 715 809 ! 716 810 CASE( 'V' ) !* from T- to V-point : hor. surface weighted mean 717 DO jk = 1, jpk 811 IF (nmet==0) THEN 812 DO jk = 1, jpk 813 DO jj = 1, jpjm1 814 DO ji = 1, fs_jpim1 ! vector opt. 815 pe3_out(ji,jj,jk) = 0.5_wp * ( vmask(ji,jj,jk) * (1.0_wp - zlnwd) + zlnwd ) * r1_e1e2v(ji,jj) & 816 & * ( e1e2t(ji,jj ) * ( pe3_in(ji,jj ,jk) - e3t_0(ji,jj ,jk) ) & 817 & + e1e2t(ji,jj+1) * ( pe3_in(ji,jj+1,jk) - e3t_0(ji,jj+1,jk) ) ) 818 END DO 819 END DO 820 END DO 821 ELSE 718 822 DO jj = 1, jpjm1 719 823 DO ji = 1, fs_jpim1 ! vector opt. 720 pe3_out(ji,jj,jk) = 0.5_wp * ( vmask(ji,jj,jk) * (1.0_wp - zlnwd) + zlnwd ) * r1_e1e2v(ji,jj) & 721 & * ( e1e2t(ji,jj ) * ( pe3_in(ji,jj ,jk) - e3t_0(ji,jj ,jk) ) & 722 & + e1e2t(ji,jj+1) * ( pe3_in(ji,jj+1,jk) - e3t_0(ji,jj+1,jk) ) ) 723 END DO 724 END DO 725 END DO 824 ! Correction at last level: 825 jkbot = mbkv(ji,jj) 826 zdo = hv_0(ji,jj) 827 DO jk=jkbot,1,-1 828 zup = 0.5_wp * ( zw(ji,jj ,jk) + zw(ji,jj+1,jk) ) 829 ! 830 ! If there is a step, taper bottom interface: 831 IF ((hv_0(ji,jj) < 0.5_wp * ( ht_0(ji,jj) + ht_0(ji,jj+1) ) ).AND.(zup>zdo)) THEN 832 IF ( ht_0(ji,jj+1) < ht_0(ji,jj) ) THEN 833 zmin = ztap * (zw(ji,jj+1,jk+1)-zw(ji,jj+1,jk)) 834 ELSE 835 zmin = ztap * (zw(ji ,jj,jk+1)-zw(ji ,jj,jk)) 836 ENDIF 837 zup = MIN(zup, zdo-zmin) 838 ENDIF 839 zup = MIN(zup, zdo-zsmall) 840 pe3_out(ji,jj,jk) = (zdo - zup - e3v_0(ji,jj,jk)) * ( vmask(ji,jj,jk) * (1.0_wp - zlnwd) + zlnwd ) 841 zdo = zup 842 END DO 843 END DO 844 END DO 845 END IF 846 ! 847 IF (nmet==2) THEN ! Spread sea level anomaly 848 DO jj = 1, jpjm1 849 DO ji = 1, fs_jpim1 ! vector opt. 850 DO jk=1,jpk 851 pe3_out(ji,jj,jk) = pe3_out(ji,jj,jk) & 852 & + ( pe3_out(ji,jj,jk) + e3v_0(ji,jj,jk) ) & 853 & / ( hv_0(ji,jj) + 1._wp - vmask(ji,jj,1) ) & 854 & * 0.5_wp * r1_e1e2v(ji,jj) & 855 * ( vmask(ji,jj,jk) * (1.0_wp - zlnwd) + zlnwd ) & 856 & * ( e1e2t(ji,jj)*zs(ji,jj) + e1e2t(ji,jj+1)*zs(ji,jj+1) ) 857 END DO 858 END DO 859 END DO 860 ! 861 ENDIF 862 ! 726 863 CALL lbc_lnk( pe3_out(:,:,:), 'V', 1._wp ) 727 864 pe3_out(:,:,:) = pe3_out(:,:,:) + e3v_0(:,:,:) 728 865 ! 729 CASE( 'F' ) !* from U-point to F-point : hor. surface weighted mean 730 DO jk = 1, jpk 866 CASE( 'F' ) !* from T-point to F-point : hor. surface weighted mean 867 IF (nmet==0) THEN 868 DO jk=1,jpk 869 DO jj = 1, jpjm1 870 DO ji = 1, fs_jpim1 ! vector opt. 871 pe3_out(ji,jj,jk) = 0.25_wp * ( umask(ji,jj,jk) * umask(ji,jj+1,jk) * (1.0_wp - zlnwd) + zlnwd ) & 872 & * r1_e1e2f(ji,jj) & 873 & * ( e1e2t(ji ,jj ) * ( pe3_in(ji ,jj ,jk)-e3t_0(ji ,jj ,jk) ) & 874 & + e1e2t(ji ,jj+1) * ( pe3_in(ji ,jj+1,jk)-e3t_0(ji ,jj+1,jk) ) & 875 & + e1e2t(ji+1,jj ) * ( pe3_in(ji+1,jj ,jk)-e3t_0(ji+1,jj ,jk) ) & 876 & + e1e2t(ji+1,jj+1) * ( pe3_in(ji+1,jj+1,jk)-e3t_0(ji+1,jj+1,jk) ) ) 877 END DO 878 END DO 879 END DO 880 ELSE 731 881 DO jj = 1, jpjm1 732 882 DO ji = 1, fs_jpim1 ! vector opt. 733 pe3_out(ji,jj,jk) = 0.5_wp * ( umask(ji,jj,jk) * umask(ji,jj+1,jk) * (1.0_wp - zlnwd) + zlnwd ) & 734 & * r1_e1e2f(ji,jj) & 735 & * ( e1e2u(ji,jj ) * ( pe3_in(ji,jj ,jk) - e3u_0(ji,jj ,jk) ) & 736 & + e1e2u(ji,jj+1) * ( pe3_in(ji,jj+1,jk) - e3u_0(ji,jj+1,jk) ) ) 737 END DO 738 END DO 739 END DO 883 ! bottom correction: 884 jkbot = MIN(mbku(ji,jj), mbku(ji,jj+1)) 885 zdo = hf_0(ji,jj) 886 DO jk=jkbot,1,-1 887 zup = 0.25_wp * ( zw(ji ,jj ,jk) & 888 & + zw(ji+1,jj ,jk) & 889 & + zw(ji ,jj+1,jk) & 890 & + zw(ji+1,jj+1,jk) ) 891 ! 892 ! If there is a step, taper bottom interface: 893 IF ((hf_0(ji,jj) < 0.5_wp * ( hu_0(ji,jj ) + hu_0(ji,jj+1) ) ).AND.(zup>zdo)) THEN 894 IF ( hu_0(ji,jj+1) < hu_0(ji,jj) ) THEN 895 IF ( ht_0(ji+1,jj+1) < ht_0(ji ,jj+1) ) THEN 896 zmin = ztap * (zw(ji+1,jj+1,jk+1)-zw(ji+1,jj+1,jk)) 897 ELSE 898 zmin = ztap * (zw(ji ,jj+1,jk+1)-zw(ji ,jj+1,jk)) 899 ENDIF 900 ELSE 901 IF ( ht_0(ji+1,jj ) < ht_0(ji ,jj ) ) THEN 902 zmin = ztap * (zw(ji+1,jj ,jk+1)-zw(ji+1,jj ,jk)) 903 ELSE 904 zmin = ztap * (zw(ji ,jj ,jk+1)-zw(ji ,jj ,jk)) 905 ENDIF 906 ENDIF 907 zup = MIN(zup, zdo-zmin) 908 ENDIF 909 zup = MIN(zup, zdo-zsmall) 910 ! 911 pe3_out(ji,jj,jk) = ( zdo - zup - e3f_0(ji,jj,jk) ) & 912 & *( umask(ji,jj,jk) * umask(ji,jj+1,jk) * (1.0_wp - zlnwd) + zlnwd ) 913 zdo = zup 914 END DO 915 END DO 916 END DO 917 END IF 918 ! 919 IF (nmet==2) THEN ! Spread sea level anomaly 920 ! 921 DO jj = 1, jpjm1 922 DO ji = 1, fs_jpim1 ! vector opt. 923 DO jk=1,jpk 924 pe3_out(ji,jj,jk) = pe3_out(ji,jj,jk) & 925 & + ( pe3_out(ji,jj,jk) + e3f_0(ji,jj,jk) ) & 926 & / ( hf_0(ji,jj) + 1._wp - umask(ji,jj,1)*umask(ji,jj+1,1) ) & 927 & * 0.25_wp * r1_e1e2f(ji,jj) & 928 & * ( umask(ji,jj,jk)*umask(ji,jj+1,jk)*(1.0_wp - zlnwd) + zlnwd )& 929 & * ( e1e2t(ji ,jj)*zs(ji ,jj) + e1e2t(ji ,jj+1)*zs(ji ,jj+1) & 930 & +e1e2t(ji+1,jj)*zs(ji+1,jj) + e1e2t(ji+1,jj+1)*zs(ji+1,jj+1) ) 931 END DO 932 END DO 933 END DO 934 END IF 935 ! 740 936 CALL lbc_lnk( pe3_out(:,:,:), 'F', 1._wp ) 741 937 pe3_out(:,:,:) = pe3_out(:,:,:) + e3f_0(:,:,:) -
NEMO/branches/2018/dev_r10057_ENHANCE03_ZTILDE/src/OCE/DOM/iscplrst.F90
r9598 r10060 201 201 CALL dom_vvl_interpol( e3t_n(:,:,:), e3u_n(:,:,:), 'U' ) 202 202 CALL dom_vvl_interpol( e3t_n(:,:,:), e3v_n(:,:,:), 'V' ) 203 CALL dom_vvl_interpol( e3 u_n(:,:,:), e3f_n(:,:,:), 'F' )203 CALL dom_vvl_interpol( e3t_n(:,:,:), e3f_n(:,:,:), 'F' ) 204 204 205 205 ! Vertical scale factor interpolations -
NEMO/branches/2018/dev_r10057_ENHANCE03_ZTILDE/src/OCE/SBC/sbcice_cice.F90
r9935 r10060 247 247 CALL dom_vvl_interpol( e3t_n(:,:,:), e3u_n(:,:,:), 'U' ) 248 248 CALL dom_vvl_interpol( e3t_n(:,:,:), e3v_n(:,:,:), 'V' ) 249 CALL dom_vvl_interpol( e3 u_n(:,:,:), e3f_n(:,:,:), 'F' )249 CALL dom_vvl_interpol( e3t_n(:,:,:), e3f_n(:,:,:), 'F' ) 250 250 ! Vertical scale factor interpolations 251 251 ! ------------------------------------
Note: See TracChangeset
for help on using the changeset viewer.