Changeset 14644 for NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/NST/agrif_oce_interp.F90
- Timestamp:
- 2021-03-26T15:33:49+01:00 (3 years ago)
- Location:
- NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final
- Files:
-
- 2 edited
-
. (modified) (1 prop)
-
src/NST/agrif_oce_interp.F90 (modified) (9 diffs)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final
- Property svn:externals
-
old new 9 9 10 10 # SETTE 11 ^/utils/CI/sette _wave@13990sette11 ^/utils/CI/sette@14244 sette
-
- Property svn:externals
-
NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/NST/agrif_oce_interp.F90
r14200 r14644 2 2 !!====================================================================== 3 3 !! *** MODULE agrif_oce_interp *** 4 !! AGRIF: interpolation package for the ocean dynamics (O PA)4 !! AGRIF: interpolation package for the ocean dynamics (OCE) 5 5 !!====================================================================== 6 6 !! History : 2.0 ! 2002-06 (L. Debreu) Original cade … … 109 109 vv(:,:,:,Kbb) = vv(:,:,:,Kbb) * vmask(:,:,:) 110 110 111 CALL lbc_lnk _multi( 'agrif_istate_oce', uu(:,:,: ,Kbb), 'U', -1.0_wp , vv(:,:,:,Kbb), 'V', -1.0_wp )111 CALL lbc_lnk( 'agrif_istate_oce', uu(:,:,: ,Kbb), 'U', -1.0_wp , vv(:,:,:,Kbb), 'V', -1.0_wp ) 112 112 CALL lbc_lnk( 'agrif_istate_oce', ts(:,:,:,:,Kbb), 'T', 1.0_wp ) 113 113 … … 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
Note: See TracChangeset
for help on using the changeset viewer.
