- Timestamp:
- 2019-09-20T17:28:02+02:00 (5 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2019/dev_r11265_ASINTER-01_Guillaume_ABL1D/src/ICE/icevar.F90
r11413 r11586 47 47 !! ice_var_zapneg : remove negative ice fields 48 48 !! ice_var_roundoff : remove negative values arising from roundoff erros 49 !! ice_var_itd : convert N-cat to M-cat50 49 !! ice_var_bv : brine volume 51 50 !! ice_var_enthalpy : compute ice and snow enthalpies from temperature 52 51 !! ice_var_sshdyn : compute equivalent ssh in lead 52 !! ice_var_itd : convert N-cat to M-cat 53 53 !!---------------------------------------------------------------------- 54 54 USE dom_oce ! ocean space and time domain … … 115 115 ! 116 116 ato_i(:,:) = 1._wp - at_i(:,:) ! open water fraction 117 ! 118 ALLOCATE( z1_at_i(jpi,jpj) ) 119 WHERE( at_i(:,:) > epsi20 ) ; z1_at_i(:,:) = 1._wp / at_i(:,:) 120 ELSEWHERE ; z1_at_i(:,:) = 0._wp 121 END WHERE 122 ! 123 tm_su(:,:) = SUM( t_su(:,:,:) * a_i(:,:,:) , dim=3 ) * z1_at_i(:,:) 124 WHERE( at_i(:,:)<=epsi20 ); tm_su(:,:) = rt0; END WHERE 125 ! 117 126 118 ! The following fields are calculated for diagnostics and outputs only 127 119 ! ==> Do not use them for other purposes 128 120 IF( kn > 1 ) THEN 129 121 ! 130 ALLOCATE( z1_vt_i(jpi,jpj) , z1_vt_s(jpi,jpj) ) 122 ALLOCATE( z1_at_i(jpi,jpj) , z1_vt_i(jpi,jpj) , z1_vt_s(jpi,jpj) ) 123 WHERE( at_i(:,:) > epsi20 ) ; z1_at_i(:,:) = 1._wp / at_i(:,:) 124 ELSEWHERE ; z1_at_i(:,:) = 0._wp 125 END WHERE 131 126 WHERE( vt_i(:,:) > epsi20 ) ; z1_vt_i(:,:) = 1._wp / vt_i(:,:) 132 127 ELSEWHERE ; z1_vt_i(:,:) = 0._wp … … 141 136 ! 142 137 ! ! mean temperature (K), salinity and age 138 tm_su(:,:) = SUM( t_su(:,:,:) * a_i(:,:,:) , dim=3 ) * z1_at_i(:,:) 143 139 tm_si(:,:) = SUM( t_si(:,:,:) * a_i(:,:,:) , dim=3 ) * z1_at_i(:,:) 144 140 om_i (:,:) = SUM( oa_i(:,:,:) , dim=3 ) * z1_at_i(:,:) … … 158 154 ! ! put rt0 where there is no ice 159 155 WHERE( at_i(:,:)<=epsi20 ) 156 tm_su(:,:) = rt0 160 157 tm_si(:,:) = rt0 161 158 tm_i (:,:) = rt0 162 159 tm_s (:,:) = rt0 163 160 END WHERE 164 165 DEALLOCATE( z1_vt_i , z1_vt_s ) 161 ! 162 ! ! mean melt pond depth 163 WHERE( at_ip(:,:) > epsi20 ) ; hm_ip(:,:) = vt_ip(:,:) / at_ip(:,:) 164 ELSEWHERE ; hm_ip(:,:) = 0._wp 165 END WHERE 166 ! 167 DEALLOCATE( z1_at_i , z1_vt_i , z1_vt_s ) 168 ! 166 169 ENDIF 167 !168 DEALLOCATE( z1_at_i )169 170 ! 170 171 END SUBROUTINE ice_var_agg … … 664 665 WHERE( pe_i (1:npti,:,:) < 0._wp .AND. pe_i (1:npti,:,:) > -epsi06 ) pe_i (1:npti,:,:) = 0._wp ! e_i must be >= 0 665 666 WHERE( pe_s (1:npti,:,:) < 0._wp .AND. pe_s (1:npti,:,:) > -epsi06 ) pe_s (1:npti,:,:) = 0._wp ! e_s must be >= 0 666 IF 667 IF( ln_pnd_H12 ) THEN 667 668 WHERE( pa_ip(1:npti,:) < 0._wp .AND. pa_ip(1:npti,:) > -epsi10 ) pa_ip(1:npti,:) = 0._wp ! a_ip must be >= 0 668 669 WHERE( pv_ip(1:npti,:) < 0._wp .AND. pv_ip(1:npti,:) > -epsi10 ) pv_ip(1:npti,:) = 0._wp ! v_ip must be >= 0 … … 785 786 !! ** Purpose : converting N-cat ice to jpl ice categories 786 787 !!------------------------------------------------------------------- 787 SUBROUTINE ice_var_itd_1c1c( phti, phts, pati , ph_i, ph_s, pa_i, &788 & ptmi, ptms, ptmsu, psmi, p t_i, pt_s, pt_su, ps_i)788 SUBROUTINE ice_var_itd_1c1c( phti, phts, pati , ph_i, ph_s, pa_i, & 789 & ptmi, ptms, ptmsu, psmi, patip, phtip, pt_i, pt_s, pt_su, ps_i, pa_ip, ph_ip ) 789 790 !!------------------------------------------------------------------- 790 791 !! ** Purpose : converting 1-cat ice to 1 ice category … … 792 793 REAL(wp), DIMENSION(:), INTENT(in) :: phti, phts, pati ! input ice/snow variables 793 794 REAL(wp), DIMENSION(:), INTENT(inout) :: ph_i, ph_s, pa_i ! output ice/snow variables 794 REAL(wp), DIMENSION(:), INTENT(in) , OPTIONAL :: ptmi, ptms, ptmsu, psmi ! input ice/snow temp & sal795 REAL(wp), DIMENSION(:), INTENT(inout) , OPTIONAL :: pt_i, pt_s, pt_su, ps_i ! output ice/snow temp & sal795 REAL(wp), DIMENSION(:), INTENT(in) :: ptmi, ptms, ptmsu, psmi, patip, phtip ! input ice/snow temp & sal & ponds 796 REAL(wp), DIMENSION(:), INTENT(inout) :: pt_i, pt_s, pt_su, ps_i, pa_ip, ph_ip ! output ice/snow temp & sal & ponds 796 797 !!------------------------------------------------------------------- 797 798 ! == thickness and concentration == ! … … 800 801 pa_i(:) = pati(:) 801 802 ! 802 ! == temperature and salinity == ! 803 IF( PRESENT( pt_i ) ) pt_i (:) = ptmi (:) 804 IF( PRESENT( pt_s ) ) pt_s (:) = ptms (:) 805 IF( PRESENT( pt_su ) ) pt_su(:) = ptmsu(:) 806 IF( PRESENT( ps_i ) ) ps_i (:) = psmi (:) 803 ! == temperature and salinity and ponds == ! 804 pt_i (:) = ptmi (:) 805 pt_s (:) = ptms (:) 806 pt_su(:) = ptmsu(:) 807 ps_i (:) = psmi (:) 808 pa_ip(:) = patip(:) 809 ph_ip(:) = phtip(:) 807 810 808 811 END SUBROUTINE ice_var_itd_1c1c 809 812 810 SUBROUTINE ice_var_itd_Nc1c( phti, phts, pati , ph_i, ph_s, pa_i, &811 & ptmi, ptms, ptmsu, psmi, p t_i, pt_s, pt_su, ps_i)813 SUBROUTINE ice_var_itd_Nc1c( phti, phts, pati , ph_i, ph_s, pa_i, & 814 & ptmi, ptms, ptmsu, psmi, patip, phtip, pt_i, pt_s, pt_su, ps_i, pa_ip, ph_ip ) 812 815 !!------------------------------------------------------------------- 813 816 !! ** Purpose : converting N-cat ice to 1 ice category … … 815 818 REAL(wp), DIMENSION(:,:), INTENT(in) :: phti, phts, pati ! input ice/snow variables 816 819 REAL(wp), DIMENSION(:) , INTENT(inout) :: ph_i, ph_s, pa_i ! output ice/snow variables 817 REAL(wp), DIMENSION(:,:), INTENT(in) , OPTIONAL :: ptmi, ptms, ptmsu, psmi ! input ice/snow temp & sal818 REAL(wp), DIMENSION(:) , INTENT(inout) , OPTIONAL :: pt_i, pt_s, pt_su, ps_i ! output ice/snow temp & sal820 REAL(wp), DIMENSION(:,:), INTENT(in) :: ptmi, ptms, ptmsu, psmi, patip, phtip ! input ice/snow temp & sal & ponds 821 REAL(wp), DIMENSION(:) , INTENT(inout) :: pt_i, pt_s, pt_su, ps_i, pa_ip, ph_ip ! output ice/snow temp & sal & ponds 819 822 ! 820 823 REAL(wp), ALLOCATABLE, DIMENSION(:) :: z1_ai, z1_vi, z1_vs … … 826 829 ! 827 830 ! == thickness and concentration == ! 828 ALLOCATE( z1_ai(idim) )831 ALLOCATE( z1_ai(idim), z1_vi(idim), z1_vs(idim) ) 829 832 ! 830 833 pa_i(:) = SUM( pati(:,:), dim=2 ) … … 838 841 ! 839 842 ! == temperature and salinity == ! 840 IF( PRESENT( pt_i ) .OR. PRESENT( pt_s ) .OR. PRESENT( pt_su ) .OR. PRESENT( ps_i ) ) THEN 841 ! 842 ALLOCATE( z1_vi(idim), z1_vs(idim) ) 843 ! 844 WHERE( ( pa_i(:) * ph_i(:) ) /= 0._wp ) ; z1_vi(:) = 1._wp / ( pa_i(:) * ph_i(:) ) 845 ELSEWHERE ; z1_vi(:) = 0._wp 846 END WHERE 847 WHERE( ( pa_i(:) * ph_s(:) ) /= 0._wp ) ; z1_vs(:) = 1._wp / ( pa_i(:) * ph_s(:) ) 848 ELSEWHERE ; z1_vs(:) = 0._wp 849 END WHERE 850 ! 851 IF( PRESENT( pt_i ) ) pt_i (:) = SUM( ptmi (:,:) * pati(:,:) * phti(:,:), dim=2 ) * z1_vi(:) 852 IF( PRESENT( pt_s ) ) pt_s (:) = SUM( ptms (:,:) * pati(:,:) * phts(:,:), dim=2 ) * z1_vs(:) 853 IF( PRESENT( pt_su ) ) pt_su(:) = SUM( ptmsu(:,:) * pati(:,:) , dim=2 ) * z1_ai(:) 854 IF( PRESENT( ps_i ) ) ps_i (:) = SUM( psmi (:,:) * pati(:,:) * phti(:,:), dim=2 ) * z1_vi(:) 855 ! 856 DEALLOCATE( z1_vi, z1_vs ) 857 ! 858 ENDIF 859 ! 860 DEALLOCATE( z1_ai ) 843 WHERE( ( pa_i(:) * ph_i(:) ) /= 0._wp ) ; z1_vi(:) = 1._wp / ( pa_i(:) * ph_i(:) ) 844 ELSEWHERE ; z1_vi(:) = 0._wp 845 END WHERE 846 WHERE( ( pa_i(:) * ph_s(:) ) /= 0._wp ) ; z1_vs(:) = 1._wp / ( pa_i(:) * ph_s(:) ) 847 ELSEWHERE ; z1_vs(:) = 0._wp 848 END WHERE 849 pt_i (:) = SUM( ptmi (:,:) * pati(:,:) * phti(:,:), dim=2 ) * z1_vi(:) 850 pt_s (:) = SUM( ptms (:,:) * pati(:,:) * phts(:,:), dim=2 ) * z1_vs(:) 851 pt_su(:) = SUM( ptmsu(:,:) * pati(:,:) , dim=2 ) * z1_ai(:) 852 ps_i (:) = SUM( psmi (:,:) * pati(:,:) * phti(:,:), dim=2 ) * z1_vi(:) 853 854 ! == ponds == ! 855 pa_ip(:) = SUM( patip(:,:), dim=2 ) 856 WHERE( pa_ip(:) /= 0._wp ) ; ph_ip(:) = SUM( phtip(:,:) * patip(:,:), dim=2 ) / pa_ip(:) 857 ELSEWHERE ; ph_ip(:) = 0._wp 858 END WHERE 859 ! 860 DEALLOCATE( z1_ai, z1_vi, z1_vs ) 861 861 ! 862 862 END SUBROUTINE ice_var_itd_Nc1c 863 863 864 SUBROUTINE ice_var_itd_1cMc( phti, phts, pati , ph_i, ph_s, pa_i, &865 & ptmi, ptms, ptmsu, psmi, p t_i, pt_s, pt_su, ps_i)864 SUBROUTINE ice_var_itd_1cMc( phti, phts, pati , ph_i, ph_s, pa_i, & 865 & ptmi, ptms, ptmsu, psmi, patip, phtip, pt_i, pt_s, pt_su, ps_i, pa_ip, ph_ip ) 866 866 !!------------------------------------------------------------------- 867 867 !! … … 894 894 REAL(wp), DIMENSION(:), INTENT(in) :: phti, phts, pati ! input ice/snow variables 895 895 REAL(wp), DIMENSION(:,:), INTENT(inout) :: ph_i, ph_s, pa_i ! output ice/snow variables 896 REAL(wp), DIMENSION(:) , INTENT(in) , OPTIONAL :: ptmi, ptms, ptmsu, psmi ! input ice/snow temp & sal897 REAL(wp), DIMENSION(:,:), INTENT(inout) , OPTIONAL :: pt_i, pt_s, pt_su, ps_i ! output ice/snow temp & sal896 REAL(wp), DIMENSION(:) , INTENT(in) :: ptmi, ptms, ptmsu, psmi, patip, phtip ! input ice/snow temp & sal & ponds 897 REAL(wp), DIMENSION(:,:), INTENT(inout) :: pt_i, pt_s, pt_su, ps_i, pa_ip, ph_ip ! output ice/snow temp & sal & ponds 898 898 ! 899 899 INTEGER , DIMENSION(4) :: itest 900 REAL(wp), ALLOCATABLE, DIMENSION(:) :: zfra 900 901 INTEGER :: ji, jk, jl 901 902 INTEGER :: idim, i_fill, jl0 … … 1010 1011 ! 1011 1012 ! == temperature and salinity == ! 1012 IF( PRESENT( pt_i ) ) THEN 1013 DO jl = 1, jpl 1014 pt_i(:,jl) = ptmi (:) 1015 END DO 1016 ENDIF 1017 IF( PRESENT( pt_s ) ) THEN 1018 DO jl = 1, jpl 1019 pt_s (:,jl) = ptms (:) 1020 END DO 1021 ENDIF 1022 IF( PRESENT( pt_su ) ) THEN 1023 DO jl = 1, jpl 1024 pt_su(:,jl) = ptmsu(:) 1025 END DO 1026 ENDIF 1027 IF( PRESENT( ps_i ) ) THEN 1028 DO jl = 1, jpl 1029 ps_i (:,jl) = psmi (:) 1030 END DO 1031 ENDIF 1013 DO jl = 1, jpl 1014 pt_i (:,jl) = ptmi (:) 1015 pt_s (:,jl) = ptms (:) 1016 pt_su(:,jl) = ptmsu(:) 1017 ps_i (:,jl) = psmi (:) 1018 ps_i (:,jl) = psmi (:) 1019 END DO 1020 ! 1021 ! == ponds == ! 1022 ALLOCATE( zfra(idim) ) 1023 ! keep the same pond fraction atip/ati for each category 1024 WHERE( pati(:) /= 0._wp ) ; zfra(:) = patip(:) / pati(:) 1025 ELSEWHERE ; zfra(:) = 0._wp 1026 END WHERE 1027 DO jl = 1, jpl 1028 pa_ip(:,jl) = zfra(:) * pa_i(:,jl) 1029 END DO 1030 ! keep the same v_ip/v_i ratio for each category 1031 WHERE( ( phti(:) * pati(:) ) /= 0._wp ) ; zfra(:) = ( phtip(:) * patip(:) ) / ( phti(:) * pati(:) ) 1032 ELSEWHERE ; zfra(:) = 0._wp 1033 END WHERE 1034 DO jl = 1, jpl 1035 WHERE( pa_ip(:,jl) /= 0._wp ) ; ph_ip(:,jl) = zfra(:) * ( ph_i(:,jl) * pa_i(:,jl) ) / pa_ip(:,jl) 1036 ELSEWHERE ; ph_ip(:,jl) = 0._wp 1037 END WHERE 1038 END DO 1039 DEALLOCATE( zfra ) 1032 1040 ! 1033 1041 END SUBROUTINE ice_var_itd_1cMc 1034 1042 1035 SUBROUTINE ice_var_itd_NcMc( phti, phts, pati , ph_i, ph_s, pa_i, &1036 & ptmi, ptms, ptmsu, psmi, p t_i, pt_s, pt_su, ps_i)1043 SUBROUTINE ice_var_itd_NcMc( phti, phts, pati , ph_i, ph_s, pa_i, & 1044 & ptmi, ptms, ptmsu, psmi, patip, phtip, pt_i, pt_s, pt_su, ps_i, pa_ip, ph_ip ) 1037 1045 !!------------------------------------------------------------------- 1038 1046 !! … … 1065 1073 REAL(wp), DIMENSION(:,:), INTENT(in) :: phti, phts, pati ! input ice/snow variables 1066 1074 REAL(wp), DIMENSION(:,:), INTENT(inout) :: ph_i, ph_s, pa_i ! output ice/snow variables 1067 REAL(wp), DIMENSION(:,:), INTENT(in) , OPTIONAL :: ptmi, ptms, ptmsu, psmi ! input ice/snow temp & sal1068 REAL(wp), DIMENSION(:,:), INTENT(inout) , OPTIONAL :: pt_i, pt_s, pt_su, ps_i ! output ice/snow temp & sal1075 REAL(wp), DIMENSION(:,:), INTENT(in) :: ptmi, ptms, ptmsu, psmi, patip, phtip ! input ice/snow temp & sal & ponds 1076 REAL(wp), DIMENSION(:,:), INTENT(inout) :: pt_i, pt_s, pt_su, ps_i, pa_ip, ph_ip ! output ice/snow temp & sal & ponds 1069 1077 ! 1070 1078 INTEGER , ALLOCATABLE, DIMENSION(:,:) :: jlfil, jlfil2 1071 1079 INTEGER , ALLOCATABLE, DIMENSION(:) :: jlmax, jlmin 1072 REAL(wp), ALLOCATABLE, DIMENSION(:) :: z1_ai, z1_vi, z1_vs, ztmp 1080 REAL(wp), ALLOCATABLE, DIMENSION(:) :: z1_ai, z1_vi, z1_vs, ztmp, zfra 1073 1081 ! 1074 1082 REAL(wp), PARAMETER :: ztrans = 0.25_wp … … 1088 1096 pa_i(:,:) = pati(:,:) 1089 1097 ! 1090 ! == temperature and salinity == ! 1091 IF( PRESENT( pt_i ) ) pt_i (:,:) = ptmi (:,:) 1092 IF( PRESENT( pt_s ) ) pt_s (:,:) = ptms (:,:) 1093 IF( PRESENT( pt_su ) ) pt_su(:,:) = ptmsu(:,:) 1094 IF( PRESENT( ps_i ) ) ps_i (:,:) = psmi (:,:) 1098 ! == temperature and salinity and ponds == ! 1099 pt_i (:,:) = ptmi (:,:) 1100 pt_s (:,:) = ptms (:,:) 1101 pt_su(:,:) = ptmsu(:,:) 1102 ps_i (:,:) = psmi (:,:) 1103 pa_ip(:,:) = patip(:,:) 1104 ph_ip(:,:) = phtip(:,:) 1095 1105 ! ! ---------------------- ! 1096 1106 ELSEIF( icat == 1 ) THEN ! input cat = 1 ! 1097 1107 ! ! ---------------------- ! 1098 CALL ice_var_itd_1cMc( phti(:,1), phts(:,1), pati (:,1), ph_i(:,:), ph_s(:,:), pa_i (:,:) ) 1099 !! CALL ice_var_itd_1cMc( phti(:,1), phts(:,1), pati (:,1), ph_i(:,:), ph_s(:,:), pa_i (:,:), & 1100 !! & ptmi(:,1), ptms(:,1), ptmsu(:,1), psmi(:,1), pt_i(:,:), pt_s(:,:), pt_su(:,:), ps_i(:,:) ) 1108 CALL ice_var_itd_1cMc( phti(:,1), phts(:,1), pati (:,1), & 1109 & ph_i(:,:), ph_s(:,:), pa_i (:,:), & 1110 & ptmi(:,1), ptms(:,1), ptmsu(:,1), psmi(:,1), patip(:,1), phtip(:,1), & 1111 & pt_i(:,:), pt_s(:,:), pt_su(:,:), ps_i(:,:), pa_ip(:,:), ph_ip(:,:) ) 1101 1112 ! ! ---------------------- ! 1102 1113 ELSEIF( jpl == 1 ) THEN ! output cat = 1 ! 1103 1114 ! ! ---------------------- ! 1104 CALL ice_var_itd_Nc1c( phti(:,:), phts(:,:), pati (:,:), ph_i(:,1), ph_s(:,1), pa_i (:,1) ) 1105 !! CALL ice_var_itd_Nc1c( phti(:,:), phts(:,:), pati (:,:), ph_i(:,1), ph_s(:,1), pa_i (:,1), & 1106 !! & ptmi(:,:), ptms(:,:), ptmsu(:,:), psmi(:,:), pt_i(:,1), pt_s(:,1), pt_su(:,1), ps_i(:,1) ) 1115 CALL ice_var_itd_Nc1c( phti(:,:), phts(:,:), pati (:,:), & 1116 & ph_i(:,1), ph_s(:,1), pa_i (:,1), & 1117 & ptmi(:,:), ptms(:,:), ptmsu(:,:), psmi(:,:), patip(:,:), phtip(:,:), & 1118 & pt_i(:,1), pt_s(:,1), pt_su(:,1), ps_i(:,1), pa_ip(:,1), ph_ip(:,1) ) 1107 1119 ! ! ----------------------- ! 1108 1120 ELSE ! input cat /= output cat ! … … 1194 1206 ! == temperature and salinity == ! 1195 1207 ! 1196 IF( PRESENT( pt_i ) .OR. PRESENT( pt_s ) .OR. PRESENT( pt_su ) .OR. PRESENT( ps_i ) ) THEN 1197 ! 1198 ALLOCATE( z1_ai(idim), z1_vi(idim), z1_vs(idim), ztmp(idim) ) 1199 ! 1200 WHERE( SUM( pa_i(:,:), dim=2 ) /= 0._wp ) ; z1_ai(:) = 1._wp / SUM( pa_i(:,:), dim=2 ) 1201 ELSEWHERE ; z1_ai(:) = 0._wp 1208 ALLOCATE( z1_ai(idim), z1_vi(idim), z1_vs(idim), ztmp(idim) ) 1209 ! 1210 WHERE( SUM( pa_i(:,:), dim=2 ) /= 0._wp ) ; z1_ai(:) = 1._wp / SUM( pa_i(:,:), dim=2 ) 1211 ELSEWHERE ; z1_ai(:) = 0._wp 1212 END WHERE 1213 WHERE( SUM( pa_i(:,:) * ph_i(:,:), dim=2 ) /= 0._wp ) ; z1_vi(:) = 1._wp / SUM( pa_i(:,:) * ph_i(:,:), dim=2 ) 1214 ELSEWHERE ; z1_vi(:) = 0._wp 1215 END WHERE 1216 WHERE( SUM( pa_i(:,:) * ph_s(:,:), dim=2 ) /= 0._wp ) ; z1_vs(:) = 1._wp / SUM( pa_i(:,:) * ph_s(:,:), dim=2 ) 1217 ELSEWHERE ; z1_vs(:) = 0._wp 1218 END WHERE 1219 ! 1220 ! fill all the categories with the same value 1221 ztmp(:) = SUM( ptmi (:,:) * pati(:,:) * phti(:,:), dim=2 ) * z1_vi(:) 1222 DO jl = 1, jpl 1223 pt_i (:,jl) = ztmp(:) 1224 END DO 1225 ztmp(:) = SUM( ptms (:,:) * pati(:,:) * phts(:,:), dim=2 ) * z1_vs(:) 1226 DO jl = 1, jpl 1227 pt_s (:,jl) = ztmp(:) 1228 END DO 1229 ztmp(:) = SUM( ptmsu(:,:) * pati(:,:) , dim=2 ) * z1_ai(:) 1230 DO jl = 1, jpl 1231 pt_su(:,jl) = ztmp(:) 1232 END DO 1233 ztmp(:) = SUM( psmi (:,:) * pati(:,:) * phti(:,:), dim=2 ) * z1_vi(:) 1234 DO jl = 1, jpl 1235 ps_i (:,jl) = ztmp(:) 1236 END DO 1237 ! 1238 DEALLOCATE( z1_ai, z1_vi, z1_vs, ztmp ) 1239 ! 1240 ! == ponds == ! 1241 ALLOCATE( zfra(idim) ) 1242 ! keep the same pond fraction atip/ati for each category 1243 WHERE( SUM( pati(:,:), dim=2 ) /= 0._wp ) ; zfra(:) = SUM( patip(:,:), dim=2 ) / SUM( pati(:,:), dim=2 ) 1244 ELSEWHERE ; zfra(:) = 0._wp 1245 END WHERE 1246 DO jl = 1, jpl 1247 pa_ip(:,jl) = zfra(:) * pa_i(:,jl) 1248 END DO 1249 ! keep the same v_ip/v_i ratio for each category 1250 WHERE( SUM( phti(:,:) * pati(:,:), dim=2 ) /= 0._wp ) 1251 zfra(:) = SUM( phtip(:,:) * patip(:,:), dim=2 ) / SUM( phti(:,:) * pati(:,:), dim=2 ) 1252 ELSEWHERE 1253 zfra(:) = 0._wp 1254 END WHERE 1255 DO jl = 1, jpl 1256 WHERE( pa_ip(:,jl) /= 0._wp ) ; ph_ip(:,jl) = zfra(:) * ( ph_i(:,jl) * pa_i(:,jl) ) / pa_ip(:,jl) 1257 ELSEWHERE ; ph_ip(:,jl) = 0._wp 1202 1258 END WHERE 1203 WHERE( SUM( pa_i(:,:) * ph_i(:,:), dim=2 ) /= 0._wp ) ; z1_vi(:) = 1._wp / SUM( pa_i(:,:) * ph_i(:,:), dim=2 ) 1204 ELSEWHERE ; z1_vi(:) = 0._wp 1205 END WHERE 1206 WHERE( SUM( pa_i(:,:) * ph_s(:,:), dim=2 ) /= 0._wp ) ; z1_vs(:) = 1._wp / SUM( pa_i(:,:) * ph_s(:,:), dim=2 ) 1207 ELSEWHERE ; z1_vs(:) = 0._wp 1208 END WHERE 1209 ! 1210 ! fill all the categories with the same value 1211 IF( PRESENT( pt_i ) ) THEN 1212 ztmp(:) = SUM( ptmi (:,:) * pati(:,:) * phti(:,:), dim=2 ) * z1_vi(:) 1213 DO jl = 1, jpl 1214 pt_i (:,jl) = ztmp(:) 1215 END DO 1216 ENDIF 1217 IF( PRESENT( pt_s ) ) THEN 1218 ztmp(:) = SUM( ptms (:,:) * pati(:,:) * phts(:,:), dim=2 ) * z1_vs(:) 1219 DO jl = 1, jpl 1220 pt_s (:,jl) = ztmp(:) 1221 END DO 1222 ENDIF 1223 IF( PRESENT( pt_su ) ) THEN 1224 ztmp(:) = SUM( ptmsu(:,:) * pati(:,:) , dim=2 ) * z1_ai(:) 1225 DO jl = 1, jpl 1226 pt_su(:,jl) = ztmp(:) 1227 END DO 1228 ENDIF 1229 IF( PRESENT( ps_i ) ) THEN 1230 ztmp(:) = SUM( psmi (:,:) * pati(:,:) * phti(:,:), dim=2 ) * z1_vi(:) 1231 DO jl = 1, jpl 1232 ps_i (:,jl) = ztmp(:) 1233 END DO 1234 ENDIF 1235 ! 1236 DEALLOCATE( z1_ai, z1_vi, z1_vs, ztmp ) 1237 ! 1238 ENDIF 1259 END DO 1260 DEALLOCATE( zfra ) 1239 1261 ! 1240 1262 ENDIF
Note: See TracChangeset
for help on using the changeset viewer.
