Changeset 14218 for NEMO/trunk/src
- Timestamp:
- 2020-12-18T17:44:52+01:00 (3 years ago)
- Location:
- NEMO/trunk/src/NST
- Files:
-
- 4 edited
-
agrif_oce_interp.F90 (modified) (7 diffs)
-
agrif_oce_sponge.F90 (modified) (2 diffs)
-
agrif_top_interp.F90 (modified) (1 diff)
-
agrif_user.F90 (modified) (2 diffs)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/trunk/src/NST/agrif_oce_interp.F90
r14170 r14218 863 863 ! Build vertical grids: 864 864 N_in = mbkt_parent(ji,jj) 865 ! Input grid (account for partial cells if any): 866 DO jk=1,N_in 867 z_in(jk) = ptab(ji,jj,jk,n2) - ptab(ji,jj,k2,n2) 868 tabin(jk,1:jpts) = ptab(ji,jj,jk,1:jpts) 869 END DO 865 N_out = mbkt(ji,jj) 866 IF (N_in*N_out > 0) THEN 867 ! Input grid (account for partial cells if any): 868 DO jk=1,N_in 869 z_in(jk) = ptab(ji,jj,jk,n2) - ptab(ji,jj,k2,n2) 870 tabin(jk,1:jpts) = ptab(ji,jj,jk,1:jpts) 871 END DO 870 872 871 ! Intermediate grid: 872 IF ( l_vremap ) THEN 873 DO jk = 1, N_in 874 h_in_i(jk) = e3t0_parent(ji,jj,jk) * & 875 & (1._wp + ptab(ji,jj,k2,n2)/(ht0_parent(ji,jj)*ssmask(ji,jj) + 1._wp - ssmask(ji,jj))) 873 ! Intermediate grid: 874 IF ( l_vremap ) THEN 875 DO jk = 1, N_in 876 h_in_i(jk) = e3t0_parent(ji,jj,jk) * & 877 & (1._wp + ptab(ji,jj,k2,n2)/(ht0_parent(ji,jj)*ssmask(ji,jj) + 1._wp - ssmask(ji,jj))) 878 END DO 879 z_in_i(1) = 0.5_wp * h_in_i(1) 880 DO jk=2,N_in 881 z_in_i(jk) = z_in_i(jk-1) + 0.5_wp * ( h_in_i(jk) + h_in_i(jk-1) ) 882 END DO 883 z_in_i(1:N_in) = z_in_i(1:N_in) - ptab(ji,jj,k2,n2) 884 ENDIF 885 886 ! Output (Child) grid: 887 DO jk=1,N_out 888 h_out(jk) = e3t(ji,jj,jk,Krhs_a) 876 889 END DO 877 z_ in_i(1) = 0.5_wp * h_in_i(1)878 DO jk=2,N_ in879 z_ in_i(jk) = z_in_i(jk-1) + 0.5_wp * ( h_in_i(jk) + h_in_i(jk-1) )890 z_out(1) = 0.5_wp * h_out(1) 891 DO jk=2,N_out 892 z_out(jk) = z_out(jk-1) + 0.5_wp * ( h_out(jk)+h_out(jk-1) ) 880 893 END DO 881 z_in_i(1:N_in) = z_in_i(1:N_in) - ptab(ji,jj,k2,n2) 882 ENDIF 883 884 ! Output (Child) grid: 885 N_out = mbkt(ji,jj) 886 DO jk=1,N_out 887 h_out(jk) = e3t(ji,jj,jk,Krhs_a) 888 END DO 889 z_out(1) = 0.5_wp * h_out(1) 890 DO jk=2,N_out 891 z_out(jk) = z_out(jk-1) + 0.5_wp * ( h_out(jk)+h_out(jk-1) ) 892 END DO 893 IF (.NOT.ln_linssh) z_out(1:N_out) = z_out(1:N_out) - ssh(ji,jj,Krhs_a) 894 895 IF (N_in*N_out > 0) THEN 894 IF (.NOT.ln_linssh) z_out(1:N_out) = z_out(1:N_out) - ssh(ji,jj,Krhs_a) 895 896 896 IF( l_ini_child ) THEN 897 897 CALL remap_linear(tabin(1:N_in,1:jpts),z_in(1:N_in),ts(ji,jj,1:N_out,1:jpts,Krhs_a), & … … 1040 1040 uu(ji,jj,:,Krhs_a) = 0._wp 1041 1041 N_in = mbku_parent(ji,jj) 1042 zhtot = 0._wp 1043 DO jk=1,N_in 1044 !IF (jk==N_in) THEN 1045 ! h_in(jk) = hu0_parent(ji,jj) + ptab(ji,jj,k2,2) - zhtot 1046 !ELSE 1047 ! h_in(jk) = ptab(ji,jj,jk,2)/(e2u(ji,jj)*zrhoy) 1048 !ENDIF 1049 IF ( l_vremap ) THEN 1050 h_in(jk) = e3u0_parent(ji,jj,jk) 1051 ELSE 1052 IF (jk==N_in) THEN 1053 h_in(jk) = hu0_parent(ji,jj) + ptab(ji,jj,k2,2) - zhtot 1042 N_out = mbku(ji,jj) 1043 IF (N_in*N_out > 0) THEN 1044 zhtot = 0._wp 1045 DO jk=1,N_in 1046 !IF (jk==N_in) THEN 1047 ! h_in(jk) = hu0_parent(ji,jj) + ptab(ji,jj,k2,2) - zhtot 1048 !ELSE 1049 ! h_in(jk) = ptab(ji,jj,jk,2)/(e2u(ji,jj)*zrhoy) 1050 !ENDIF 1051 IF ( l_vremap ) THEN 1052 h_in(jk) = e3u0_parent(ji,jj,jk) 1054 1053 ELSE 1055 h_in(jk) = ptab(ji,jj,jk,2)/(e2u(ji,jj)*zrhoy) 1054 IF (jk==N_in) THEN 1055 h_in(jk) = hu0_parent(ji,jj) + ptab(ji,jj,k2,2) - zhtot 1056 ELSE 1057 h_in(jk) = ptab(ji,jj,jk,2)/(e2u(ji,jj)*zrhoy) 1058 ENDIF 1056 1059 ENDIF 1057 ENDIF 1058 zhtot = zhtot + h_in(jk) 1059 IF( h_in(jk) .GT. 0. ) THEN 1060 tabin(jk) = ptab(ji,jj,jk,1)/(e2u(ji,jj)*zrhoy*h_in(jk)) 1061 ELSE 1062 tabin(jk) = 0. 1063 ENDIF 1064 END DO 1065 z_in(1) = 0.5_wp * h_in(1) - zhtot + hu0_parent(ji,jj) 1066 DO jk=2,N_in 1067 z_in(jk) = z_in(jk-1) + 0.5_wp * (h_in(jk)+h_in(jk-1)) 1068 END DO 1060 zhtot = zhtot + h_in(jk) 1061 IF( h_in(jk) .GT. 0. ) THEN 1062 tabin(jk) = ptab(ji,jj,jk,1)/(e2u(ji,jj)*zrhoy*h_in(jk)) 1063 ELSE 1064 tabin(jk) = 0. 1065 ENDIF 1066 END DO 1067 z_in(1) = 0.5_wp * h_in(1) - zhtot + hu0_parent(ji,jj) 1068 DO jk=2,N_in 1069 z_in(jk) = z_in(jk-1) + 0.5_wp * (h_in(jk)+h_in(jk-1)) 1070 END DO 1069 1071 1070 N_out = 0 1071 DO jk=1,jpk 1072 IF (umask(ji,jj,jk) == 0) EXIT 1073 N_out = N_out + 1 1074 h_out(N_out) = e3u(ji,jj,jk,Krhs_a) 1075 END DO 1076 1077 z_out(1) = 0.5_wp * h_out(1) - SUM(h_out(1:N_out)) + hu_0(ji,jj) 1078 DO jk=2,N_out 1079 z_out(jk) = z_out(jk-1) + 0.5_wp * (h_out(jk-1) + h_out(jk)) 1080 END DO 1081 1082 IF (N_in*N_out > 0) THEN 1083 IF( l_ini_child ) THEN 1084 CALL remap_linear (tabin(1:N_in),z_in(1:N_in),uu(ji,jj,1:N_out,Krhs_a),z_out(1:N_out),N_in,N_out,1) 1085 ELSE 1086 CALL reconstructandremap(tabin(1:N_in),h_in(1:N_in),uu(ji,jj,1:N_out,Krhs_a),h_out(1:N_out),N_in,N_out,1) 1087 ENDIF 1072 DO jk=1, N_out 1073 h_out(jk) = e3u(ji,jj,jk,Krhs_a) 1074 END DO 1075 1076 z_out(1) = 0.5_wp * h_out(1) - SUM(h_out(1:N_out)) + hu_0(ji,jj) 1077 DO jk=2,N_out 1078 z_out(jk) = z_out(jk-1) + 0.5_wp * (h_out(jk-1) + h_out(jk)) 1079 END DO 1080 1081 IF( l_ini_child ) THEN 1082 CALL remap_linear (tabin(1:N_in),z_in(1:N_in),uu(ji,jj,1:N_out,Krhs_a),z_out(1:N_out),N_in,N_out,1) 1083 ELSE 1084 CALL reconstructandremap(tabin(1:N_in),h_in(1:N_in),uu(ji,jj,1:N_out,Krhs_a),h_out(1:N_out),N_in,N_out,1) 1085 ENDIF 1088 1086 ENDIF 1089 1087 END DO … … 1171 1169 vv(ji,jj,:,Krhs_a) = 0._wp 1172 1170 N_in = mbkv_parent(ji,jj) 1173 zhtot = 0._wp1174 DO jk=1,N_in 1175 !IF (jk==N_in) THEN1176 ! h_in(jk) = hv0_parent(ji,jj) + ptab(ji,jj,k2,2) - zhtot1177 !ELSE1178 ! h_in(jk) = ptab(ji,jj,jk,2)/(e1v(ji,jj)*zrhox)1179 !ENDIF1180 IF (l_vremap) THEN1181 h_in(jk) = e3v0_parent(ji,jj,jk)1182 ELSE1183 IF ( jk==N_in) THEN1184 h_in(jk) = hv0_parent(ji,jj) + ptab(ji,jj,k2,2) - zhtot1171 N_out = mbkv(ji,jj) 1172 1173 IF (N_in*N_out > 0) THEN 1174 zhtot = 0._wp 1175 DO jk=1,N_in 1176 !IF (jk==N_in) THEN 1177 ! h_in(jk) = hv0_parent(ji,jj) + ptab(ji,jj,k2,2) - zhtot 1178 !ELSE 1179 ! h_in(jk) = ptab(ji,jj,jk,2)/(e1v(ji,jj)*zrhox) 1180 !ENDIF 1181 IF (l_vremap) THEN 1182 h_in(jk) = e3v0_parent(ji,jj,jk) 1185 1183 ELSE 1186 h_in(jk) = ptab(ji,jj,jk,2)/(e1v(ji,jj)*zrhox) 1184 IF (jk==N_in) THEN 1185 h_in(jk) = hv0_parent(ji,jj) + ptab(ji,jj,k2,2) - zhtot 1186 ELSE 1187 h_in(jk) = ptab(ji,jj,jk,2)/(e1v(ji,jj)*zrhox) 1188 ENDIF 1187 1189 ENDIF 1188 ENDIF 1189 zhtot = zhtot + h_in(jk) 1190 IF( h_in(jk) .GT. 0. ) THEN 1191 tabin(jk) = ptab(ji,jj,jk,1)/(e1v(ji,jj)*zrhox*h_in(jk)) 1192 ELSE 1193 tabin(jk) = 0. 1194 ENDIF 1195 END DO 1196 1197 z_in(1) = 0.5_wp * h_in(1) - zhtot + hv0_parent(ji,jj) 1198 DO jk=2,N_in 1199 z_in(jk) = z_in(jk-1) + 0.5_wp * (h_in(jk-1)+h_in(jk)) 1200 END DO 1201 1202 N_out = 0 1203 DO jk=1,jpk 1204 IF (vmask(ji,jj,jk) == 0) EXIT 1205 N_out = N_out + 1 1206 h_out(N_out) = e3v(ji,jj,jk,Krhs_a) 1207 END DO 1208 1209 z_out(1) = 0.5_wp * h_out(1) - SUM(h_out(1:N_out)) + hv_0(ji,jj) 1210 DO jk=2,N_out 1211 z_out(jk) = z_out(jk-1) + 0.5_wp * (h_out(jk-1)+h_out(jk)) 1212 END DO 1190 zhtot = zhtot + h_in(jk) 1191 IF( h_in(jk) .GT. 0. ) THEN 1192 tabin(jk) = ptab(ji,jj,jk,1)/(e1v(ji,jj)*zrhox*h_in(jk)) 1193 ELSE 1194 tabin(jk) = 0. 1195 ENDIF 1196 END DO 1197 1198 z_in(1) = 0.5_wp * h_in(1) - zhtot + hv0_parent(ji,jj) 1199 DO jk=2,N_in 1200 z_in(jk) = z_in(jk-1) + 0.5_wp * (h_in(jk-1)+h_in(jk)) 1201 END DO 1202 1203 DO jk=1,N_out 1204 h_out(jk) = e3v(ji,jj,jk,Krhs_a) 1205 END DO 1206 1207 z_out(1) = 0.5_wp * h_out(1) - SUM(h_out(1:N_out)) + hv_0(ji,jj) 1208 DO jk=2,N_out 1209 z_out(jk) = z_out(jk-1) + 0.5_wp * (h_out(jk-1)+h_out(jk)) 1210 END DO 1213 1211 1214 IF (N_in*N_out > 0) THEN1215 1212 IF( l_ini_child ) THEN 1216 1213 CALL remap_linear (tabin(1:N_in),z_in(1:N_in),vv(ji,jj,1:N_out,Krhs_a),z_out(1:N_out),N_in,N_out,1) … … 1560 1557 & ptab(ji,jj,jk), tmask(ji,jj,jk) * e3t_0(ji,jj,jk), & 1561 1558 & mig0(ji), mjg0(jj), jk 1562 !kindic_agr = kindic_agr + 11559 kindic_agr = kindic_agr + 1 1563 1560 ENDIF 1564 1561 END DO … … 1703 1700 1704 1701 IF( l_vremap ) THEN 1705 ! Interpolate thicknesses1702 ! Interpolate interfaces 1706 1703 ! Warning: these are masked, hence extrapolated prior interpolation. 1707 1704 DO jk=k1,k2 1708 1705 DO jj=j1,j2 1709 1706 DO ji=i1,i2 1710 ptab(ji,jj,jk,2) = tmask(ji,jj,jk) * e3t(ji,jj,jk,Kmm_a)1707 ptab(ji,jj,jk,2) = tmask(ji,jj,jk) * gdepw(ji,jj,jk,Kmm_a) 1711 1708 END DO 1712 1709 END DO 1713 1710 END DO 1714 1715 ! Extrapolate thicknesses in partial bottom cells:1716 ! Set them to Agrif_SpecialValue (0.). Correct bottom thicknesses are retrieved later on1717 IF (ln_zps) THEN1718 DO jj=j1,j21719 DO ji=i1,i21720 jk = mbkt(ji,jj)1721 ptab(ji,jj,jk,2) = 0._wp1722 END DO1723 END DO1724 END IF1725 1711 1726 1712 ! Save ssh at last level: … … 1736 1722 IF( l_vremap ) THEN 1737 1723 IF (ln_linssh) ptab(i1:i2,j1:j2,k2,2) = 0._wp 1738 avm_k(i1:i2,j1:j2, k1:k2) = 0._wp1724 avm_k(i1:i2,j1:j2,1:jpkm1) = 0._wp 1739 1725 1740 1726 DO jj = j1, j2 1741 1727 DO ji =i1, i2 1742 1728 N_in = mbkt_parent(ji,jj) 1743 IF ( tmask(ji,jj,1) == 0._wp) N_in = 0 1744 z_in(N_in+1) = ht0_parent(ji,jj) + ptab(ji,jj,k2,2) 1745 DO jk = N_in, 1, -1 ! Parent vertical grid 1746 z_in(jk) = z_in(jk+1) - ptab(ji,jj,jk,2) 1747 tabin(jk) = ptab(ji,jj,jk,1) 1748 END DO 1749 N_out = mbkt(ji,jj) 1750 DO jk = 1, N_out ! Child vertical grid 1751 z_out(jk) = gdepw(ji,jj,jk,Kmm_a) 1752 END DO 1729 N_out = mbkt(ji,jj) 1753 1730 IF (N_in*N_out > 0) THEN 1731 DO jk = 1, N_in ! Parent vertical grid 1732 z_in(jk) = ptab(ji,jj,jk,2) - ptab(ji,jj,k2,2) 1733 tabin(jk) = ptab(ji,jj,jk,1) 1734 END DO 1735 DO jk = 1, N_out ! Child vertical grid 1736 z_out(jk) = gdepw(ji,jj,jk,Kmm_a) - ssh(ji,jj,Kmm_a) 1737 END DO 1738 IF (.NOT.ln_linssh) z_out(1:N_out) = z_out(1:N_out) - ssh(ji,jj,Kmm_a) 1739 1754 1740 CALL remap_linear(tabin(1:N_in),z_in(1:N_in),avm_k(ji,jj,1:N_out),z_out(1:N_out),N_in,N_out,1) 1755 1741 ENDIF … … 1757 1743 END DO 1758 1744 ELSE 1759 avm_k(i1:i2,j1:j2, k1:k2) = ptab (i1:i2,j1:j2,k1:k2,1)1745 avm_k(i1:i2,j1:j2,1:jpkm1) = ptab (i1:i2,j1:j2,1:jpkm1,1) 1760 1746 ENDIF 1761 1747 ENDIF -
NEMO/trunk/src/NST/agrif_oce_sponge.F90
r14170 r14218 658 658 tabres_child(ji,jj,:) = 0._wp 659 659 N_in = mbku_parent(ji,jj) 660 zhtot = 0._wp 661 DO jk=1,N_in 662 !IF (jk==N_in) THEN 663 ! h_in(jk) = hu0_parent(ji,jj) + tabres(ji,jj,k2,m2) - zhtot 664 !ELSE 665 ! h_in(jk) = tabres(ji,jj,jk,m2) 666 !ENDIF 667 h_in(jk) = e3u0_parent(ji,jj,jk) 668 zhtot = zhtot + h_in(jk) 669 tabin(jk) = tabres(ji,jj,jk,m1) 670 END DO 671 ! 672 N_out = 0 673 DO jk=1,jpk 674 IF (umask(ji,jj,jk) == 0) EXIT 675 N_out = N_out + 1 676 h_out(N_out) = e3u(ji,jj,jk,Kbb_a) 677 END DO 678 679 ! Account for small differences in free-surface 680 IF ( sum(h_out(1:N_out)) > sum(h_in(1:N_in) )) THEN 681 h_out(1) = h_out(1) - ( sum(h_out(1:N_out))-sum(h_in(1:N_in)) ) 682 ELSE 683 h_in(1) = h_in(1) - (sum(h_in(1:N_in))-sum(h_out(1:N_out)) ) 684 ENDIF 660 N_out = mbku(ji,jj) 661 IF (N_in * N_out > 0) THEN 662 zhtot = 0._wp 663 DO jk=1,N_in 664 !IF (jk==N_in) THEN 665 ! h_in(jk) = hu0_parent(ji,jj) + tabres(ji,jj,k2,m2) - zhtot 666 !ELSE 667 ! h_in(jk) = tabres(ji,jj,jk,m2) 668 !ENDIF 669 h_in(jk) = e3u0_parent(ji,jj,jk) 670 zhtot = zhtot + h_in(jk) 671 tabin(jk) = tabres(ji,jj,jk,m1) 672 END DO 673 ! 674 DO jk=1,N_out 675 h_out(jk) = e3u(ji,jj,jk,Kbb_a) 676 END DO 677 678 ! Account for small differences in free-surface 679 IF ( sum(h_out(1:N_out)) > sum(h_in(1:N_in) )) THEN 680 h_out(1) = h_out(1) - ( sum(h_out(1:N_out))-sum(h_in(1:N_in)) ) 681 ELSE 682 h_in(1) = h_in(1) - (sum(h_in(1:N_in))-sum(h_out(1:N_out)) ) 683 ENDIF 685 684 686 IF (N_in * N_out > 0) THEN687 685 CALL reconstructandremap(tabin(1:N_in),h_in(1:N_in),tabres_child(ji,jj,1:N_out),h_out(1:N_out),N_in,N_out,1) 688 686 ENDIF … … 843 841 tabres_child(ji,jj,:) = 0._wp 844 842 N_in = mbkv_parent(ji,jj) 845 zhtot = 0._wp 846 DO jk=1,N_in 847 !IF (jk==N_in) THEN 848 ! h_in(jk) = hv0_parent(ji,jj) + tabres(ji,jj,k2,m2) - zhtot 849 !ELSE 850 ! h_in(jk) = tabres(ji,jj,jk,m2) 851 !ENDIF 852 h_in(jk) = e3v0_parent(ji,jj,jk) 853 zhtot = zhtot + h_in(jk) 854 tabin(jk) = tabres(ji,jj,jk,m1) 855 END DO 856 ! 857 N_out = 0 858 DO jk=1,jpk 859 IF (vmask(ji,jj,jk) == 0) EXIT 860 N_out = N_out + 1 861 h_out(N_out) = e3v(ji,jj,jk,Kbb_a) 862 END DO 863 864 ! Account for small differences in free-surface 865 IF ( sum(h_out(1:N_out)) > sum(h_in(1:N_in) )) THEN 866 h_out(1) = h_out(1) - ( sum(h_out(1:N_out))-sum(h_in(1:N_in)) ) 867 ELSE 868 h_in(1) = h_in(1) - ( sum(h_in(1:N_in))-sum(h_out(1:N_out)) ) 869 ENDIF 843 N_out = mbkv(ji,jj) 844 IF (N_in * N_out > 0) THEN 845 zhtot = 0._wp 846 DO jk=1,N_in 847 !IF (jk==N_in) THEN 848 ! h_in(jk) = hv0_parent(ji,jj) + tabres(ji,jj,k2,m2) - zhtot 849 !ELSE 850 ! h_in(jk) = tabres(ji,jj,jk,m2) 851 !ENDIF 852 h_in(jk) = e3v0_parent(ji,jj,jk) 853 zhtot = zhtot + h_in(jk) 854 tabin(jk) = tabres(ji,jj,jk,m1) 855 END DO 856 ! 857 DO jk=1,N_out 858 h_out(jk) = e3v(ji,jj,jk,Kbb_a) 859 END DO 860 861 ! Account for small differences in free-surface 862 IF ( sum(h_out(1:N_out)) > sum(h_in(1:N_in) )) THEN 863 h_out(1) = h_out(1) - ( sum(h_out(1:N_out))-sum(h_in(1:N_in)) ) 864 ELSE 865 h_in(1) = h_in(1) - ( sum(h_in(1:N_in))-sum(h_out(1:N_out)) ) 866 ENDIF 870 867 871 IF (N_in * N_out > 0) THEN872 868 CALL reconstructandremap(tabin(1:N_in),h_in(1:N_in),tabres_child(ji,jj,1:N_out),h_out(1:N_out),N_in,N_out,1) 869 873 870 ENDIF 874 871 END DO -
NEMO/trunk/src/NST/agrif_top_interp.F90
r14148 r14218 120 120 ! Build vertical grids: 121 121 N_in = mbkt_parent(ji,jj) 122 ! Input grid (account for partial cells if any): 123 DO jk=1,N_in 124 z_in(jk) = ptab(ji,jj,jk,n2) - ptab(ji,jj,k2,n2) 125 tabin(jk,1:jptra) = ptab(ji,jj,jk,1:jptra) 126 END DO 122 N_out = mbkt(ji,jj) 123 IF (N_in*N_out > 0) THEN 124 ! Input grid (account for partial cells if any): 125 DO jk=1,N_in 126 z_in(jk) = ptab(ji,jj,jk,n2) - ptab(ji,jj,k2,n2) 127 tabin(jk,1:jptra) = ptab(ji,jj,jk,1:jptra) 128 END DO 127 129 128 ! Intermediate grid: 129 IF ( l_vremap ) THEN 130 DO jk = 1, N_in 131 h_in_i(jk) = e3t0_parent(ji,jj,jk) * & 132 & (1._wp + ptab(ji,jj,k2,n2)/(ht0_parent(ji,jj)*ssmask(ji,jj) + 1._wp - ssmask(ji,jj))) 133 END DO 134 z_in_i(1) = 0.5_wp * h_in_i(1) 135 DO jk=2,N_in 136 z_in_i(jk) = z_in_i(jk-1) + 0.5_wp * ( h_in_i(jk) + h_in_i(jk-1) ) 137 END DO 138 z_in_i(1:N_in) = z_in_i(1:N_in) - ptab(ji,jj,k2,n2) 139 ENDIF 140 141 ! Output (Child) grid: 142 N_out = mbkt(ji,jj) 143 DO jk=1,N_out 144 h_out(jk) = e3t(ji,jj,jk,Krhs_a) 145 END DO 146 z_out(1) = 0.5_wp * h_out(1) 147 DO jk=2,N_out 148 z_out(jk) = z_out(jk-1) + 0.5_wp * ( h_out(jk)+h_out(jk-1) ) 149 END DO 150 IF (.NOT.ln_linssh) z_out(1:N_out) = z_out(1:N_out) - ssh(ji,jj,Krhs_a) 151 152 IF (N_in*N_out > 0) THEN 130 ! Intermediate grid: 131 IF ( l_vremap ) THEN 132 DO jk = 1, N_in 133 h_in_i(jk) = e3t0_parent(ji,jj,jk) * & 134 & (1._wp + ptab(ji,jj,k2,n2)/(ht0_parent(ji,jj)*ssmask(ji,jj) + 1._wp - ssmask(ji,jj))) 135 END DO 136 z_in_i(1) = 0.5_wp * h_in_i(1) 137 DO jk=2,N_in 138 z_in_i(jk) = z_in_i(jk-1) + 0.5_wp * ( h_in_i(jk) + h_in_i(jk-1) ) 139 END DO 140 z_in_i(1:N_in) = z_in_i(1:N_in) - ptab(ji,jj,k2,n2) 141 ENDIF 142 143 ! Output (Child) grid: 144 DO jk=1,N_out 145 h_out(jk) = e3t(ji,jj,jk,Krhs_a) 146 END DO 147 z_out(1) = 0.5_wp * h_out(1) 148 DO jk=2,N_out 149 z_out(jk) = z_out(jk-1) + 0.5_wp * ( h_out(jk)+h_out(jk-1) ) 150 END DO 151 IF (.NOT.ln_linssh) z_out(1:N_out) = z_out(1:N_out) - ssh(ji,jj,Krhs_a) 152 153 153 IF( l_ini_child ) THEN 154 154 CALL remap_linear(tabin(1:N_in,1:jptra),z_in(1:N_in),tr(ji,jj,1:N_out,1:jptra,Krhs_a), & -
NEMO/trunk/src/NST/agrif_user.F90
r14170 r14218 272 272 273 273 CALL Agrif_check_bat( kindic_agr ) 274 275 CALL mpp_sum( 'agrif_InitValues_Domain', kindic_agr )276 IF( kindic_agr /= 0 ) THEN277 CALL ctl_stop('==> Child Bathymetry is NOT correct near boundaries.')278 ELSE279 IF(lwp) WRITE(numout,*) '==> Child Bathymetry is ok near boundaries.'280 IF(lwp) WRITE(numout,*) ' '281 ENDIF282 274 ENDIF 275 ! 276 CALL mpp_sum( 'agrif_InitValues_Domain', kindic_agr ) 277 IF( kindic_agr /= 0 ) THEN 278 CALL ctl_stop('==> Child Bathymetry is NOT correct near boundaries.') 279 ELSE 280 IF(lwp) WRITE(numout,*) '==> Child Bathymetry is ok near boundaries.' 281 IF(lwp) WRITE(numout,*) ' ' 282 ENDIF 283 283 ENDIF 284 284 ! … … 532 532 CALL Agrif_Set_bc( ub2b_cor_id, (/-imaxrho*nn_shift_bar,ind1/) ) 533 533 CALL Agrif_Set_bc( vb2b_cor_id, (/-imaxrho*nn_shift_bar,ind1/) ) 534 IF( ln_zdftke.OR.ln_zdfgls ) CALL Agrif_Set_bc( avm_id, (/0,ind1 /) )534 IF( ln_zdftke.OR.ln_zdfgls ) CALL Agrif_Set_bc( avm_id, (/0,ind1-1/) ) 535 535 !!$ CALL Agrif_Set_bc(glamt_id, (/0,ind1-1/) ) 536 536 !!$ CALL Agrif_Set_bc(gphit_id, (/0,ind1-1/) )
Note: See TracChangeset
for help on using the changeset viewer.
