- Timestamp:
- 2020-10-22T20:49:56+02:00 (4 years ago)
- Location:
- NEMO/branches/2019/dev_r11842_SI3-10_EAP
- Files:
-
- 2 edited
-
. (modified) (1 prop)
-
src/ICE/icevar.F90 (modified) (30 diffs)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2019/dev_r11842_SI3-10_EAP
- Property svn:externals
-
old new 1 ^/utils/build/arch@HEAD arch 2 ^/utils/build/makenemo@HEAD makenemo 3 ^/utils/build/mk@HEAD mk 4 ^/utils/tools@HEAD tools 5 ^/vendors/AGRIF/dev@HEAD ext/AGRIF 6 ^/vendors/FCM@HEAD ext/FCM 7 ^/vendors/IOIPSL@HEAD ext/IOIPSL 1 ^/utils/build/arch@12130 arch 2 ^/utils/build/makenemo@12191 makenemo 3 ^/utils/build/mk@11662 mk 4 ^/utils/tools_r4.0-HEAD@12672 tools 5 ^/vendors/AGRIF/dev@10586 ext/AGRIF 6 ^/vendors/FCM@10134 ext/FCM 7 ^/vendors/IOIPSL@9655 ext/IOIPSL 8 9 # SETTE mapping (inactive) 10 #^/utils/CI/sette@12135 sette
-
- Property svn:externals
-
NEMO/branches/2019/dev_r11842_SI3-10_EAP/src/ICE/icevar.F90
r11732 r13662 51 51 !! ice_var_sshdyn : compute equivalent ssh in lead 52 52 !! ice_var_itd : convert N-cat to M-cat 53 !! ice_var_snwfra : fraction of ice covered by snow 54 !! ice_var_snwblow : distribute snow fall between ice and ocean 53 55 !!---------------------------------------------------------------------- 54 56 USE dom_oce ! ocean space and time domain … … 77 79 PUBLIC ice_var_sshdyn 78 80 PUBLIC ice_var_itd 81 PUBLIC ice_var_snwfra 82 PUBLIC ice_var_snwblow 79 83 80 84 INTERFACE ice_var_itd 81 85 MODULE PROCEDURE ice_var_itd_1c1c, ice_var_itd_Nc1c, ice_var_itd_1cMc, ice_var_itd_NcMc 86 END INTERFACE 87 88 INTERFACE ice_var_snwfra 89 MODULE PROCEDURE ice_var_snwfra_1d, ice_var_snwfra_2d, ice_var_snwfra_3d 90 END INTERFACE 91 92 INTERFACE ice_var_snwblow 93 MODULE PROCEDURE ice_var_snwblow_1d, ice_var_snwblow_2d 82 94 END INTERFACE 83 95 … … 113 125 at_ip(:,:) = SUM( a_ip(:,:,:), dim=3 ) ! melt ponds 114 126 vt_ip(:,:) = SUM( v_ip(:,:,:), dim=3 ) 127 vt_il(:,:) = SUM( v_il(:,:,:), dim=3 ) 115 128 ! 116 129 ato_i(:,:) = 1._wp - at_i(:,:) ! open water fraction … … 161 174 ! 162 175 ! ! mean melt pond depth 163 WHERE( at_ip(:,:) > epsi20 ) ; hm_ip(:,:) = vt_ip(:,:) / at_ip(:,:) 164 ELSEWHERE ; hm_ip(:,:) = 0._wp 176 WHERE( at_ip(:,:) > epsi20 ) ; hm_ip(:,:) = vt_ip(:,:) / at_ip(:,:) ; hm_il(:,:) = vt_il(:,:) / at_ip(:,:) 177 ELSEWHERE ; hm_ip(:,:) = 0._wp ; hm_il(:,:) = 0._wp 165 178 END WHERE 166 179 ! … … 184 197 REAL(wp) :: zhmax, z1_zhmax ! - - 185 198 REAL(wp) :: zlay_i, zlay_s ! - - 186 REAL(wp), DIMENSION(jpi,jpj,jpl) :: z1_a_i, z1_v_i 199 REAL(wp), PARAMETER :: zhl_max = 0.015_wp ! pond lid thickness above which the ponds disappear from the albedo calculation 200 REAL(wp), PARAMETER :: zhl_min = 0.005_wp ! pond lid thickness below which the full pond area is used in the albedo calculation 201 REAL(wp), DIMENSION(jpi,jpj,jpl) :: z1_a_i, z1_v_i, z1_a_ip, za_s_fra 187 202 !!------------------------------------------------------------------- 188 203 … … 202 217 WHERE( v_i(:,:,:) > epsi20 ) ; z1_v_i(:,:,:) = 1._wp / v_i(:,:,:) 203 218 ELSEWHERE ; z1_v_i(:,:,:) = 0._wp 219 END WHERE 220 ! 221 WHERE( a_ip(:,:,:) > epsi20 ) ; z1_a_ip(:,:,:) = 1._wp / a_ip(:,:,:) 222 ELSEWHERE ; z1_a_ip(:,:,:) = 0._wp 204 223 END WHERE 205 224 ! !--- ice thickness … … 217 236 ! !--- ice age 218 237 o_i(:,:,:) = oa_i(:,:,:) * z1_a_i(:,:,:) 219 ! !--- pond fraction and thickness 238 ! !--- pond and lid thickness 239 h_ip(:,:,:) = v_ip(:,:,:) * z1_a_ip(:,:,:) 240 h_il(:,:,:) = v_il(:,:,:) * z1_a_ip(:,:,:) 241 ! !--- melt pond effective area (used for albedo) 220 242 a_ip_frac(:,:,:) = a_ip(:,:,:) * z1_a_i(:,:,:) 221 WHERE( a_ip_frac(:,:,:) > epsi20 ) ; h_ip(:,:,:) = v_ip(:,:,:) * z1_a_i(:,:,:) / a_ip_frac(:,:,:) 222 ELSEWHERE ; h_ip(:,:,:) = 0._wp 243 WHERE ( h_il(:,:,:) <= zhl_min ) ; a_ip_eff(:,:,:) = a_ip_frac(:,:,:) ! lid is very thin. Expose all the pond 244 ELSEWHERE( h_il(:,:,:) >= zhl_max ) ; a_ip_eff(:,:,:) = 0._wp ! lid is very thick. Cover all the pond up with ice and snow 245 ELSEWHERE ; a_ip_eff(:,:,:) = a_ip_frac(:,:,:) * & ! lid is in between. Expose part of the pond 246 & ( h_il(:,:,:) - zhl_min ) / ( zhl_max - zhl_min ) 223 247 END WHERE 248 ! 249 CALL ice_var_snwfra( h_s, za_s_fra ) ! calculate ice fraction covered by snow 250 a_ip_eff = MIN( a_ip_eff, 1._wp - za_s_fra ) ! make sure (a_ip_eff + a_s_fra) <= 1 224 251 ! 225 252 ! !--- salinity (with a minimum value imposed everywhere) … … 289 316 sv_i(:,:,:) = s_i (:,:,:) * v_i (:,:,:) 290 317 v_ip(:,:,:) = h_ip(:,:,:) * a_ip(:,:,:) 318 v_il(:,:,:) = h_il(:,:,:) * a_ip(:,:,:) 291 319 ! 292 320 END SUBROUTINE ice_var_eqv2glo … … 533 561 a_ip (ji,jj,jl) = a_ip (ji,jj,jl) * zswitch(ji,jj) 534 562 v_ip (ji,jj,jl) = v_ip (ji,jj,jl) * zswitch(ji,jj) 563 v_il (ji,jj,jl) = v_il (ji,jj,jl) * zswitch(ji,jj) 535 564 ! 536 565 END DO … … 555 584 556 585 557 SUBROUTINE ice_var_zapneg( pdt, pato_i, pv_i, pv_s, psv_i, poa_i, pa_i, pa_ip, pv_ip, p e_s, pe_i )586 SUBROUTINE ice_var_zapneg( pdt, pato_i, pv_i, pv_s, psv_i, poa_i, pa_i, pa_ip, pv_ip, pv_il, pe_s, pe_i ) 558 587 !!------------------------------------------------------------------- 559 588 !! *** ROUTINE ice_var_zapneg *** … … 570 599 REAL(wp), DIMENSION(:,:,:) , INTENT(inout) :: pa_ip ! melt pond fraction 571 600 REAL(wp), DIMENSION(:,:,:) , INTENT(inout) :: pv_ip ! melt pond volume 601 REAL(wp), DIMENSION(:,:,:) , INTENT(inout) :: pv_il ! melt pond lid volume 572 602 REAL(wp), DIMENSION(:,:,:,:), INTENT(inout) :: pe_s ! snw heat content 573 603 REAL(wp), DIMENSION(:,:,:,:), INTENT(inout) :: pe_i ! ice heat content … … 636 666 WHERE( pa_ip (:,:,:) < 0._wp ) pa_ip (:,:,:) = 0._wp 637 667 WHERE( pv_ip (:,:,:) < 0._wp ) pv_ip (:,:,:) = 0._wp ! in theory one should change wfx_pnd(-) and wfx_sum(+) 638 !but it does not change conservation, so keep it this way is ok668 WHERE( pv_il (:,:,:) < 0._wp ) pv_il (:,:,:) = 0._wp ! but it does not change conservation, so keep it this way is ok 639 669 ! 640 670 END SUBROUTINE ice_var_zapneg 641 671 642 672 643 SUBROUTINE ice_var_roundoff( pa_i, pv_i, pv_s, psv_i, poa_i, pa_ip, pv_ip, p e_s, pe_i )673 SUBROUTINE ice_var_roundoff( pa_i, pv_i, pv_s, psv_i, poa_i, pa_ip, pv_ip, pv_il, pe_s, pe_i ) 644 674 !!------------------------------------------------------------------- 645 675 !! *** ROUTINE ice_var_roundoff *** … … 654 684 REAL(wp), DIMENSION(:,:) , INTENT(inout) :: pa_ip ! melt pond fraction 655 685 REAL(wp), DIMENSION(:,:) , INTENT(inout) :: pv_ip ! melt pond volume 686 REAL(wp), DIMENSION(:,:) , INTENT(inout) :: pv_il ! melt pond lid volume 656 687 REAL(wp), DIMENSION(:,:,:), INTENT(inout) :: pe_s ! snw heat content 657 688 REAL(wp), DIMENSION(:,:,:), INTENT(inout) :: pe_i ! ice heat content … … 665 696 WHERE( pe_i (1:npti,:,:) < 0._wp .AND. pe_i (1:npti,:,:) > -epsi06 ) pe_i (1:npti,:,:) = 0._wp ! e_i must be >= 0 666 697 WHERE( pe_s (1:npti,:,:) < 0._wp .AND. pe_s (1:npti,:,:) > -epsi06 ) pe_s (1:npti,:,:) = 0._wp ! e_s must be >= 0 667 IF( ln_pnd_ H12) THEN698 IF( ln_pnd_LEV ) THEN 668 699 WHERE( pa_ip(1:npti,:) < 0._wp .AND. pa_ip(1:npti,:) > -epsi10 ) pa_ip(1:npti,:) = 0._wp ! a_ip must be >= 0 669 700 WHERE( pv_ip(1:npti,:) < 0._wp .AND. pv_ip(1:npti,:) > -epsi10 ) pv_ip(1:npti,:) = 0._wp ! v_ip must be >= 0 701 IF( ln_pnd_lids ) THEN 702 WHERE( pv_il(1:npti,:) < 0._wp .AND. pv_il(1:npti,:) > -epsi10 ) pv_il(1:npti,:) = 0._wp ! v_il must be >= 0 703 ENDIF 670 704 ENDIF 671 705 ! … … 786 820 !! ** Purpose : converting N-cat ice to jpl ice categories 787 821 !!------------------------------------------------------------------- 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)822 SUBROUTINE ice_var_itd_1c1c( phti, phts, pati , ph_i, ph_s, pa_i, & 823 & ptmi, ptms, ptmsu, psmi, patip, phtip, phtil, pt_i, pt_s, pt_su, ps_i, pa_ip, ph_ip, ph_il ) 790 824 !!------------------------------------------------------------------- 791 825 !! ** Purpose : converting 1-cat ice to 1 ice category … … 793 827 REAL(wp), DIMENSION(:), INTENT(in) :: phti, phts, pati ! input ice/snow variables 794 828 REAL(wp), DIMENSION(:), INTENT(inout) :: ph_i, ph_s, pa_i ! output ice/snow variables 795 REAL(wp), DIMENSION(:), INTENT(in) :: ptmi, ptms, ptmsu, psmi, patip, phtip ! input ice/snow temp & sal & ponds796 REAL(wp), DIMENSION(:), INTENT(inout) :: pt_i, pt_s, pt_su, ps_i, pa_ip, ph_ip ! output ice/snow temp & sal & ponds829 REAL(wp), DIMENSION(:), INTENT(in) :: ptmi, ptms, ptmsu, psmi, patip, phtip, phtil ! input ice/snow temp & sal & ponds 830 REAL(wp), DIMENSION(:), INTENT(inout) :: pt_i, pt_s, pt_su, ps_i, pa_ip, ph_ip, ph_il ! output ice/snow temp & sal & ponds 797 831 !!------------------------------------------------------------------- 798 832 ! == thickness and concentration == ! … … 808 842 pa_ip(:) = patip(:) 809 843 ph_ip(:) = phtip(:) 844 ph_il(:) = phtil(:) 810 845 811 846 END SUBROUTINE ice_var_itd_1c1c 812 847 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)848 SUBROUTINE ice_var_itd_Nc1c( phti, phts, pati , ph_i, ph_s, pa_i, & 849 & ptmi, ptms, ptmsu, psmi, patip, phtip, phtil, pt_i, pt_s, pt_su, ps_i, pa_ip, ph_ip, ph_il ) 815 850 !!------------------------------------------------------------------- 816 851 !! ** Purpose : converting N-cat ice to 1 ice category … … 818 853 REAL(wp), DIMENSION(:,:), INTENT(in) :: phti, phts, pati ! input ice/snow variables 819 854 REAL(wp), DIMENSION(:) , INTENT(inout) :: ph_i, ph_s, pa_i ! output ice/snow variables 820 REAL(wp), DIMENSION(:,:), INTENT(in) :: ptmi, ptms, ptmsu, psmi, patip, phtip ! input ice/snow temp & sal & ponds821 REAL(wp), DIMENSION(:) , INTENT(inout) :: pt_i, pt_s, pt_su, ps_i, pa_ip, ph_ip ! output ice/snow temp & sal & ponds855 REAL(wp), DIMENSION(:,:), INTENT(in) :: ptmi, ptms, ptmsu, psmi, patip, phtip, phtil ! input ice/snow temp & sal & ponds 856 REAL(wp), DIMENSION(:) , INTENT(inout) :: pt_i, pt_s, pt_su, ps_i, pa_ip, ph_ip, ph_il ! output ice/snow temp & sal & ponds 822 857 ! 823 858 REAL(wp), ALLOCATABLE, DIMENSION(:) :: z1_ai, z1_vi, z1_vs … … 854 889 ! == ponds == ! 855 890 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 891 WHERE( pa_ip(:) /= 0._wp ) 892 ph_ip(:) = SUM( phtip(:,:) * patip(:,:), dim=2 ) / pa_ip(:) 893 ph_il(:) = SUM( phtil(:,:) * patip(:,:), dim=2 ) / pa_ip(:) 894 ELSEWHERE 895 ph_ip(:) = 0._wp 896 ph_il(:) = 0._wp 858 897 END WHERE 859 898 ! … … 862 901 END SUBROUTINE ice_var_itd_Nc1c 863 902 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)903 SUBROUTINE ice_var_itd_1cMc( phti, phts, pati , ph_i, ph_s, pa_i, & 904 & ptmi, ptms, ptmsu, psmi, patip, phtip, phtil, pt_i, pt_s, pt_su, ps_i, pa_ip, ph_ip, ph_il ) 866 905 !!------------------------------------------------------------------- 867 906 !! … … 885 924 REAL(wp), DIMENSION(:), INTENT(in) :: phti, phts, pati ! input ice/snow variables 886 925 REAL(wp), DIMENSION(:,:), INTENT(inout) :: ph_i, ph_s, pa_i ! output ice/snow variables 887 REAL(wp), DIMENSION(:) , INTENT(in) :: ptmi, ptms, ptmsu, psmi, patip, phtip ! input ice/snow temp & sal & ponds888 REAL(wp), DIMENSION(:,:), INTENT(inout) :: pt_i, pt_s, pt_su, ps_i, pa_ip, ph_ip ! output ice/snow temp & sal & ponds926 REAL(wp), DIMENSION(:) , INTENT(in) :: ptmi, ptms, ptmsu, psmi, patip, phtip, phtil ! input ice/snow temp & sal & ponds 927 REAL(wp), DIMENSION(:,:), INTENT(inout) :: pt_i, pt_s, pt_su, ps_i, pa_ip, ph_ip, ph_il ! output ice/snow temp & sal & ponds 889 928 ! 890 929 REAL(wp), ALLOCATABLE, DIMENSION(:) :: zfra, z1_hti … … 976 1015 pt_su(:,jl) = ptmsu(:) 977 1016 ps_i (:,jl) = psmi (:) 978 ps_i (:,jl) = psmi (:)979 1017 END DO 980 1018 ! … … 997 1035 END WHERE 998 1036 END DO 1037 ! keep the same v_il/v_i ratio for each category 1038 WHERE( ( phti(:) * pati(:) ) /= 0._wp ) ; zfra(:) = ( phtil(:) * patip(:) ) / ( phti(:) * pati(:) ) 1039 ELSEWHERE ; zfra(:) = 0._wp 1040 END WHERE 1041 DO jl = 1, jpl 1042 WHERE( pa_ip(:,jl) /= 0._wp ) ; ph_il(:,jl) = zfra(:) * ( ph_i(:,jl) * pa_i(:,jl) ) / pa_ip(:,jl) 1043 ELSEWHERE ; ph_il(:,jl) = 0._wp 1044 END WHERE 1045 END DO 999 1046 DEALLOCATE( zfra ) 1000 1047 ! 1001 1048 END SUBROUTINE ice_var_itd_1cMc 1002 1049 1003 SUBROUTINE ice_var_itd_NcMc( phti, phts, pati , ph_i, ph_s, pa_i, &1004 & ptmi, ptms, ptmsu, psmi, patip, phtip, pt_i, pt_s, pt_su, ps_i, pa_ip, ph_ip)1050 SUBROUTINE ice_var_itd_NcMc( phti, phts, pati , ph_i, ph_s, pa_i, & 1051 & ptmi, ptms, ptmsu, psmi, patip, phtip, phtil, pt_i, pt_s, pt_su, ps_i, pa_ip, ph_ip, ph_il ) 1005 1052 !!------------------------------------------------------------------- 1006 1053 !! … … 1017 1064 !! 1018 1065 !! 2) Expand the filling to the cat jlmin-1 and jlmax+1 1019 1066 !! by removing 25% ice area from jlmin and jlmax (resp.) 1020 1067 !! 1021 1068 !! 3) Expand the filling to the empty cat between jlmin and jlmax … … 1033 1080 REAL(wp), DIMENSION(:,:), INTENT(in) :: phti, phts, pati ! input ice/snow variables 1034 1081 REAL(wp), DIMENSION(:,:), INTENT(inout) :: ph_i, ph_s, pa_i ! output ice/snow variables 1035 REAL(wp), DIMENSION(:,:), INTENT(in) :: ptmi, ptms, ptmsu, psmi, patip, phtip ! input ice/snow temp & sal & ponds1036 REAL(wp), DIMENSION(:,:), INTENT(inout) :: pt_i, pt_s, pt_su, ps_i, pa_ip, ph_ip ! output ice/snow temp & sal & ponds1082 REAL(wp), DIMENSION(:,:), INTENT(in) :: ptmi, ptms, ptmsu, psmi, patip, phtip, phtil ! input ice/snow temp & sal & ponds 1083 REAL(wp), DIMENSION(:,:), INTENT(inout) :: pt_i, pt_s, pt_su, ps_i, pa_ip, ph_ip, ph_il ! output ice/snow temp & sal & ponds 1037 1084 ! 1038 1085 INTEGER , ALLOCATABLE, DIMENSION(:,:) :: jlfil, jlfil2 … … 1063 1110 pa_ip(:,:) = patip(:,:) 1064 1111 ph_ip(:,:) = phtip(:,:) 1112 ph_il(:,:) = phtil(:,:) 1065 1113 ! ! ---------------------- ! 1066 1114 ELSEIF( icat == 1 ) THEN ! input cat = 1 ! … … 1068 1116 CALL ice_var_itd_1cMc( phti(:,1), phts(:,1), pati (:,1), & 1069 1117 & ph_i(:,:), ph_s(:,:), pa_i (:,:), & 1070 & ptmi(:,1), ptms(:,1), ptmsu(:,1), psmi(:,1), patip(:,1), phtip(:,1), &1071 & pt_i(:,:), pt_s(:,:), pt_su(:,:), ps_i(:,:), pa_ip(:,:), ph_ip(:,:) )1118 & ptmi(:,1), ptms(:,1), ptmsu(:,1), psmi(:,1), patip(:,1), phtip(:,1), phtil(:,1), & 1119 & pt_i(:,:), pt_s(:,:), pt_su(:,:), ps_i(:,:), pa_ip(:,:), ph_ip(:,:), ph_il(:,:) ) 1072 1120 ! ! ---------------------- ! 1073 1121 ELSEIF( jpl == 1 ) THEN ! output cat = 1 ! … … 1075 1123 CALL ice_var_itd_Nc1c( phti(:,:), phts(:,:), pati (:,:), & 1076 1124 & ph_i(:,1), ph_s(:,1), pa_i (:,1), & 1077 & ptmi(:,:), ptms(:,:), ptmsu(:,:), psmi(:,:), patip(:,:), phtip(:,:), &1078 & pt_i(:,1), pt_s(:,1), pt_su(:,1), ps_i(:,1), pa_ip(:,1), ph_ip(:,1) )1125 & ptmi(:,:), ptms(:,:), ptmsu(:,:), psmi(:,:), patip(:,:), phtip(:,:), phtil(:,:), & 1126 & pt_i(:,1), pt_s(:,1), pt_su(:,1), ps_i(:,1), pa_ip(:,1), ph_ip(:,1), ph_il(:,1) ) 1079 1127 ! ! ----------------------- ! 1080 1128 ELSE ! input cat /= output cat ! … … 1218 1266 END WHERE 1219 1267 END DO 1268 ! keep the same v_il/v_i ratio for each category 1269 WHERE( SUM( phti(:,:) * pati(:,:), dim=2 ) /= 0._wp ) 1270 zfra(:) = SUM( phtil(:,:) * patip(:,:), dim=2 ) / SUM( phti(:,:) * pati(:,:), dim=2 ) 1271 ELSEWHERE 1272 zfra(:) = 0._wp 1273 END WHERE 1274 DO jl = 1, jpl 1275 WHERE( pa_ip(:,jl) /= 0._wp ) ; ph_il(:,jl) = zfra(:) * ( ph_i(:,jl) * pa_i(:,jl) ) / pa_ip(:,jl) 1276 ELSEWHERE ; ph_il(:,jl) = 0._wp 1277 END WHERE 1278 END DO 1220 1279 DEALLOCATE( zfra ) 1221 1280 ! … … 1223 1282 ! 1224 1283 END SUBROUTINE ice_var_itd_NcMc 1284 1285 !!------------------------------------------------------------------- 1286 !! INTERFACE ice_var_snwfra 1287 !! 1288 !! ** Purpose : fraction of ice covered by snow 1289 !! 1290 !! ** Method : In absence of proper snow model on top of sea ice, 1291 !! we argue that snow does not cover the whole ice because 1292 !! of wind blowing... 1293 !! 1294 !! ** Arguments : ph_s: snow thickness 1295 !! 1296 !! ** Output : pa_s_fra: fraction of ice covered by snow 1297 !! 1298 !!------------------------------------------------------------------- 1299 SUBROUTINE ice_var_snwfra_3d( ph_s, pa_s_fra ) 1300 REAL(wp), DIMENSION(:,:,:), INTENT(in ) :: ph_s ! snow thickness 1301 REAL(wp), DIMENSION(:,:,:), INTENT( out) :: pa_s_fra ! ice fraction covered by snow 1302 IF ( nn_snwfra == 0 ) THEN ! basic 0 or 1 snow cover 1303 WHERE( ph_s > 0._wp ) ; pa_s_fra = 1._wp 1304 ELSEWHERE ; pa_s_fra = 0._wp 1305 END WHERE 1306 ELSEIF( nn_snwfra == 1 ) THEN ! snow cover depends on hsnow (met-office style) 1307 pa_s_fra = 1._wp - EXP( -0.2_wp * rhos * ph_s ) 1308 ELSEIF( nn_snwfra == 2 ) THEN ! snow cover depends on hsnow (cice style) 1309 pa_s_fra = ph_s / ( ph_s + 0.02_wp ) 1310 ENDIF 1311 END SUBROUTINE ice_var_snwfra_3d 1312 1313 SUBROUTINE ice_var_snwfra_2d( ph_s, pa_s_fra ) 1314 REAL(wp), DIMENSION(:,:), INTENT(in ) :: ph_s ! snow thickness 1315 REAL(wp), DIMENSION(:,:), INTENT( out) :: pa_s_fra ! ice fraction covered by snow 1316 IF ( nn_snwfra == 0 ) THEN ! basic 0 or 1 snow cover 1317 WHERE( ph_s > 0._wp ) ; pa_s_fra = 1._wp 1318 ELSEWHERE ; pa_s_fra = 0._wp 1319 END WHERE 1320 ELSEIF( nn_snwfra == 1 ) THEN ! snow cover depends on hsnow (met-office style) 1321 pa_s_fra = 1._wp - EXP( -0.2_wp * rhos * ph_s ) 1322 ELSEIF( nn_snwfra == 2 ) THEN ! snow cover depends on hsnow (cice style) 1323 pa_s_fra = ph_s / ( ph_s + 0.02_wp ) 1324 ENDIF 1325 END SUBROUTINE ice_var_snwfra_2d 1326 1327 SUBROUTINE ice_var_snwfra_1d( ph_s, pa_s_fra ) 1328 REAL(wp), DIMENSION(:), INTENT(in ) :: ph_s ! snow thickness 1329 REAL(wp), DIMENSION(:), INTENT( out) :: pa_s_fra ! ice fraction covered by snow 1330 IF ( nn_snwfra == 0 ) THEN ! basic 0 or 1 snow cover 1331 WHERE( ph_s > 0._wp ) ; pa_s_fra = 1._wp 1332 ELSEWHERE ; pa_s_fra = 0._wp 1333 END WHERE 1334 ELSEIF( nn_snwfra == 1 ) THEN ! snow cover depends on hsnow (met-office style) 1335 pa_s_fra = 1._wp - EXP( -0.2_wp * rhos * ph_s ) 1336 ELSEIF( nn_snwfra == 2 ) THEN ! snow cover depends on hsnow (cice style) 1337 pa_s_fra = ph_s / ( ph_s + 0.02_wp ) 1338 ENDIF 1339 END SUBROUTINE ice_var_snwfra_1d 1340 1341 !!-------------------------------------------------------------------------- 1342 !! INTERFACE ice_var_snwblow 1343 !! 1344 !! ** Purpose : Compute distribution of precip over the ice 1345 !! 1346 !! Snow accumulation in one thermodynamic time step 1347 !! snowfall is partitionned between leads and ice. 1348 !! If snow fall was uniform, a fraction (1-at_i) would fall into leads 1349 !! but because of the winds, more snow falls on leads than on sea ice 1350 !! and a greater fraction (1-at_i)^beta of the total mass of snow 1351 !! (beta < 1) falls in leads. 1352 !! In reality, beta depends on wind speed, 1353 !! and should decrease with increasing wind speed but here, it is 1354 !! considered as a constant. an average value is 0.66 1355 !!-------------------------------------------------------------------------- 1356 !!gm I think it can be usefull to set this as a FUNCTION, not a SUBROUTINE.... 1357 SUBROUTINE ice_var_snwblow_2d( pin, pout ) 1358 REAL(wp), DIMENSION(:,:), INTENT(in ) :: pin ! previous fraction lead ( 1. - a_i_b ) 1359 REAL(wp), DIMENSION(:,:), INTENT(inout) :: pout 1360 pout = ( 1._wp - ( pin )**rn_snwblow ) 1361 END SUBROUTINE ice_var_snwblow_2d 1362 1363 SUBROUTINE ice_var_snwblow_1d( pin, pout ) 1364 REAL(wp), DIMENSION(:), INTENT(in ) :: pin 1365 REAL(wp), DIMENSION(:), INTENT(inout) :: pout 1366 pout = ( 1._wp - ( pin )**rn_snwblow ) 1367 END SUBROUTINE ice_var_snwblow_1d 1225 1368 1226 1369 #else
Note: See TracChangeset
for help on using the changeset viewer.
