Changeset 4523 for LMDZ6/trunk/libf/phylmdiso
- Timestamp:
- May 3, 2023, 6:21:08 PM (22 months ago)
- Location:
- LMDZ6/trunk
- Files:
-
- 11 edited
- 4 copied
-
. (modified) (1 prop)
-
libf/phylmdiso/add_phys_tend_mod.F90 (modified) (39 diffs)
-
libf/phylmdiso/blowing_snow_ini_mod.F90 (copied) (copied from LMDZ6/branches/blowing_snow/libf/phylmdiso/blowing_snow_ini_mod.F90)
-
libf/phylmdiso/blowing_snow_sublim_sedim.F90 (copied) (copied from LMDZ6/branches/blowing_snow/libf/phylmdiso/blowing_snow_sublim_sedim.F90)
-
libf/phylmdiso/call_blowing_snow_sublim_sedim.F90 (copied) (copied from LMDZ6/branches/blowing_snow/libf/phylmdiso/call_blowing_snow_sublim_sedim.F90)
-
libf/phylmdiso/climb_qbs_mod.F90 (copied) (copied from LMDZ6/branches/blowing_snow/libf/phylmdiso/climb_qbs_mod.F90)
-
libf/phylmdiso/pbl_surface_mod.F90 (modified) (45 diffs)
-
libf/phylmdiso/phyredem.F90 (modified) (2 diffs)
-
libf/phylmdiso/phys_local_var_mod.F90 (modified) (18 diffs)
-
libf/phylmdiso/phys_output_ctrlout_mod.F90 (modified) (8 diffs)
-
libf/phylmdiso/phys_output_var_mod.F90 (modified) (4 diffs)
-
libf/phylmdiso/physiq_mod.F90 (modified) (63 diffs)
-
libf/phylmdiso/surf_land_mod.F90 (modified) (9 diffs)
-
libf/phylmdiso/surf_landice_mod.F90 (modified) (16 diffs)
-
libf/phylmdiso/surf_ocean_mod.F90 (modified) (8 diffs)
Legend:
- Unmodified
- Added
- Removed
-
LMDZ6/trunk
- Property svn:mergeinfo changed
/LMDZ6/branches/blowing_snow (added) merged: 4485,4504,4506,4521
- Property svn:mergeinfo changed
-
LMDZ6/trunk/libf/phylmdiso/add_phys_tend_mod.F90
r4491 r4523 16 16 CONTAINS 17 17 18 SUBROUTINE add_pbl_tend(zdu, zdv, zdt, zdq, zdql, zdqi, paprs, text,abortphy,flag_inhib_tend, itap &18 SUBROUTINE add_pbl_tend(zdu, zdv, zdt, zdq, zdql, zdqi, zdqbs, paprs, text,abortphy,flag_inhib_tend, itap & 19 19 #ifdef ISO 20 20 ,zdxt,zdxtl,zdxti & … … 62 62 ! ------------ 63 63 REAL zdu(klon, klev), zdv(klon, klev) 64 REAL zdt(klon, klev), zdq(klon, klev), zdql(klon, klev), zdqi(klon, klev) 64 REAL zdt(klon, klev), zdq(klon, klev), zdql(klon, klev), zdqi(klon, klev), zdqbs(klon,klev) 65 65 CHARACTER *(*) text 66 66 REAL paprs(klon,klev+1) … … 104 104 PRINT *, ' add_pbl_tend, zzdt ', zzdt 105 105 PRINT *, ' add_pbl_tend, zzdq ', zzdq 106 CALL add_phys_tend(zdu, zdv, zzdt, zzdq, zdql, zdqi, paprs, text,abortphy,flag_inhib_tend, itap, 0 &106 CALL add_phys_tend(zdu, zdv, zzdt, zzdq, zdql, zdqi, zdqbs, paprs, text,abortphy,flag_inhib_tend, itap, 0 & 107 107 #ifdef ISO 108 108 ,zzdxt,zdxtl,zdxti & … … 110 110 ) 111 111 ELSE 112 CALL add_phys_tend(zdu, zdv, zdt, zdq, zdql, zdqi, paprs, text,abortphy,flag_inhib_tend, itap, 0 &112 CALL add_phys_tend(zdu, zdv, zdt, zdq, zdql, zdqi, zdqbs, paprs, text,abortphy,flag_inhib_tend, itap, 0 & 113 113 #ifdef ISO 114 114 ,zdxt,zdxtl,zdxti & … … 123 123 ! $Id$ 124 124 ! 125 SUBROUTINE add_phys_tend (zdu,zdv,zdt,zdq,zdql,zdqi, paprs,text, &125 SUBROUTINE add_phys_tend (zdu,zdv,zdt,zdq,zdql,zdqi,zdqbs,paprs,text, & 126 126 abortphy,flag_inhib_tend, itap, diag_mode & 127 127 #ifdef ISO … … 142 142 USE dimphy, ONLY: klon, klev 143 143 USE phys_state_var_mod, ONLY : phys_tstep 144 USE phys_local_var_mod, ONLY: u_seri, v_seri, ql_seri, qs_seri, q _seri, t_seri144 USE phys_local_var_mod, ONLY: u_seri, v_seri, ql_seri, qs_seri, qbs_seri, q_seri, t_seri 145 145 #ifdef ISO 146 146 USE phys_local_var_mod, ONLY: xtl_seri, xts_seri, xt_seri … … 150 150 USE print_control_mod, ONLY: prt_level 151 151 USE cmp_seri_mod 152 USE phys_output_var_mod, ONLY : d_qw_col, d_ql_col, d_qs_col, d_q t_col, d_ek_col, d_h_dair_col &153 & , d_h_qw_col, d_h_ql_col, d_h_qs_col, d_h_ col152 USE phys_output_var_mod, ONLY : d_qw_col, d_ql_col, d_qs_col, d_qbs_col, d_qt_col, d_ek_col, d_h_dair_col & 153 & , d_h_qw_col, d_h_ql_col, d_h_qs_col, d_h_qbs_col, d_h_col 154 154 155 155 #ifdef ISO … … 167 167 !------------ 168 168 REAL, DIMENSION(klon,klev), INTENT(IN) :: zdu, zdv 169 REAL, DIMENSION(klon,klev), INTENT(IN) :: zdt, zdql, zdqi 169 REAL, DIMENSION(klon,klev), INTENT(IN) :: zdt, zdql, zdqi, zdqbs 170 170 REAL, DIMENSION(klon,klev+1), INTENT(IN) :: paprs 171 171 CHARACTER*(*), INTENT(IN) :: text … … 197 197 ! Save variables, used in diagnostic mode (diag_mode=1). 198 198 REAL, DIMENSION(klon,klev) :: sav_u_seri, sav_v_seri 199 REAL, DIMENSION(klon,klev) :: sav_ql_seri, sav_qs_seri, sav_q _seri199 REAL, DIMENSION(klon,klev) :: sav_ql_seri, sav_qs_seri, sav_qbs_seri, sav_q_seri 200 200 REAL, DIMENSION(klon,klev) :: sav_t_seri 201 201 REAL, DIMENSION(klon,klev) :: sav_zdq … … 228 228 ! zh_ql_col---- total enthalpy of liquid watter (J/m2) 229 229 ! zh_qs_col---- total enthalpy of solid watter (J/m2) 230 ! zh_qbs_col---- total enthalpy of blowing snow (J/m2) 230 231 ! zqw_col------ total mass of watter vapour (kg/m2) 231 232 ! zql_col------ total mass of liquid watter (kg/m2) 232 ! zqs_col------ total mass of solid watter (kg/m2) 233 ! zqs_col------ total mass of cloud ice (kg/m2) 234 ! zqbs_col------ total mass of blowing snow (kg/m2) 233 235 ! zek_col------ total kinetic energy (kg/m2) 234 236 ! … … 237 239 REAL zql_col(klon,2) 238 240 REAL zqs_col(klon,2) 241 REAL zqbs_col(klon,2) 239 242 REAL zek_col(klon,2) 240 243 REAL zh_dair_col(klon,2) 241 REAL zh_qw_col(klon,2), zh_ql_col(klon,2), zh_qs_col(klon,2) 244 REAL zh_qw_col(klon,2), zh_ql_col(klon,2), zh_qs_col(klon,2), zh_qbs_col(klon,2) 242 245 REAL zh_col(klon,2) 243 246 … … 278 281 sav_ql_seri(:,:) = ql_seri(:,:) 279 282 sav_qs_seri(:,:) = qs_seri(:,:) 283 sav_qbs_seri(:,:) = qbs_seri(:,:) 280 284 sav_q_seri(:,:) = q_seri(:,:) 281 285 sav_t_seri(:,:) = t_seri(:,:) … … 304 308 305 309 CALL integr_v(klon, klev, zcpvap, & 306 t_seri, q_seri, ql_seri, qs_seri, u_seri, v_seri, zairm, &307 zqw_col(:,n), zql_col(:,n), zqs_col(:,n), z ek_col(:,n), zh_dair_col(:,n), &308 zh_qw_col(:,n), zh_ql_col(:,n), zh_qs_col(:,n), zh_ col(:,n))310 t_seri, q_seri, ql_seri, qs_seri, qbs_seri, u_seri, v_seri, zairm, & 311 zqw_col(:,n), zql_col(:,n), zqs_col(:,n), zqbs_col(:,n), zek_col(:,n), zh_dair_col(:,n), & 312 zh_qw_col(:,n), zh_ql_col(:,n), zh_qs_col(:,n), zh_qbs_col(:,n), zh_col(:,n)) 309 313 310 314 end if ! end if (fl_ebil .GT. 0) … … 337 341 ql_seri(:,:)=ql_seri(:,:)+zdql(:,:) 338 342 qs_seri(:,:)=qs_seri(:,:)+zdqi(:,:) 343 qbs_seri(:,:)=qbs_seri(:,:)+zdqbs(:,:) 339 344 #ifdef ISO 340 345 xtl_seri(:,:,:)=xtl_seri(:,:,:)+zdxtl(:,:,:) … … 601 606 ql_seri(:,:)=ql_seri(:,:)-zdql(:,:) 602 607 qs_seri(:,:)=qs_seri(:,:)-zdqi(:,:) 608 qbs_seri(:,:)=qbs_seri(:,:)-zdqbs(:,:) 603 609 ENDIF 604 610 … … 615 621 616 622 CALL integr_v(klon, klev, zcpvap, & 617 t_seri, q_seri, ql_seri, qs_seri, u_seri, v_seri, zairm, &618 zqw_col(:,n), zql_col(:,n), zqs_col(:,n), z ek_col(:,n), zh_dair_col(:,n), &619 zh_qw_col(:,n), zh_ql_col(:,n), zh_qs_col(:,n), zh_ col(:,n))623 t_seri, q_seri, ql_seri, qs_seri, qbs_seri, u_seri, v_seri, zairm, & 624 zqw_col(:,n), zql_col(:,n), zqs_col(:,n), zqbs_col(:,n), zek_col(:,n), zh_dair_col(:,n), & 625 zh_qw_col(:,n), zh_ql_col(:,n), zh_qs_col(:,n), zh_qbs_col(:,n), zh_col(:,n)) 620 626 621 627 ! ------------------------------------------------ … … 626 632 d_ql_col(:) = (zql_col(:,2)-zql_col(:,1))/phys_tstep 627 633 d_qs_col(:) = (zqs_col(:,2)-zqs_col(:,1))/phys_tstep 628 d_qt_col(:) = d_qw_col(:) + d_ql_col(:) + d_qs_col(:) 634 d_qbs_col(:) = (zqbs_col(:,2)-zqbs_col(:,1))/phys_tstep 635 d_qt_col(:) = d_qw_col(:) + d_ql_col(:) + d_qs_col(:) + d_qbs_col(:) 629 636 630 637 d_ek_col(:) = (zek_col(:,2)-zek_col(:,1))/phys_tstep … … 634 641 d_h_ql_col(:) = (zh_ql_col(:,2)-zh_ql_col(:,1))/phys_tstep 635 642 d_h_qs_col(:) = (zh_qs_col(:,2)-zh_qs_col(:,1))/phys_tstep 643 d_h_qbs_col(:) = (zh_qbs_col(:,2)-zh_qbs_col(:,1))/phys_tstep 636 644 637 645 d_h_col = (zh_col(:,2)-zh_col(:,1))/phys_tstep … … 645 653 ql_seri(:,:) = sav_ql_seri(:,:) 646 654 qs_seri(:,:) = sav_qs_seri(:,:) 655 qbs_seri(:,:) = sav_qbs_seri(:,:) 647 656 q_seri(:,:) = sav_q_seri(:,:) 648 657 t_seri(:,:) = sav_t_seri(:,:) … … 659 668 END SUBROUTINE add_phys_tend 660 669 661 SUBROUTINE diag_phys_tend (nlon, nlev, uu, vv, temp, qv, ql, qs, &662 zdu,zdv,zdt,zdq,zdql,zdqs, paprs,text)670 SUBROUTINE diag_phys_tend (nlon, nlev, uu, vv, temp, qv, ql, qs, qbs, & 671 zdu,zdv,zdt,zdq,zdql,zdqs,zdqbs,paprs,text) 663 672 !====================================================================== 664 673 ! Ajoute les tendances des variables physiques aux variables … … 676 685 USE print_control_mod, ONLY: prt_level 677 686 USE cmp_seri_mod 678 USE phys_output_var_mod, ONLY : d_qw_col, d_ql_col, d_qs_col, d_q t_col, d_ek_col, d_h_dair_col &679 & , d_h_qw_col, d_h_ql_col, d_h_qs_col, d_h_ col687 USE phys_output_var_mod, ONLY : d_qw_col, d_ql_col, d_qs_col, d_qbs_col, d_qt_col, d_ek_col, d_h_dair_col & 688 & , d_h_qw_col, d_h_ql_col, d_h_qs_col, d_h_qbs_col, d_h_col 680 689 IMPLICIT none 681 690 include "YOMCST.h" … … 686 695 INTEGER, INTENT(IN) :: nlon, nlev 687 696 REAL, DIMENSION(nlon,nlev), INTENT(IN) :: uu, vv 688 REAL, DIMENSION(nlon,nlev), INTENT(IN) :: temp, qv, ql, qs 697 REAL, DIMENSION(nlon,nlev), INTENT(IN) :: temp, qv, ql, qs, qbs 689 698 REAL, DIMENSION(nlon,nlev), INTENT(IN) :: zdu, zdv 690 REAL, DIMENSION(nlon,nlev), INTENT(IN) :: zdt, zdq, zdql, zdqs 699 REAL, DIMENSION(nlon,nlev), INTENT(IN) :: zdt, zdq, zdql, zdqs, zdqbs 691 700 REAL, DIMENSION(nlon,nlev+1), INTENT(IN) :: paprs 692 701 CHARACTER*(*), INTENT(IN) :: text … … 695 704 !-------- 696 705 REAL, DIMENSION(nlon,nlev) :: uu_n, vv_n 697 REAL, DIMENSION(nlon,nlev) :: temp_n, qv_n, ql_n, qs_n 706 REAL, DIMENSION(nlon,nlev) :: temp_n, qv_n, ql_n, qs_n, qbs_n 698 707 699 708 … … 718 727 ! zqw_col------ total mass of watter vapour (kg/m2) 719 728 ! zql_col------ total mass of liquid watter (kg/m2) 720 ! zqs_col------ total mass of solid watter (kg/m2) 729 ! zqs_col------ total mass of cloud ice (kg/m2) 730 ! zqbs_col------ total mass of blowing snow (kg/m2) 721 731 ! zek_col------ total kinetic energy (kg/m2) 722 732 ! … … 725 735 REAL zql_col(nlon,2) 726 736 REAL zqs_col(nlon,2) 737 REAL zqbs_col(nlon,2) 727 738 REAL zek_col(nlon,2) 728 739 REAL zh_dair_col(nlon,2) 729 REAL zh_qw_col(nlon,2), zh_ql_col(nlon,2), zh_qs_col(nlon,2) 740 REAL zh_qw_col(nlon,2), zh_ql_col(nlon,2), zh_qs_col(nlon,2), zh_qbs_col(nlon,2) 730 741 REAL zh_col(nlon,2) 731 742 … … 760 771 761 772 CALL integr_v(nlon, nlev, rcpv, & 762 temp, qv, ql, qs, uu, vv, zairm, &763 zqw_col(:,n), zql_col(:,n), zqs_col(:,n), z ek_col(:,n), zh_dair_col(:,n), &764 zh_qw_col(:,n), zh_ql_col(:,n), zh_qs_col(:,n), zh_ col(:,n))773 temp, qv, ql, qs, qbs, uu, vv, zairm, & 774 zqw_col(:,n), zql_col(:,n), zqs_col(:,n), zqbs_col(:,n), zek_col(:,n), zh_dair_col(:,n), & 775 zh_qw_col(:,n), zh_ql_col(:,n), zh_qs_col(:,n), zh_qbs_col(:,n), zh_col(:,n)) 765 776 766 777 end if ! end if (fl_ebil .GT. 0) … … 775 786 ql_n(:,:)=ql(:,:)+zdql(:,:) 776 787 qs_n(:,:)=qs(:,:)+zdqs(:,:) 788 qbs_n(:,:)=qbs(:,:)+zdqbs(:,:) 777 789 temp_n(:,:)=temp(:,:)+zdt(:,:) 778 790 … … 791 803 792 804 CALL integr_v(nlon, nlev, rcpv, & 793 temp_n, qv_n, ql_n, qs_n, uu_n, vv_n, zairm, &794 zqw_col(:,n), zql_col(:,n), zqs_col(:,n), z ek_col(:,n), zh_dair_col(:,n), &795 zh_qw_col(:,n), zh_ql_col(:,n), zh_qs_col(:,n), zh_ col(:,n))805 temp_n, qv_n, ql_n, qs_n, qbs_n, uu_n, vv_n, zairm, & 806 zqw_col(:,n), zql_col(:,n), zqs_col(:,n), zqbs_col(:,n), zek_col(:,n), zh_dair_col(:,n), & 807 zh_qw_col(:,n), zh_ql_col(:,n), zh_qs_col(:,n), zh_qbs_col(:,n), zh_col(:,n)) 796 808 797 809 ! ------------------------------------------------ … … 802 814 d_ql_col(:) = (zql_col(:,2)-zql_col(:,1))/phys_tstep 803 815 d_qs_col(:) = (zqs_col(:,2)-zqs_col(:,1))/phys_tstep 804 d_qt_col(:) = d_qw_col(:) + d_ql_col(:) + d_qs_col(:) 816 d_qbs_col(:) = (zqbs_col(:,2)-zqbs_col(:,1))/phys_tstep 817 d_qt_col(:) = d_qw_col(:) + d_ql_col(:) + d_qs_col(:) + d_qbs_col(:) 805 818 806 819 d_ek_col(:) = (zek_col(:,2)-zek_col(:,1))/phys_tstep … … 814 827 d_h_ql_col(:) = (zh_ql_col(:,2)-zh_ql_col(:,1))/phys_tstep 815 828 d_h_qs_col(:) = (zh_qs_col(:,2)-zh_qs_col(:,1))/phys_tstep 829 d_h_qbs_col(:) = (zh_qbs_col(:,2)-zh_qbs_col(:,1))/phys_tstep 816 830 817 831 d_h_col = (zh_col(:,2)-zh_col(:,1))/phys_tstep … … 824 838 825 839 SUBROUTINE integr_v(nlon, nlev, zcpvap, & 826 temp, qv, ql, qs, uu, vv, zairm, &827 zqw_col, zql_col, zqs_col, z ek_col, zh_dair_col, &828 zh_qw_col, zh_ql_col, zh_qs_col, zh_ col)840 temp, qv, ql, qs, qbs, uu, vv, zairm, & 841 zqw_col, zql_col, zqs_col, zqbs_col, zek_col, zh_dair_col, & 842 zh_qw_col, zh_ql_col, zh_qs_col, zh_qbs_col, zh_col) 829 843 830 844 IMPLICIT none … … 833 847 INTEGER, INTENT(IN) :: nlon,nlev 834 848 REAL, INTENT(IN) :: zcpvap 835 REAL, DIMENSION(nlon,nlev), INTENT(IN) :: temp, qv, ql, qs, uu, vv849 REAL, DIMENSION(nlon,nlev), INTENT(IN) :: temp, qv, ql, qs, qbs, uu, vv 836 850 REAL, DIMENSION(nlon,nlev), INTENT(IN) :: zairm 837 851 REAL, DIMENSION(nlon), INTENT(OUT) :: zqw_col 838 852 REAL, DIMENSION(nlon), INTENT(OUT) :: zql_col 839 REAL, DIMENSION(nlon), INTENT(OUT) :: zqs_col 853 REAL, DIMENSION(nlon), INTENT(OUT) :: zqs_col, zqbs_col 840 854 REAL, DIMENSION(nlon), INTENT(OUT) :: zek_col 841 855 REAL, DIMENSION(nlon), INTENT(OUT) :: zh_dair_col 842 856 REAL, DIMENSION(nlon), INTENT(OUT) :: zh_qw_col 843 857 REAL, DIMENSION(nlon), INTENT(OUT) :: zh_ql_col 844 REAL, DIMENSION(nlon), INTENT(OUT) :: zh_qs_col 858 REAL, DIMENSION(nlon), INTENT(OUT) :: zh_qs_col, zh_qbs_col 845 859 REAL, DIMENSION(nlon), INTENT(OUT) :: zh_col 846 860 … … 852 866 zql_col(:) = 0. 853 867 zqs_col(:) = 0. 868 zqbs_col(:) = 0. 854 869 zek_col(:) = 0. 855 870 zh_dair_col(:) = 0. … … 857 872 zh_ql_col(:) = 0. 858 873 zh_qs_col(:) = 0. 874 zh_qbs_col(:) = 0. 859 875 860 876 !JLD write (*,*) "rcpd, zcpvap, zcwat, zcice ",rcpd, zcpvap, zcwat, zcice … … 869 885 zql_col(i) = zql_col(i) + ql(i, k)*zairm(i, k) 870 886 zqs_col(i) = zqs_col(i) + qs(i, k)*zairm(i, k) 887 zqbs_col(i)= zqbs_col(i) + qbs(i,k)*zairm(i,k) 871 888 ! Kinetic Energy 872 889 zek_col(i) = zek_col(i) + 0.5*(uu(i,k)**2+vv(i,k)**2)*zairm(i, k) … … 877 894 zh_ql_col(i) = zh_ql_col(i) + (zcpvap*temp(i, k) - rlvtt)*ql(i, k)*zairm(i, k) !jyg 878 895 zh_qs_col(i) = zh_qs_col(i) + (zcpvap*temp(i, k) - rlstt)*qs(i, k)*zairm(i, k) !jyg 896 zh_qbs_col(i) = zh_qbs_col(i) + (zcpvap*temp(i, k) - rlstt)*qbs(i, k)*zairm(i, k) !jyg 879 897 END DO 880 898 END DO 881 899 ! compute total air enthalpy 882 zh_col(:) = zh_dair_col(:) + zh_qw_col(:) + zh_ql_col(:) + zh_qs_col(:) 900 zh_col(:) = zh_dair_col(:) + zh_qw_col(:) + zh_ql_col(:) + zh_qs_col(:) + zh_qbs_col(:) 883 901 884 902 END SUBROUTINE integr_v … … 895 913 USE dimphy, ONLY: klon, klev 896 914 USE phys_state_var_mod, ONLY : phys_tstep 897 USE phys_state_var_mod, ONLY : topsw, toplw, solsw, sollw, rain_con, snow_con 915 USE phys_state_var_mod, ONLY : topsw, toplw, solsw, sollw, rain_con, snow_con, bs_fall 898 916 USE geometry_mod, ONLY: longitude_deg, latitude_deg 899 917 USE print_control_mod, ONLY: prt_level 900 918 USE cmp_seri_mod 901 USE phys_output_var_mod, ONLY : d_qw_col, d_ql_col, d_qs_col, d_q t_col, d_ek_col, d_h_dair_col &902 & , d_h_qw_col, d_h_ql_col, d_h_qs_col, d_h_ col919 USE phys_output_var_mod, ONLY : d_qw_col, d_ql_col, d_qs_col, d_qbs_col, d_qt_col, d_ek_col, d_h_dair_col & 920 & , d_h_qw_col, d_h_ql_col, d_h_qs_col, d_h_qbs_col, d_h_col 903 921 USE phys_local_var_mod, ONLY: evap, sens 904 USE phys_local_var_mod, ONLY: u_seri, v_seri, ql_seri, qs_seri, q _seri, t_seri &922 USE phys_local_var_mod, ONLY: u_seri, v_seri, ql_seri, qs_seri, qbs_seri, q_seri, t_seri & 905 923 & , rain_lsc, snow_lsc 906 924 USE climb_hq_mod, ONLY : d_h_col_vdf, f_h_bnd … … 939 957 bilh_bnd = (-(rcw-rcpd)*t_seri(1,1) + rlvtt) * rain_lsc(1) & 940 958 & + (-(rcs-rcpd)*t_seri(1,1) + rlstt) * snow_lsc(1) 959 CASE("bs") param 960 bilq_bnd = - bs_fall(1) 961 bilh_bnd = (-(rcs-rcpd)*t_seri(1,1) + rlstt) * bs_fall(1) 941 962 CASE("convection") param 942 963 bilq_bnd = - rain_con(1) - snow_con(1) … … 975 996 if ( prt_level .GE. 5) then 976 997 write(*,9000) text,"enerbil at boundaries: Q, H",bilq_bnd, bilh_bnd 977 write(*,9000) text,"enerbil: water budget",d_qt_col(1),d_qw_col(1),d_ql_col(1),d_qs_col(1) 978 write(*,9000) text,"enerbil: enthalpy budget",d_h_col(1),d_h_dair_col(1),d_h_qw_col(1),d_h_ql_col(1),d_h_qs_col(1) 998 write(*,9000) text,"enerbil: water budget",d_qt_col(1),d_qw_col(1),d_ql_col(1),d_qs_col(1), d_qbs_col(1) 999 write(*,9000) text,"enerbil: enthalpy budget",d_h_col(1),d_h_dair_col(1),d_h_qw_col(1),d_h_ql_col(1),d_h_qs_col(1),d_h_qbs_col(1) 979 1000 end if 980 1001 -
LMDZ6/trunk/libf/phylmdiso/pbl_surface_mod.F90
r4491 r4523 21 21 USE cpl_mod, ONLY : gath2cpl 22 22 USE climb_hq_mod, ONLY : climb_hq_down, climb_hq_up 23 USE climb_qbs_mod, ONLY : climb_qbs_down, climb_qbs_up 23 24 USE climb_wind_mod, ONLY : climb_wind_down, climb_wind_up 24 25 USE coef_diff_turb_mod, ONLY : coef_diff_turb … … 261 262 rlon, rlat, rugoro, rmu0, & 262 263 lwdown_m, cldt, & 263 rain_f, snow_f, solsw_m, solswfdiff_m, sollw_m, &264 rain_f, snow_f, bs_f, solsw_m, solswfdiff_m, sollw_m, & 264 265 gustiness, & 265 t, q, u, v, &266 t, q, qbs, u, v, & 266 267 !!! nrlmd+jyg le 02/05/2011 et le 20/02/2012 267 268 !! t_x, q_x, t_w, q_w, & … … 275 276 beta, & 276 277 !>jyg 277 alb_dir_m, alb_dif_m, zxsens, zxevap, &278 alb_dir_m, alb_dif_m, zxsens, zxevap, zxsnowerosion, & 278 279 alb3_lic, runoff, snowhgt, qsnow, to_ice, sissnow, & 279 280 zxtsol, zxfluxlat, zt2m, qsat2m, zn2mout, & 280 d_t, d_q, d_u, d_v, d_t_diss, &281 d_t, d_q, d_qbs, d_u, d_v, d_t_diss, & 281 282 !!! nrlmd+jyg le 02/05/2011 et le 20/02/2012 282 283 d_t_w, d_q_w, & … … 301 302 rh2m, zxfluxu, zxfluxv, & 302 303 z0m, z0h, agesno, sollw, solsw, & 303 d_ts, evap, fluxlat, t2m, &304 d_ts, evap, fluxlat, t2m, & 304 305 wfbils, wfbilo, wfevap, wfrain, wfsnow, & 305 306 flux_t, flux_u, flux_v, & … … 307 308 !jyg< 308 309 !! zxfluxt, zxfluxq, q2m, flux_q, tke, & 309 zxfluxt, zxfluxq, q2m, flux_q, tke_x, &310 zxfluxt, zxfluxq, zxfluxqbs, q2m, flux_q, flux_qbs, tke_x, & 310 311 !>jyg 311 312 !!! nrlmd+jyg le 02/05/2011 et le 20/02/2012 … … 410 411 dser, dt_ds, zsig, zmea 411 412 use phys_output_var_mod, only: tkt, tks, taur, sss 413 use blowing_snow_ini_mod, only : zeta_bs 412 414 #ifdef CPP_XIOS 413 415 USE wxios, ONLY: missing_val … … 444 446 REAL, DIMENSION(klon), INTENT(IN) :: rain_f ! rain fall 445 447 REAL, DIMENSION(klon), INTENT(IN) :: snow_f ! snow fall 448 REAL, DIMENSION(klon), INTENT(IN) :: bs_f ! blowing snow fall 446 449 REAL, DIMENSION(klon), INTENT(IN) :: solsw_m ! net shortwave radiation at mean surface 447 450 REAL, DIMENSION(klon), INTENT(IN) :: solswfdiff_m ! diffuse fraction fordownward shortwave radiation at mean surface … … 449 452 REAL, DIMENSION(klon,klev), INTENT(IN) :: t ! temperature (K) 450 453 REAL, DIMENSION(klon,klev), INTENT(IN) :: q ! water vapour (kg/kg) 454 REAL, DIMENSION(klon,klev), INTENT(IN) :: qbs ! blowing snow specific content (kg/kg) 451 455 REAL, DIMENSION(klon,klev), INTENT(IN) :: u ! u speed 452 456 REAL, DIMENSION(klon,klev), INTENT(IN) :: v ! v speed … … 521 525 ! (=> positive sign upwards) 522 526 REAL, DIMENSION(klon), INTENT(OUT) :: zxevap ! water vapour flux at surface, positiv upwards 527 REAL, DIMENSION(klon), INTENT(OUT) :: zxsnowerosion ! blowing snow flux at surface 523 528 REAL, DIMENSION(klon), INTENT(OUT) :: zxtsol ! temperature at surface, mean for each grid point 524 529 !!! jyg le ??? … … 537 542 REAL, DIMENSION(klon, klev), INTENT(OUT) :: d_u ! change in u speed 538 543 REAL, DIMENSION(klon, klev), INTENT(OUT) :: d_v ! change in v speed 544 REAL, DIMENSION(klon, klev), INTENT(OUT) :: d_qbs ! change in blowing snow specific content 545 539 546 540 547 REAL, INTENT(OUT):: zcoefh(:, :, :) ! (klon, klev, nbsrf + 1) … … 604 611 REAL, DIMENSION(klon, nbsrf), INTENT(OUT) :: sollw ! net longwave radiation at surface 605 612 REAL, DIMENSION(klon, nbsrf), INTENT(OUT) :: d_ts ! change in temperature at surface 606 REAL, DIMENSION(klon, nbsrf), INTENT(INOUT) :: evap ! evaporation at surface613 REAL, DIMENSION(klon, nbsrf), INTENT(INOUT) :: evap ! evaporation at surface 607 614 REAL, DIMENSION(klon, nbsrf), INTENT(OUT) :: fluxlat ! latent flux 608 615 REAL, DIMENSION(klon, nbsrf), INTENT(OUT) :: t2m ! temperature at 2 meter height … … 631 638 REAL, DIMENSION(klon, klev), INTENT(OUT) :: zxfluxt ! sensible heat flux, mean for each grid point 632 639 REAL, DIMENSION(klon, klev), INTENT(OUT) :: zxfluxq ! water vapour flux, mean for each grid point 640 REAL, DIMENSION(klon, klev), INTENT(OUT) :: zxfluxqbs ! blowing snow flux, mean for each grid point 633 641 REAL, DIMENSION(klon, nbsrf),INTENT(OUT) :: q2m ! water vapour at 2 meter height 634 642 REAL, DIMENSION(klon, klev, nbsrf), INTENT(OUT) :: flux_q ! water vapour flux(latent flux) (kg/m**2/s) 643 REAL, DIMENSION(klon, klev, nbsrf), INTENT(OUT) :: flux_qbs ! blowind snow vertical flux (kg/m**2 644 635 645 #ifdef ISO 636 646 REAL, DIMENSION(ntraciso,klon), INTENT(OUT) :: dflux_xt ! change of water vapour flux … … 683 693 REAL, DIMENSION(klon) :: yalb,yalb_vis 684 694 !albedo SB <<< 685 REAL, DIMENSION(klon) :: yt1, yq1, yu1, yv1 695 REAL, DIMENSION(klon) :: yt1, yq1, yu1, yv1, yqbs1 686 696 REAL, DIMENSION(klon) :: yqa 687 697 REAL, DIMENSION(klon) :: ysnow, yqsurf, yagesno, yqsol 688 REAL, DIMENSION(klon) :: yrain_f, ysnow_f 698 REAL, DIMENSION(klon) :: yrain_f, ysnow_f, ybs_f 689 699 #ifdef ISO 690 700 REAL, DIMENSION(ntraciso,klon) :: yxt1 … … 699 709 REAL, DIMENSION(klon) :: yrugoro 700 710 REAL, DIMENSION(klon) :: yfluxlat 711 REAL, DIMENSION(klon) :: yfluxbs 701 712 REAL, DIMENSION(klon) :: y_d_ts 702 713 REAL, DIMENSION(klon) :: y_flux_t1, y_flux_q1 … … 707 718 #endif 708 719 REAL, DIMENSION(klon) :: y_flux_u1, y_flux_v1 720 REAL, DIMENSION(klon) :: y_flux_bs, y_flux0 709 721 REAL, DIMENSION(klon) :: yt2m, yq2m, yu10m 710 722 INTEGER, DIMENSION(klon, nbsrf, 6) :: yn2mout, yn2mout_x, yn2mout_w … … 736 748 #endif 737 749 REAL, DIMENSION(klon) :: AcoefU, AcoefV, BcoefU, BcoefV 750 REAL, DIMENSION(klon) :: AcoefQBS, BcoefQBS 738 751 REAL, DIMENSION(klon) :: ypsref 739 752 REAL, DIMENSION(klon) :: yevap, yevap_pot, ytsurf_new, yalb3_new … … 744 757 REAL, DIMENSION(klon) :: meansqT ! mean square deviation of subsurface temperatures 745 758 REAL, DIMENSION(klon) :: alb_m ! mean albedo for whole SW interval 746 REAL, DIMENSION(klon,klev) :: y_d_t, y_d_q, y_d_t_diss 759 REAL, DIMENSION(klon,klev) :: y_d_t, y_d_q, y_d_t_diss, y_d_qbs 747 760 REAL, DIMENSION(klon,klev) :: y_d_u, y_d_v 748 REAL, DIMENSION(klon,klev) :: y_flux_t, y_flux_q 761 REAL, DIMENSION(klon,klev) :: y_flux_t, y_flux_q, y_flux_qbs 749 762 REAL, DIMENSION(klon,klev) :: y_flux_u, y_flux_v 750 REAL, DIMENSION(klon,klev) :: ycoefh, ycoefm,ycoefq 763 REAL, DIMENSION(klon,klev) :: ycoefh, ycoefm,ycoefq, ycoefqbs 751 764 REAL, DIMENSION(klon) :: ycdragh, ycdragq, ycdragm 752 765 REAL, DIMENSION(klon,klev) :: yu, yv 753 REAL, DIMENSION(klon,klev) :: yt, yq 766 REAL, DIMENSION(klon,klev) :: yt, yq, yqbs 754 767 #ifdef ISO 755 768 REAL, DIMENSION(ntraciso,klon) :: yxtevap … … 819 832 REAL, DIMENSION(klon,klev) :: CcoefH, CcoefQ, DcoefH, DcoefQ 820 833 REAL, DIMENSION(klon,klev) :: CcoefU, CcoefV, DcoefU, DcoefV 834 REAL, DIMENSION(klon,klev) :: CcoefQBS, DcoefQBS 821 835 REAL, DIMENSION(klon,klev) :: CcoefH_x, CcoefQ_x, DcoefH_x, DcoefQ_x 822 836 REAL, DIMENSION(klon,klev) :: CcoefH_w, CcoefQ_w, DcoefH_w, DcoefQ_w … … 824 838 REAL, DIMENSION(klon,klev) :: CcoefU_w, CcoefV_w, DcoefU_w, DcoefV_w 825 839 REAL, DIMENSION(klon,klev) :: Kcoef_hq, Kcoef_m, gama_h, gama_q 840 REAL, DIMENSION(klon,klev) :: gama_qbs, Kcoef_qbs 826 841 REAL, DIMENSION(klon,klev) :: Kcoef_hq_x, Kcoef_m_x, gama_h_x, gama_q_x 827 842 REAL, DIMENSION(klon,klev) :: Kcoef_hq_w, Kcoef_m_w, gama_h_w, gama_q_w … … 1016 1031 REAL, DIMENSION(klon,nbsrf) :: zx_t1 1017 1032 REAL, DIMENSION(klon, nbsrf) :: alb ! mean albedo for whole SW interval 1033 REAL, DIMENSION(klon,nbsrf) :: snowerosion 1018 1034 REAL, DIMENSION(klon) :: ylwdown ! jg : temporary (ysollwdown) 1019 1035 REAL, DIMENSION(klon) :: ygustiness ! jg : temporary (ysollwdown) … … 1189 1205 alb_dir_m=0. ; alb_dif_m=0. ; alb3_lic(:)=0. 1190 1206 !albedo SB <<< 1191 zxsens(:)=0. ; zxevap(:)=0. ; zxtsol(:)=0. 1207 zxsens(:)=0. ; zxevap(:)=0. ; zxtsol(:)=0. ; zxsnowerosion(:)=0. 1192 1208 d_t_w(:,:)=0. ; d_q_w(:,:)=0. ; d_t_x(:,:)=0. ; d_q_x(:,:)=0. 1193 1209 zxfluxlat(:)=0. 1194 1210 zt2m(:)=0. ; zq2m(:)=0. ; qsat2m(:)=0. ; rh2m(:)=0. 1195 1211 zn2mout(:,:)=0 ; 1196 d_t(:,:)=0. ; d_t_diss(:,:)=0. ; d_q(:,:)=0. ; d_ u(:,:)=0. ; d_v(:,:)=0.1212 d_t(:,:)=0. ; d_t_diss(:,:)=0. ; d_q(:,:)=0. ; d_qbs(:,:)=0. ; d_u(:,:)=0. ; d_v(:,:)=0. 1197 1213 zcoefh(:,:,:)=0. ; zcoefm(:,:,:)=0. 1198 1214 zxsens_x(:)=0. ; zxsens_w(:)=0. ; zxfluxlat_x(:)=0. ; zxfluxlat_w(:)=0. … … 1214 1230 d_ts(:,:)=0. 1215 1231 evap(:,:)=0. 1232 snowerosion(:,:)=0. 1216 1233 fluxlat(:,:)=0. 1217 1234 wfbils(:,:)=0. ; wfbilo(:,:)=0. 1218 1235 wfevap(:,:)=0. ; wfrain(:,:)=0. ; wfsnow(:,:)=0. 1219 1236 flux_t(:,:,:)=0. ; flux_q(:,:,:)=0. ; flux_u(:,:,:)=0. ; flux_v(:,:,:)=0. 1237 flux_qbs(:,:,:)=0. 1220 1238 dflux_t(:)=0. ; dflux_q(:)=0. 1221 1239 zxsnow(:)=0. 1222 zxfluxt(:,:)=0. ; zxfluxq(:,:)=0. 1240 zxfluxt(:,:)=0. ; zxfluxq(:,:)=0.; zxfluxqbs(:,:)=0. 1223 1241 qsnow(:)=0. ; snowhgt(:)=0. ; to_ice(:)=0. ; sissnow(:)=0. 1224 1242 runoff(:)=0. … … 1266 1284 yqsurf = 0.0 ; yalb = 0.0 ; yalb_vis = 0.0 1267 1285 !albedo SB <<< 1268 yrain_f = 0.0 ; ysnow_f = 0.0 ; yfder = 0.0 ; ysolsw = 0.01286 yrain_f = 0.0 ; ysnow_f = 0.0 ; ybs_f=0.0 ; yfder = 0.0 ; ysolsw = 0.0 1269 1287 ysollw = 0.0 ; yz0m = 0.0 ; yz0h = 0.0 ; yu1 = 0.0 1270 yv1 = 0.0 ; ypaprs = 0.0 ; ypplay = 0.0 1288 yv1 = 0.0 ; ypaprs = 0.0 ; ypplay = 0.0 ; yqbs1 = 0.0 1271 1289 ydelp = 0.0 ; yu = 0.0 ; yv = 0.0 ; yt = 0.0 1272 1290 yq = 0.0 ; y_dflux_t = 0.0 ; y_dflux_q = 0.0 1291 yqbs(:,:)=0.0 1273 1292 yrugoro = 0.0 ; ywindsp = 0.0 1274 1293 !! d_ts = 0.0 ; yfluxlat=0.0 ; flux_t = 0.0 ; flux_q = 0.0 1275 yfluxlat=0.0 1294 yfluxlat=0.0 ; y_flux0(:)=0.0 1276 1295 !! flux_u = 0.0 ; flux_v = 0.0 ; d_t = 0.0 ; d_q = 0.0 1277 1296 !! d_t_diss= 0.0 ;d_u = 0.0 ; d_v = 0.0 … … 1288 1307 ycldt = 0.0 ; yrmu0 = 0.0 1289 1308 ! Martin 1309 y_d_qbs(:,:)=0.0 1290 1310 1291 1311 !!! nrlmd+jyg le 02/05/2011 et le 20/02/2012 … … 1629 1649 yrain_f(j) = rain_f(i) 1630 1650 ysnow_f(j) = snow_f(i) 1651 ybs_f(j) = bs_f(i) 1631 1652 yagesno(j) = agesno(i,nsrf) 1632 1653 yfder(j) = fder(i) … … 1640 1661 yu1(j) = u(i,1) 1641 1662 yv1(j) = v(i,1) 1663 yqbs1(j) = qbs(i,1) 1642 1664 ypaprs(j,klev+1) = paprs(i,klev+1) 1643 1665 !jyg< … … 1653 1675 !!! nrlmd le 13/06/2011 1654 1676 y_delta_tsurf(j)=delta_tsurf(i,nsrf) 1677 yfluxbs(j)=0.0 1678 y_flux_bs(j) = 0.0 1655 1679 !!! 1656 1680 #ifdef ISO … … 1721 1745 yt(j,k) = t(i,k) 1722 1746 yq(j,k) = q(i,k) 1747 yqbs(j,k)=qbs(i,k) 1723 1748 #ifdef ISO 1724 1749 do ixt=1,ntraciso … … 1951 1976 print *,' args coef_diff_turb: ycdragh ', ycdragh 1952 1977 print *,' args coef_diff_turb: ytke ', ytke 1953 1954 1978 ENDIF 1955 1979 … … 1960 1984 1961 1985 ELSE 1962 1963 1986 1964 1987 CALL coef_diff_turb(dtime, nsrf, knon, ni, & … … 1981 2004 1982 2005 IF (prt_level >=10) print *,'coef_diff_turb -> ycoefh ',ycoefh 1983 ! 2006 2007 1984 2008 ELSE !(iflag_split .eq.0) 2009 1985 2010 IF (prt_level >=10) THEN 1986 2011 print *,' args coef_diff_turb: yu_x ', yu_x … … 2020 2045 ENDIF 2021 2046 2022 ENDIF ! iflag_pbl >= 502047 ENDIF ! iflag_pbl >= 50 2023 2048 2024 2049 IF (prt_level >=10) print *,'coef_diff_turb -> ycoefh_x ',ycoefh_x … … 2034 2059 print *,' args coef_diff_turb: ycdragh_w ', ycdragh_w 2035 2060 print *,' args coef_diff_turb: ytke_w ', ytke_w 2036 2061 ENDIF 2037 2062 2038 2063 IF (iflag_pbl>=50) THEN … … 2062 2087 2063 2088 IF (prt_level >=10) print *,'coef_diff_turb -> ycoefh_w ',ycoefh_w 2064 ! 2089 2065 2090 !!!jyg le 10/04/2013 2066 2091 !! En attendant de traiter le transport des traceurs dans les poches froides, formule … … 2072 2097 ENDDO 2073 2098 ENDDO 2074 !!!2075 2099 ENDIF ! (iflag_split .eq.0) 2076 !!!2077 2100 2078 2101 !**************************************************************************************** … … 2171 2194 ENDIF ! (iflag_split .eq.0) 2172 2195 !!! 2196 2197 ! For blowing snow: 2198 IF (ok_bs) THEN 2199 ! following Bintanja et al 2000, part II 2200 ! we assume that the eddy diffuvisity coefficient for 2201 ! suspended particles is larger than Km by a factor zeta_bs 2202 ! which is equal to 3 by default 2203 ycoefqbs=ycoefm*zeta_bs 2204 CALL climb_qbs_down(knon, ycoefqbs, ypaprs, ypplay, & 2205 ydelp, yt, yqbs, dtime, & 2206 CcoefQBS, DcoefQBS, & 2207 Kcoef_qbs, gama_qbs, & 2208 AcoefQBS, BcoefQBS) 2209 ENDIF 2210 2173 2211 2174 2212 !**************************************************************************************** … … 2356 2394 debut, lafin, ydelp(:,1), r_co2_ppm, ysolsw, ysollw, yalb, & 2357 2395 !!jyg yts, ypplay(:,1), ycdragh, ycdragm, yrain_f, ysnow_f, yt(:,1), yq(:,1),& 2358 yts, ypplay(:,1), ycdragh, ycdragm, yrain_f, ysnow_f, y t1, yq1,&2396 yts, ypplay(:,1), ycdragh, ycdragm, yrain_f, ysnow_f, ybs_f, yt1, yq1,& 2359 2397 AcoefH, AcoefQ, BcoefH, BcoefQ, & 2360 2398 AcoefU, AcoefV, BcoefU, BcoefV, & … … 2362 2400 ylwdown, yq2m, yt2m, & 2363 2401 ysnow, yqsol, yagesno, ytsoil, & 2364 yz0m, yz0h, SFRWL, yalb_dir_new, yalb_dif_new, yevap, yfluxsens,yfluxlat, &2402 yz0m, yz0h, SFRWL, yalb_dir_new, yalb_dif_new, yevap, yfluxsens,yfluxlat,yfluxbs,& 2365 2403 yqsurf, ytsurf_new, y_dflux_t, y_dflux_q, & 2366 2404 y_flux_u1, y_flux_v1, & … … 2433 2471 yrmu0, ylwdown, yalb, zgeo1, & 2434 2472 ysolsw, ysollw, yts, ypplay(:,1), & 2435 !!jyg ycdragh, ycdragm, yrain_f, ysnow_f, yt(:,1), yq(:,1),& 2436 ycdragh, ycdragm, yrain_f, ysnow_f, yt1, yq1,& 2473 ycdragh, ycdragm, yrain_f, ysnow_f, ybs_f, yt1, yq1,& 2437 2474 AcoefH, AcoefQ, BcoefH, BcoefQ, & 2438 2475 AcoefU, AcoefV, BcoefU, BcoefV, & 2439 2476 ypsref, yu1, yv1, ygustiness, yrugoro, pctsrf, & 2440 ysnow, yqsurf, yqsol, yagesno, &2477 ysnow, yqsurf, yqsol,yqbs1, yagesno, & 2441 2478 ytsoil, yz0m, yz0h, SFRWL, yalb_dir_new, yalb_dif_new, yevap,yfluxsens,yfluxlat, & 2442 y tsurf_new, y_dflux_t, y_dflux_q, &2479 yfluxbs, ytsurf_new, y_dflux_t, y_dflux_q, & 2443 2480 yzmea, yzsig, ycldt, & 2444 2481 ysnowhgt, yqsnow, ytoice, ysissnow, & … … 2499 2536 itap, dtime, jour, knon, ni, & 2500 2537 !!jyg ypplay(:,1), zgeo1/RG, ycdragh, ycdragm, yrain_f, ysnow_f, yt(:,1), yq(:,1),& 2501 ypplay(:,1), zgeo1(1:knon)/RG, ycdragh, ycdragm, yrain_f, ysnow_f, y t(:,1), yq(:,1),& ! ym missing init2538 ypplay(:,1), zgeo1(1:knon)/RG, ycdragh, ycdragm, yrain_f, ysnow_f, ybs_f, yt(:,1), yq(:,1),& ! ym missing init 2502 2539 AcoefH, AcoefQ, BcoefH, BcoefQ, & 2503 2540 AcoefU, AcoefV, BcoefU, BcoefV, & … … 2664 2701 ENDDO 2665 2702 ENDIF ! (ok_flux_surf) 2703 2704 ! flux of blowing snow at the first level 2705 IF (ok_bs) THEN 2706 DO j=1,knon 2707 y_flux_bs(j)=yfluxbs(j) 2708 ENDDO 2709 ENDIF 2666 2710 ! 2667 2711 ! ------------------------------------------------------------------------------ … … 2991 3035 ! 2992 3036 ENDIF ! (iflag_split .eq.0) 3037 3038 IF (ok_bs) THEN 3039 CALL climb_qbs_up(knon, dtime, yqbs, & 3040 y_flux_bs, ypaprs, ypplay, & 3041 AcoefQBS, BcoefQBS, & 3042 CcoefQBS, DcoefQBS, & 3043 Kcoef_qbs, gama_qbs, & 3044 y_flux_qbs(:,:), y_d_qbs(:,:)) 3045 ENDIF 3046 2993 3047 !!! 2994 3048 !! … … 3157 3211 !!! 3158 3212 3159 ! print*,'Dans pbl OK1' 3160 3161 !jyg< 3162 !! evap(:,nsrf) = - flux_q(:,1,nsrf) 3163 !>jyg 3213 ! tendencies of blowing snow 3214 IF (ok_bs) THEN 3215 DO k = 1, klev 3216 DO j = 1, knon 3217 i = ni(j) 3218 y_d_qbs(j,k)=y_d_qbs(j,k) * ypct(j) 3219 flux_qbs(i,k,nsrf) = y_flux_qbs(j,k) 3220 ENDDO 3221 ENDDO 3222 ENDIF 3223 3224 3164 3225 DO j = 1, knon 3165 3226 i = ni(j) 3166 3227 evap(i,nsrf) = - flux_q(i,1,nsrf) !jyg 3228 if (ok_bs) then ; snowerosion(i,nsrf)=flux_qbs(i,1,nsrf); endif 3167 3229 beta(i,nsrf) = ybeta(j) !jyg 3168 3230 d_ts(i,nsrf) = y_d_ts(j) … … 3392 3454 ENDDO 3393 3455 ENDDO 3456 3457 3458 IF (ok_bs) THEN 3459 DO k = 1, klev 3460 DO j = 1, knon 3461 i = ni(j) 3462 d_qbs(i,k) = d_qbs(i,k) + y_d_qbs(j,k) 3463 ENDDO 3464 ENDDO 3465 ENDIF 3466 3394 3467 3395 3468 #ifdef ISO … … 3894 3967 fder_print(i) = fder(i) + dflux_t(i) + dflux_q(i) 3895 3968 ENDDO 3969 3970 ! if blowing snow 3971 if (ok_bs) then 3972 DO nsrf = 1, nbsrf 3973 DO k = 1, klev 3974 DO i = 1, klon 3975 zxfluxqbs(i,k) = zxfluxqbs(i,k) + flux_qbs(i,k,nsrf) * pctsrf(i,nsrf) 3976 ENDDO 3977 ENDDO 3978 ENDDO 3979 3980 DO i = 1, klon 3981 zxsnowerosion(i) = zxfluxqbs(i,1) ! blowings snow flux at the surface 3982 END DO 3983 endif 3984 3985 3986 3896 3987 #ifdef ISO 3897 3988 DO i = 1, klon -
LMDZ6/trunk/libf/phylmdiso/phyredem.F90
r4491 r4523 15 15 ftsol, beta_aridity, delta_tsurf, falb_dir, & 16 16 falb_dif, qsol, fevap, radsol, solsw, sollw, & 17 sollwdown, rain_fall, snow_fall, z0m, z0h,&17 sollwdown, rain_fall, snow_fall, bs_fall, z0m, z0h, & 18 18 agesno, zmea, zstd, zsig, zgam, zthe, zpic, & 19 19 zval, rugoro, t_ancien, q_ancien, & 20 prw_ancien, prlw_ancien, prsw_ancien, 21 ql_ancien, qs_ancien, u_ancien,&20 prw_ancien, prlw_ancien, prsw_ancien, prbsw_ancien, & 21 ql_ancien, qs_ancien, qbs_ancien, u_ancien, & 22 22 v_ancien, clwcon, rnebcon, ratqs, pbl_tke, & 23 23 wake_delta_pbl_tke, zmax0, f0, sig1, w01, & … … 260 260 261 261 CALL put_field(pass,"QSANCIEN", "QSANCIEN", qs_ancien) 262 263 IF (ok_bs) THEN 264 CALL put_field(pass,"bs_f", "precipitation neige soufflee", bs_fall) 265 CALL put_field(pass,"QBSANCIEN", "QBSANCIEN", qbs_ancien) 266 CALL put_field(pass,"PRBSWANCIEN", "PRBSWANCIEN", prbsw_ancien) 267 ENDIF 262 268 263 269 CALL put_field(pass,"PRWANCIEN", "PRWANCIEN", prw_ancien) -
LMDZ6/trunk/libf/phylmdiso/phys_local_var_mod.F90
r4143 r4523 14 14 REAL, SAVE, ALLOCATABLE :: ql_seri(:,:),qs_seri(:,:) 15 15 !$OMP THREADPRIVATE(ql_seri,qs_seri) 16 REAL, SAVE, ALLOCATABLE :: qbs_seri(:,:) 17 !$OMP THREADPRIVATE(qbs_seri) 16 18 REAL, SAVE, ALLOCATABLE :: u_seri(:,:), v_seri(:,:) 17 19 !$OMP THREADPRIVATE(u_seri, v_seri) … … 26 28 REAL, SAVE, ALLOCATABLE :: d_t_dyn(:,:), d_q_dyn(:,:) 27 29 !$OMP THREADPRIVATE(d_t_dyn, d_q_dyn) 28 REAL, SAVE, ALLOCATABLE :: d_ql_dyn(:,:), d_qs_dyn(:,:) 29 !$OMP THREADPRIVATE(d_ql_dyn, d_qs_dyn )30 REAL, SAVE, ALLOCATABLE :: d_q_dyn2d(:), d_ql_dyn2d(:), d_qs_dyn2d(:) 31 !$OMP THREADPRIVATE(d_q_dyn2d, d_ql_dyn2d, d_qs_dyn2d )30 REAL, SAVE, ALLOCATABLE :: d_ql_dyn(:,:), d_qs_dyn(:,:), d_qbs_dyn(:,:) 31 !$OMP THREADPRIVATE(d_ql_dyn, d_qs_dyn, d_qbs_dyn) 32 REAL, SAVE, ALLOCATABLE :: d_q_dyn2d(:), d_ql_dyn2d(:), d_qs_dyn2d(:), d_qbs_dyn2d(:) 33 !$OMP THREADPRIVATE(d_q_dyn2d, d_ql_dyn2d, d_qs_dyn2d, d_qbs_dyn2d) 32 34 REAL, SAVE, ALLOCATABLE :: d_u_dyn(:,:), d_v_dyn(:,:) 33 35 !$OMP THREADPRIVATE(d_u_dyn, d_v_dyn) … … 69 71 REAL, SAVE, ALLOCATABLE :: d_u_oli(:,:), d_v_oli(:,:) 70 72 !$OMP THREADPRIVATE(d_u_oli, d_v_oli) 71 REAL, SAVE, ALLOCATABLE :: d_t_vdf(:,:), d_q_vdf(:,:), d_ t_diss(:,:)72 !$OMP THREADPRIVATE( d_t_vdf, d_q_vdf, d_t_diss)73 REAL, SAVE, ALLOCATABLE :: d_t_vdf(:,:), d_q_vdf(:,:), d_qbs_vdf(:,:), d_t_diss(:,:) 74 !$OMP THREADPRIVATE( d_t_vdf, d_q_vdf, d_qbs_vdf, d_t_diss) 73 75 REAL, SAVE, ALLOCATABLE :: d_u_vdf(:,:), d_v_vdf(:,:) 74 76 !$OMP THREADPRIVATE(d_u_vdf, d_v_vdf) … … 78 80 REAL, SAVE, ALLOCATABLE :: d_t_vdf_x(:,:), d_q_vdf_x(:,:) 79 81 !$OMP THREADPRIVATE( d_t_vdf_x, d_q_vdf_x) 82 REAL, SAVE, ALLOCATABLE :: d_t_bs(:,:), d_q_bs(:,:), d_qbs_bs(:,:) 83 !$OMP THREADPRIVATE( d_t_bs,d_q_bs, d_qbs_bs) 80 84 !>nrlmd+jyg 81 85 REAL, SAVE, ALLOCATABLE :: d_t_oro(:,:) … … 361 365 REAL,ALLOCATABLE,SAVE,DIMENSION(:) :: JrNt 362 366 !$OMP THREADPRIVATE(JrNt) 363 REAL,ALLOCATABLE,SAVE,DIMENSION(:) :: dthmin, evap, fder, plcl, plfc, prw, prlw, prsw364 !$OMP THREADPRIVATE(dthmin, evap, fder, plcl, plfc, prw, prlw, prsw)367 REAL,ALLOCATABLE,SAVE,DIMENSION(:) :: dthmin, evap, snowerosion, fder, plcl, plfc, prw, prlw, prsw, prbsw 368 !$OMP THREADPRIVATE(dthmin, evap, snowerosion, fder, plcl, plfc, prw, prlw, prsw, prbsw) 365 369 REAL,ALLOCATABLE,SAVE,DIMENSION(:) :: zustar, zu10m, zv10m, rh2m 366 370 !$OMP THREADPRIVATE(zustar, zu10m, zv10m, rh2m) … … 379 383 REAL,ALLOCATABLE,SAVE,DIMENSION(:) :: tpot, tpote, ue, uq, uwat, ve, vq, vwat, zxffonte 380 384 !$OMP THREADPRIVATE(tpot, tpote, ue, uq, uwat, ve, vq, vwat, zxffonte) 385 REAL,ALLOCATABLE,SAVE,DIMENSION(:) :: zxustartlic, zxrhoslic 386 !$OMP THREADPRIVATE(zxustartlic, zxrhoslic) 381 387 REAL,ALLOCATABLE,SAVE,DIMENSION(:) :: zxfqcalving 382 388 !$OMP THREADPRIVATE(zxfqcalving) … … 567 573 REAL,ALLOCATABLE,SAVE,DIMENSION(:,:) :: zx_rh, zx_rhl, zx_rhi 568 574 !$OMP THREADPRIVATE(zx_rh, zx_rhl, zx_rhi) 569 REAL,ALLOCATABLE,SAVE,DIMENSION(:,:) :: prfl, psfl, fraca 570 !$OMP THREADPRIVATE(prfl, psfl, fraca )575 REAL,ALLOCATABLE,SAVE,DIMENSION(:,:) :: prfl, psfl, fraca, bsfl 576 !$OMP THREADPRIVATE(prfl, psfl, fraca, bsfl) 571 577 REAL,ALLOCATABLE,SAVE,DIMENSION(:,:) :: Vprecip, zw2 572 578 !$OMP THREADPRIVATE(Vprecip, zw2) … … 734 740 735 741 IMPLICIT NONE 736 ALLOCATE(t_seri(klon,klev),q_seri(klon,klev),ql_seri(klon,klev),qs_seri(klon,klev) )742 ALLOCATE(t_seri(klon,klev),q_seri(klon,klev),ql_seri(klon,klev),qs_seri(klon,klev), qbs_seri(klon,klev)) 737 743 ALLOCATE(u_seri(klon,klev),v_seri(klon,klev)) 738 744 ALLOCATE(l_mixmin(klon,klev+1,nbsrf),l_mix(klon,klev+1,nbsrf),tke_dissip(klon,klev+1,nbsrf),wprime(klon,klev+1,nbsrf)) … … 741 747 ALLOCATE(tr_seri(klon,klev,nbtr)) 742 748 ALLOCATE(d_t_dyn(klon,klev),d_q_dyn(klon,klev)) 743 ALLOCATE(d_ql_dyn(klon,klev),d_qs_dyn(klon,klev) )744 ALLOCATE(d_q_dyn2d(klon),d_ql_dyn2d(klon),d_qs_dyn2d(klon) )749 ALLOCATE(d_ql_dyn(klon,klev),d_qs_dyn(klon,klev), d_qbs_dyn(klon,klev)) 750 ALLOCATE(d_q_dyn2d(klon),d_ql_dyn2d(klon),d_qs_dyn2d(klon), d_qbs_dyn2d(klon)) 745 751 ALLOCATE(d_u_dyn(klon,klev),d_v_dyn(klon,klev)) 746 752 ALLOCATE(d_tr_dyn(klon,klev,nbtr)) !RomP … … 765 771 ALLOCATE(plul_st(klon),plul_th(klon)) 766 772 ALLOCATE(d_t_vdf(klon,klev),d_q_vdf(klon,klev),d_t_diss(klon,klev)) 767 773 ALLOCATE (d_qbs_vdf(klon,klev)) 774 ALLOCATE(d_t_bs(klon,klev),d_q_bs(klon,klev),d_qbs_bs(klon,klev)) 768 775 ALLOCATE(d_t_vdf_w(klon,klev),d_q_vdf_w(klon,klev)) 769 776 ALLOCATE(d_t_vdf_x(klon,klev),d_q_vdf_x(klon,klev)) … … 925 932 ALLOCATE(cldm(klon), cldq(klon), cldt(klon), qsat2m(klon)) 926 933 ALLOCATE(JrNt(klon)) 927 ALLOCATE(dthmin(klon), evap(klon), fder(klon), plcl(klon), plfc(klon))928 ALLOCATE(prw(klon), prlw(klon), prsw(klon), zustar(klon), zu10m(klon), zv10m(klon), rh2m(klon))934 ALLOCATE(dthmin(klon), evap(klon), snowerosion(klon), fder(klon), plcl(klon), plfc(klon)) 935 ALLOCATE(prw(klon), prlw(klon), prsw(klon), prbsw(klon), zustar(klon), zu10m(klon), zv10m(klon), rh2m(klon)) 929 936 ALLOCATE(s_lcl(klon)) 930 937 ALLOCATE(s_pblh(klon), s_pblt(klon), s_therm(klon)) … … 1055 1062 ALLOCATE(prfl(klon, klev+1)) 1056 1063 ALLOCATE(psfl(klon, klev+1), fraca(klon, klev+1), Vprecip(klon, klev+1)) 1064 ALLOCATE(bsfl(klon,klev+1)) 1057 1065 ALLOCATE(zw2(klon, klev+1)) 1058 1066 … … 1141 1149 USE indice_sol_mod 1142 1150 IMPLICIT NONE 1143 DEALLOCATE(t_seri,q_seri,ql_seri,qs_seri )1151 DEALLOCATE(t_seri,q_seri,ql_seri,qs_seri, qbs_seri) 1144 1152 DEALLOCATE(u_seri,v_seri) 1145 1153 DEALLOCATE(l_mixmin,l_mix, tke_dissip,wprime) … … 1147 1155 DEALLOCATE(tr_seri) 1148 1156 DEALLOCATE(d_t_dyn,d_q_dyn) 1149 DEALLOCATE(d_ql_dyn,d_qs_dyn )1150 DEALLOCATE(d_q_dyn2d,d_ql_dyn2d,d_qs_dyn2d )1157 DEALLOCATE(d_ql_dyn,d_qs_dyn, d_qbs_dyn) 1158 DEALLOCATE(d_q_dyn2d,d_ql_dyn2d,d_qs_dyn2d, d_qbs_dyn2d) 1151 1159 DEALLOCATE(d_u_dyn,d_v_dyn) 1152 1160 DEALLOCATE(d_tr_dyn) !RomP … … 1171 1179 DEALLOCATE(plul_st,plul_th) 1172 1180 DEALLOCATE(d_t_vdf,d_q_vdf,d_t_diss) 1181 DEALLOCATE(d_qbs_vdf) 1182 DEALLOCATE(d_t_bs,d_q_bs,d_qbs_bs) 1173 1183 #ifdef ISO 1174 1184 deallocate(xt_seri,xtl_seri,xts_seri) … … 1308 1318 DEALLOCATE(cldm, cldq, cldt, qsat2m) 1309 1319 DEALLOCATE(JrNt) 1310 DEALLOCATE(dthmin, evap, fder, plcl, plfc)1311 DEALLOCATE(prw, prlw, prsw, zustar, zu10m, zv10m, rh2m, s_lcl)1320 DEALLOCATE(dthmin, evap, snowerosion, fder, plcl, plfc) 1321 DEALLOCATE(prw, prlw, prsw, prbsw, zustar, zu10m, zv10m, rh2m, s_lcl) 1312 1322 DEALLOCATE(s_pblh, s_pblt, s_therm) 1313 1323 ! … … 1322 1332 DEALLOCATE(zxfqcalving, zxfluxlat) 1323 1333 DEALLOCATE(zxrunofflic) 1334 DEALLOCATE(zxustartlic, zxrhoslic) 1324 1335 DEALLOCATE(zxtsol, snow_lsc, zxfqfonte, zxqsurf) 1325 1336 DEALLOCATE(rain_lsc) … … 1423 1434 1424 1435 1425 DEALLOCATE(prfl, psfl, fraca, Vprecip)1436 DEALLOCATE(prfl, psfl, bsfl, fraca, Vprecip) 1426 1437 DEALLOCATE(zw2) 1427 1438 -
LMDZ6/trunk/libf/phylmdiso/phys_output_ctrlout_mod.F90
r4065 r4523 378 378 TYPE(ctrl_out), SAVE :: o_snow = ctrl_out((/ 1, 1, 10, 10, 5, 10, 11, 11, 11, 11/), & 379 379 'snow', 'Snow fall', 'kg/(s*m2)', (/ ('', i=1, 10) /)) 380 TYPE(ctrl_out), SAVE :: o_bsfall = ctrl_out((/ 10, 10, 10, 10, 5, 10, 11, 11, 11, 11/), & 381 'bsfall', 'Blowing Snow fall', 'kg/(s*m2)', (/ ('', i=1, 10) /)) 380 382 TYPE(ctrl_out), SAVE :: o_evap = ctrl_out((/ 1, 1, 10, 10, 10, 10, 11, 11, 11, 11/), & 381 383 'evap', 'Evaporat', 'kg/(s*m2)', (/ ('', i=1, 10) /)) 382 384 TYPE(ctrl_out), SAVE :: o_snowerosion = ctrl_out((/ 10, 10, 10, 10, 10, 10, 11, 11, 11, 11/), & 385 'snowerosion', 'blowing snow flux', 'kg/(s*m2)', (/ ('', i=1, 10) /)) 386 TYPE(ctrl_out), SAVE :: o_ustart_lic = ctrl_out((/ 11, 11, 11, 11, 11, 11, 11, 11, 11, 11/), & 387 'ustart_lic', 'threshold velocity', 'm/s', (/ ('', i=1, 10) /)) 388 TYPE(ctrl_out), SAVE :: o_rhosnow_lic = ctrl_out((/ 11, 11, 11, 11, 11, 11, 11, 11, 11, 11/), & 389 'rhosnow_lic', 'snow density lic', 'kg/m3', (/ ('', i=1, 10) /)) 383 390 TYPE(ctrl_out), SAVE :: o_sens_prec_liq_oce = ctrl_out((/ 5, 5, 10, 10, 5, 10, 11, 11, 11, 11/), & 384 391 'sens_rain_oce', 'Sensible heat flux of liquid prec. over ocean', 'W/m2', (/ ('', i=1, 10) /)) … … 743 750 TYPE(ctrl_out), SAVE :: o_prsw = ctrl_out((/ 1, 1, 10, 10, 10, 10, 11, 11, 11, 11/), & 744 751 'prsw', 'Precipitable solid water', 'kg/m2', (/ ('', i=1, 10) /)) 752 TYPE(ctrl_out), SAVE :: o_prbsw = ctrl_out((/ 10, 10, 10, 10, 10, 10, 11, 11, 11, 11/), & 753 'prbsw', 'Precipitable blowing snow', 'kg/m2', (/ ('', i=1, 10) /)) 745 754 TYPE(ctrl_out), SAVE :: o_s_pblh = ctrl_out((/ 1, 10, 10, 10, 10, 10, 11, 11, 11, 11/), & 746 755 's_pblh', 'Boundary Layer Height', 'm', (/ ('', i=1, 10) /)) … … 1413 1422 'ec550aer', 'Extinction at 550nm', 'm^-1', (/ ('', i=1, 10) /)) 1414 1423 TYPE(ctrl_out), SAVE :: o_lwcon = ctrl_out((/ 2, 5, 10, 10, 10, 10, 11, 11, 11, 11/), & 1415 'lwcon', 'Cloud liquid water content ', 'kg/kg', (/ ('', i=1, 10) /))1424 'lwcon', 'Cloud liquid water content seen by radiation', 'kg/kg', (/ ('', i=1, 10) /)) 1416 1425 TYPE(ctrl_out), SAVE :: o_iwcon = ctrl_out((/ 2, 5, 10, 10, 10, 10, 11, 11, 11, 11/), & 1417 'iwcon', 'Cloud ice water content ', 'kg/kg', (/ ('', i=1, 10) /))1426 'iwcon', 'Cloud ice water content seen by radiation', 'kg/kg', (/ ('', i=1, 10) /)) 1418 1427 TYPE(ctrl_out), SAVE :: o_temp = ctrl_out((/ 2, 3, 4, 10, 10, 10, 11, 11, 11, 11/), & 1419 1428 'temp', 'Air temperature', 'K', (/ ('', i=1, 10) /)) … … 1432 1441 TYPE(ctrl_out), SAVE :: o_ocond = ctrl_out((/ 2, 3, 4, 10, 10, 10, 11, 11, 11, 11/), & 1433 1442 'ocond', 'Condensed water', 'kg/kg', (/ ('', i=1, 10) /)) 1443 TYPE(ctrl_out), SAVE :: o_qbs = ctrl_out((/ 10, 10, 10, 10, 10, 10, 11, 11, 11, 11/), & 1444 'qbs', 'Specific content of blowing snow', 'kg/kg', (/ ('', i=1, 10) /)) 1434 1445 TYPE(ctrl_out), SAVE :: o_wvapp = ctrl_out((/ 2, 10, 10, 10, 10, 10, 11, 11, 11, 11/), & 1435 1446 'wvapp', '', '', (/ ('', i=1, 10) /)) … … 1494 1505 TYPE(ctrl_out), SAVE :: o_dqsphy2d = ctrl_out((/ 2, 10, 10, 10, 10, 10, 11, 11, 11, 11/), & 1495 1506 'dqsphy2d', 'Physics dQS', '(kg/m2)/s', (/ ('', i=1, 10) /)) 1507 TYPE(ctrl_out), SAVE :: o_dqbsphy = ctrl_out((/ 10, 10, 10, 10, 10, 10, 11, 11, 11, 11/), & 1508 'dqbsphy', 'Physics dQBS', '(kg/kg)/s', (/ ('', i=1, 10) /)) 1509 TYPE(ctrl_out), SAVE :: o_dqbsphy2d = ctrl_out((/ 10, 10, 10, 10, 10, 10, 11, 11, 11, 11/), & 1510 'dqbsphy2d', 'Physics dQBS', '(kg/m2)/s', (/ ('', i=1, 10) /)) 1496 1511 TYPE(ctrl_out), SAVE :: o_pr_con_l = ctrl_out((/ 2, 10, 10, 10, 10, 10, 11, 11, 11, 11/), & 1497 1512 'pr_con_l', 'Convective precipitation lic', ' ', (/ ('', i=1, 10) /)) … … 1502 1517 TYPE(ctrl_out), SAVE :: o_pr_lsc_i = ctrl_out((/ 2, 10, 10, 10, 10, 10, 11, 11, 11, 11/), & 1503 1518 'pr_lsc_i', 'Large scale precipitation ice', ' ', (/ ('', i=1, 10) /)) 1519 TYPE(ctrl_out), SAVE :: o_pr_bs = ctrl_out((/ 10, 10, 10, 10, 10, 10, 11, 11, 11, 11/), & 1520 'pr_bs', 'profile of blowing snow flux', ' ', (/ ('', i=1, 10) /)) 1504 1521 TYPE(ctrl_out), SAVE :: o_re = ctrl_out((/ 5, 10, 10, 10, 10, 10, 11, 11, 11, 11/), & 1505 1522 're', 'Cloud droplet effective radius', 'um', (/ ('', i=1, 10) /)) … … 1599 1616 TYPE(ctrl_out), SAVE :: o_dqsdyn2d = ctrl_out((/ 4, 10, 10, 10, 10, 10, 11, 11, 11, 11/), & 1600 1617 'dqsdyn2d', 'Dynamics dQS', '(kg/m2)/s', (/ ('', i=1, 10) /)) 1618 TYPE(ctrl_out), SAVE :: o_dqbsdyn = ctrl_out((/ 10, 10, 10, 10, 10, 10, 11, 11, 11, 11/), & 1619 'dqbsdyn', 'Dynamics dQBS', '(kg/kg)/s', (/ ('', i=1, 10) /)) 1620 TYPE(ctrl_out), SAVE :: o_dqbsdyn2d = ctrl_out((/ 10, 10, 10, 10, 10, 10, 11, 11, 11, 11/), & 1621 'dqbsdyn2d', 'Dynamics dQBS', '(kg/m2)/s', (/ ('', i=1, 10) /)) 1601 1622 TYPE(ctrl_out), SAVE :: o_dudyn = ctrl_out((/ 4, 10, 10, 10, 10, 10, 11, 11, 11, 11/), & 1602 1623 'dudyn', 'Dynamics dU', 'm/s2', (/ ('', i=1, 10) /)) … … 1673 1694 TYPE(ctrl_out), SAVE :: o_dqeva2d = ctrl_out((/ 4, 10, 10, 10, 10, 10, 11, 11, 11, 11/), & 1674 1695 'dqeva2d', 'Reevaporation dQ', '(kg/m2)/s', (/ ('', i=1, 10) /)) 1696 TYPE(ctrl_out), SAVE :: o_dqbsvdf = ctrl_out((/ 10, 10, 10, 10, 10, 10, 11, 11, 11, 11/), & 1697 'dqbsvdf', 'Boundary-layer dQBS', '(kg/kg)/s', (/ ('', i=1, 10) /)) 1698 TYPE(ctrl_out), SAVE :: o_dqbsbs = ctrl_out((/ 10, 10, 10, 10, 10, 10, 11, 11, 11, 11/), & 1699 'dqbsbs', 'Blowing snow dQBS', '(kg/kg)/s', (/ ('', i=1, 10) /)) 1700 TYPE(ctrl_out), SAVE :: o_dtbs = ctrl_out((/ 10, 10, 10, 10, 10, 10, 11, 11, 11, 11/), & 1701 'dtbs', 'Blowing snow dT', '(K)/s', (/ ('', i=1, 10) /)) 1702 TYPE(ctrl_out), SAVE :: o_dqbs = ctrl_out((/ 10, 10, 10, 10, 10, 10, 11, 11, 11, 11/), & 1703 'dqbs', 'Blowing snow dQ', '(kg/kg)/s', (/ ('', i=1, 10) /)) 1675 1704 1676 1705 !!!!!!!!!!!!!!!! Specifique thermiques -
LMDZ6/trunk/libf/phylmdiso/phys_output_var_mod.F90
r4374 r4523 29 29 REAL, SAVE, ALLOCATABLE :: d_qw_col(:) ! watter vapour mass budget for each column (kg/m2/s) 30 30 REAL, SAVE, ALLOCATABLE :: d_ql_col(:) ! liquid watter mass budget for each column (kg/m2/s) 31 REAL, SAVE, ALLOCATABLE :: d_qs_col(:) ! solid watter mass budget for each column (kg/m2/s) 31 REAL, SAVE, ALLOCATABLE :: d_qs_col(:) ! cloud ice mass budget for each column (kg/m2/s) 32 REAL, SAVE, ALLOCATABLE :: d_qbs_col(:) ! blowing snow mass budget for each column (kg/m2/s) 32 33 REAL, SAVE, ALLOCATABLE :: d_qt_col(:) ! total watter mass budget for each column (kg/m2/s) 33 34 REAL, SAVE, ALLOCATABLE :: d_ek_col(:) ! kinetic energy budget for each column (W/m2) … … 35 36 REAL, SAVE, ALLOCATABLE :: d_h_qw_col(:) ! enthalpy budget of watter vapour for each column (W/m2) 36 37 REAL, SAVE, ALLOCATABLE :: d_h_ql_col(:) ! enthalpy budget of liquid watter for each column (W/m2) 37 REAL, SAVE, ALLOCATABLE :: d_h_qs_col(:) ! enthalpy budget of solid watter for each column (W/m2) 38 REAL, SAVE, ALLOCATABLE :: d_h_qs_col(:) ! enthalpy budget of cloud ice for each column (W/m2) 39 REAL, SAVE, ALLOCATABLE :: d_h_qbs_col(:) ! enthalpy budget of blowing snow for each column (W/m2) 38 40 REAL, SAVE, ALLOCATABLE :: d_h_col(:) ! total enthalpy budget for each column (W/m2) 39 !$OMP THREADPRIVATE(d_qw_col, d_ql_col, d_qs_col, d_q t_col, d_ek_col, d_h_dair_col)40 !$OMP THREADPRIVATE(d_h_qw_col, d_h_ql_col, d_h_qs_col, d_h_ col)41 !$OMP THREADPRIVATE(d_qw_col, d_ql_col, d_qs_col, d_qbs_col, d_qt_col, d_ek_col, d_h_dair_col) 42 !$OMP THREADPRIVATE(d_h_qw_col, d_h_ql_col, d_h_qs_col, d_h_qbs_col, d_h_col) 41 43 42 44 ! Outputs used in cloudth_vert to extract the moments of the horizontal and … … 173 175 174 176 allocate (bils_ec(klon),bils_ech(klon),bils_tke(klon),bils_diss(klon),bils_kinetic(klon),bils_enthalp(klon),bils_latent(klon)) 175 allocate (d_qw_col(klon), d_ql_col(klon), d_qs_col(klon), d_q t_col(klon), d_ek_col(klon), d_h_dair_col(klon) &176 & , d_h_qw_col(klon), d_h_ql_col(klon), d_h_qs_col(klon), d_h_ col(klon))177 d_qw_col=0. ; d_ql_col=0. ; d_qs_col=0. ; d_q t_col=0. ; d_ek_col=0. ; d_h_dair_col =0.178 d_h_qw_col=0. ; d_h_ql_col=0. ; d_h_qs_col=0. ; d_h_ col=0.177 allocate (d_qw_col(klon), d_ql_col(klon), d_qs_col(klon), d_qbs_col(klon), d_qt_col(klon), d_ek_col(klon), d_h_dair_col(klon) & 178 & , d_h_qw_col(klon), d_h_ql_col(klon), d_h_qs_col(klon), d_h_qbs_col(klon), d_h_col(klon)) 179 d_qw_col=0. ; d_ql_col=0. ; d_qs_col=0. ; d_qbs_col=0. ; d_qt_col=0. ; d_ek_col=0. ; d_h_dair_col =0. 180 d_h_qw_col=0. ; d_h_ql_col=0. ; d_h_qs_col=0. ; d_h_qbs_col=0. ; d_h_col=0. 179 181 180 182 ! Outputs used in cloudth_vert … … 223 225 deallocate(sza_o) 224 226 deallocate (bils_ec,bils_ech,bils_tke,bils_diss,bils_kinetic,bils_enthalp,bils_latent) 225 deallocate (d_qw_col, d_ql_col, d_qs_col, d_q t_col, d_ek_col, d_h_dair_col &226 & , d_h_qw_col, d_h_ql_col, d_h_qs_col, d_h_ col)227 deallocate (d_qw_col, d_ql_col, d_qs_col, d_qbs_col, d_qt_col, d_ek_col, d_h_dair_col & 228 & , d_h_qw_col, d_h_ql_col, d_h_qs_col, d_h_qbs_col, d_h_col) 227 229 228 230 ! Outputs used in cloudth_vert -
LMDZ6/trunk/libf/phylmdiso/physiq_mod.F90
r4522 r4523 79 79 USE wxios, ONLY: g_ctx, wxios_set_context 80 80 #endif 81 USE atke_turbulence_ini_mod, ONLY : atke_ini82 USE lscp_ini_mod, ONLY : lscp_ini83 81 USE lscp_mod, ONLY : lscp 84 82 USE wake_ini_mod, ONLY : wake_ini 85 83 USE yamada_ini_mod, ONLY : yamada_ini 84 USE atke_turbulence_ini_mod, ONLY : atke_ini 86 85 USE thermcell_ini_mod, ONLY : thermcell_ini 86 USE blowing_snow_ini_mod, ONLY : blowing_snow_ini , qbst_bs 87 USE lscp_ini_mod, ONLY : lscp_ini 87 88 88 89 !USE cmp_seri_mod … … 183 184 ! [Variables internes non sauvegardees de la physique] 184 185 ! Variables locales pour effectuer les appels en serie 185 t_seri,q_seri,ql_seri,qs_seri, u_seri,v_seri,tr_seri,rneb_seri, &186 t_seri,q_seri,ql_seri,qs_seri,qbs_seri,u_seri,v_seri,tr_seri,rneb_seri, & 186 187 ! Dynamic tendencies (diagnostics) 187 d_t_dyn,d_q_dyn,d_ql_dyn,d_qs_dyn,d_ u_dyn,d_v_dyn,d_tr_dyn,d_rneb_dyn, &188 d_q_dyn2d,d_ql_dyn2d,d_qs_dyn2d, &188 d_t_dyn,d_q_dyn,d_ql_dyn,d_qs_dyn,d_qbs_dyn,d_u_dyn,d_v_dyn,d_tr_dyn,d_rneb_dyn, & 189 d_q_dyn2d,d_ql_dyn2d,d_qs_dyn2d,d_qbs_dyn2d, & 189 190 ! Physic tendencies 190 191 d_t_con,d_q_con,d_u_con,d_v_con, & … … 203 204 plul_st,plul_th, & 204 205 ! 205 d_t_vdf,d_q_vdf, d_u_vdf,d_v_vdf,d_t_diss, &206 d_t_vdf,d_q_vdf, d_qbs_vdf, d_u_vdf,d_v_vdf,d_t_diss, & 206 207 d_t_vdf_x, d_t_vdf_w, & 207 208 d_q_vdf_x, d_q_vdf_w, & 208 209 d_ts, & 210 ! 211 d_t_bs,d_q_bs,d_qbs_bs, & 209 212 ! 210 213 ! d_t_oli,d_u_oli,d_v_oli, & … … 254 257 cldh, cldl,cldm, cldq, cldt, & 255 258 JrNt, & 256 dthmin, evap, fder, plcl, plfc, &257 prw, prlw, prsw, &259 dthmin, evap, snowerosion,fder, plcl, plfc, & 260 prw, prlw, prsw, prbsw, & 258 261 s_lcl, s_pblh, s_pblt, s_therm, & 259 262 cdragm, cdragh, & … … 343 346 fsolsw, wfbils, wfbilo, & 344 347 wfevap, wfrain, wfsnow, & 345 prfl, psfl, fraca, Vprecip, &348 prfl, psfl,bsfl, fraca, Vprecip, & 346 349 zw2, & 347 350 ! … … 526 529 !====================================================================== 527 530 ! 528 ! indices de traceurs eau vapeur, liquide, glace, fraction nuageuse LS (optional) 529 INTEGER,SAVE :: ivap, iliq, isol, irneb 530 !$OMP THREADPRIVATE(ivap, iliq, isol, irneb )531 ! indices de traceurs eau vapeur, liquide, glace, fraction nuageuse LS (optional), blowing snow (optional) 532 INTEGER,SAVE :: ivap, iliq, isol, irneb, ibs 533 !$OMP THREADPRIVATE(ivap, iliq, isol, irneb, ibs) 531 534 ! 532 535 ! … … 905 908 REAL dialiq(klon,klev) ! eau liquide nuageuse 906 909 REAL diafra(klon,klev) ! fraction nuageuse 907 REAL cldliq(klon,klev) ! eau liquide nuageuse910 REAL radocond(klon,klev) ! eau condensee nuageuse 908 911 ! 909 912 !XXX PB 910 913 REAL fluxq(klon,klev, nbsrf) ! flux turbulent d'humidite 914 REAL fluxqbs(klon,klev, nbsrf) ! flux turbulent de neige soufflee 911 915 ! 912 916 REAL zxfluxt(klon, klev) 913 917 REAL zxfluxq(klon, klev) 918 REAL zxfluxqbs(klon,klev) 914 919 REAL zxfluxu(klon, klev) 915 920 REAL zxfluxv(klon, klev) … … 1009 1014 ! 1010 1015 ! tendance nulles 1011 REAL, dimension(klon,klev):: du0, dv0, dt0, dq0, dql0, dqi0 1016 REAL, dimension(klon,klev):: du0, dv0, dt0, dq0, dql0, dqi0, dqbs0 1012 1017 #ifdef ISO 1013 1018 REAL, dimension(ntraciso,klon,klev):: dxt0, dxtl0, dxti0 … … 1156 1161 REAL ztsol(klon) 1157 1162 REAL q2m(klon,nbsrf) ! humidite a 2m 1163 REAL fsnowerosion(klon,nbsrf) ! blowing snow flux at surface 1164 REAL qbsfra ! blowing snow fraction 1158 1165 #ifdef ISO 1159 1166 REAL d_xtw(ntraciso),d_xtl(ntraciso), d_xts(ntraciso) … … 1372 1379 isol = strIdx(tracers(:)%name, addPhase('H2O', 's')) 1373 1380 irneb= strIdx(tracers(:)%name, addPhase('H2O', 'r')) 1381 ibs = strIdx(tracers(:)%name, addPhase('H2O', 'b')) 1374 1382 CALL init_etat0_limit_unstruct 1375 1383 IF (.NOT. create_etat0_limit) CALL init_limit_read(days_elapsed) … … 1421 1429 ENDIF 1422 1430 1423 IF (ok_ice_sursat.AND.(nqo. NE.4)) THEN1431 IF (ok_ice_sursat.AND.(nqo.LT.4)) THEN 1424 1432 WRITE (lunout, *) ' ok_ice_sursat=y requires 4 H2O tracers ', & 1425 1433 '(H2O_g, H2O_l, H2O_s, H2O_r) but nqo=', nqo, '. Might as well stop here.' … … 1440 1448 ENDIF 1441 1449 1450 IF (ok_bs) THEN 1451 abort_message='blowing snow cannot be activated with water isotopes yet' 1452 CALL abort_physic(modname,abort_message, 1) 1453 IF ((ok_ice_sursat.AND.nqo .LT.5).OR.(.NOT.ok_ice_sursat.AND.nqo.LT.4)) THEN 1454 WRITE (lunout, *) 'activation of blowing snow needs a specific H2O tracer', & 1455 'but nqo=', nqo 1456 abort_message='see above' 1457 CALL abort_physic(modname,abort_message, 1) 1458 ENDIF 1459 ENDIF 1442 1460 Ncvpaseq1 = 0 1443 1461 dnwd0=0.0 … … 1893 1911 CALL lscp_ini(pdtphys,ok_ice_sursat) 1894 1912 endif 1913 CALL blowing_snow_ini(prt_level,lunout, & 1914 RCPD, RLSTT, RLVTT, RLMLT, & 1915 RVTMP2, RTT,RD,RG) 1895 1916 1896 1917 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! … … 1919 1940 CALL phys_output_write(itap, pdtphys, paprs, pphis, & 1920 1941 pplay, lmax_th, aerosol_couple, & 1921 ok_ade, ok_aie, ok_volcan, ivap, iliq, isol, ok_sync,&1942 ok_ade, ok_aie, ok_volcan, ivap, iliq, isol, ibs, ok_sync,& 1922 1943 ptconv, read_climoz, clevSTD, & 1923 1944 ptconvth, d_u, d_t, qx, d_qx, zmasse, & … … 2406 2427 dql0(:,:)=0. 2407 2428 dqi0(:,:)=0. 2429 dqbs0(:,:)=0. 2408 2430 #ifdef ISO 2409 2431 dxt0(:,:,:)=0. … … 2463 2485 q_seri(i,k) = qx(i,k,ivap) 2464 2486 ql_seri(i,k) = qx(i,k,iliq) 2487 qbs_seri(i,k) = 0. 2465 2488 !CR: ATTENTION, on rajoute la variable glace 2466 2489 IF (nqo.EQ.2) THEN !--vapour and liquid only … … 2470 2493 qs_seri(i,k) = qx(i,k,isol) 2471 2494 rneb_seri(i,k) = 0. 2472 ELSE IF (nqo. EQ.4) THEN !--vapour, liquid, ice and rneb2495 ELSE IF (nqo.GE.4) THEN !--vapour, liquid, ice and rneb and blowing snow 2473 2496 qs_seri(i,k) = qx(i,k,isol) 2497 IF (ok_ice_sursat) THEN 2474 2498 rneb_seri(i,k) = qx(i,k,irneb) 2499 ENDIF 2500 IF (ok_bs) THEN 2501 qbs_seri(i,k)= qx(i,k,ibs) 2502 ENDIF 2503 2475 2504 ENDIF 2505 2506 2476 2507 ENDDO 2477 2508 ENDDO … … 2515 2546 qql1(:)=0.0 2516 2547 DO k = 1, klev 2517 qql1(:)=qql1(:)+(q_seri(:,k)+ql_seri(:,k)+qs_seri(:,k) )*zmasse(:,k)2548 qql1(:)=qql1(:)+(q_seri(:,k)+ql_seri(:,k)+qs_seri(:,k)+qbs_seri(:,k))*zmasse(:,k) 2518 2549 ENDDO 2519 2550 #ifdef ISO … … 2631 2662 d_ql_dyn(:,:) = (ql_seri(:,:)-ql_ancien(:,:))/phys_tstep 2632 2663 d_qs_dyn(:,:) = (qs_seri(:,:)-qs_ancien(:,:))/phys_tstep 2664 d_qbs_dyn(:,:) = (qbs_seri(:,:)-qbs_ancien(:,:))/phys_tstep 2633 2665 CALL water_int(klon,klev,q_seri,zmasse,zx_tmp_fi2d) 2634 2666 d_q_dyn2d(:)=(zx_tmp_fi2d(:)-prw_ancien(:))/phys_tstep … … 2637 2669 CALL water_int(klon,klev,qs_seri,zmasse,zx_tmp_fi2d) 2638 2670 d_qs_dyn2d(:)=(zx_tmp_fi2d(:)-prsw_ancien(:))/phys_tstep 2671 CALL water_int(klon,klev,qbs_seri,zmasse,zx_tmp_fi2d) 2672 d_qbs_dyn2d(:)=(zx_tmp_fi2d(:)-prbsw_ancien(:))/phys_tstep 2639 2673 ! !! RomP >>> td dyn traceur 2640 2674 IF (nqtot > nqo) d_tr_dyn(:,:,:)=(tr_seri(:,:,:)-tr_ancien(:,:,:))/phys_tstep … … 2723 2757 d_ql_dyn2d(:) = 0.0 2724 2758 d_qs_dyn2d(:) = 0.0 2759 d_qbs_dyn2d(:)= 0.0 2725 2760 2726 2761 #ifdef ISO … … 2746 2781 ! !! RomP <<< 2747 2782 d_rneb_dyn(:,:)=0.0 2783 d_qbs_dyn(:,:)=0.0 2748 2784 ancien_ok = .TRUE. 2749 2785 ENDIF … … 2878 2914 2879 2915 CALL add_phys_tend & 2880 (du0,dv0,d_t_eva,d_q_eva,d_ql_eva,d_qi_eva, paprs,&2916 (du0,dv0,d_t_eva,d_q_eva,d_ql_eva,d_qi_eva,dqbs0,paprs,& 2881 2917 'eva',abortphy,flag_inhib_tend,itap,0 & 2882 2918 #ifdef ISO … … 3047 3083 longitude_deg, latitude_deg, rugoro, zrmu0, & 3048 3084 sollwdown, cldt, & 3049 rain_fall, snow_fall, solsw, solswfdiff, sollw, &3085 rain_fall, snow_fall, bs_fall, solsw, solswfdiff, sollw, & 3050 3086 gustiness, & 3051 t_seri, q_seri, u_seri, v_seri, &3087 t_seri, q_seri, qbs_seri, u_seri, v_seri, & 3052 3088 !nrlmd+jyg< 3053 3089 wake_deltat, wake_deltaq, wake_cstar, wake_s, & … … 3060 3096 !albedo SB >>> 3061 3097 ! albsol1, albsol2, sens, evap, & 3062 albsol_dir, albsol_dif, sens, evap, 3098 albsol_dir, albsol_dif, sens, evap, snowerosion, & 3063 3099 !albedo SB <<< 3064 3100 albsol3_lic,runoff, snowhgt, qsnow, to_ice, sissnow, & 3065 3101 zxtsol, zxfluxlat, zt2m, qsat2m, zn2mout, & 3066 d_t_vdf, d_q_vdf, d_u_vdf, d_v_vdf, d_t_diss, &3102 d_t_vdf, d_q_vdf, d_qbs_vdf, d_u_vdf, d_v_vdf, d_t_diss, & 3067 3103 !nrlmd< 3068 3104 !jyg< … … 3090 3126 fluxt, fluxu, fluxv, & 3091 3127 dsens, devap, zxsnow, & 3092 zxfluxt, zxfluxq, q2m, fluxq, pbl_tke, &3128 zxfluxt, zxfluxq, zxfluxqbs, q2m, fluxq, fluxqbs, pbl_tke, & 3093 3129 !nrlmd+jyg< 3094 3130 wake_delta_pbl_TKE, & … … 3202 3238 IF (klon_glo==1) THEN 3203 3239 CALL add_pbl_tend & 3204 (d_u_vdf,d_v_vdf,d_t_vdf+d_t_diss,d_q_vdf,dql0,dqi0, paprs,&3240 (d_u_vdf,d_v_vdf,d_t_vdf+d_t_diss,d_q_vdf,dql0,dqi0,d_qbs_vdf,paprs,& 3205 3241 'vdf',abortphy,flag_inhib_tend,itap & 3206 3242 #ifdef ISO … … 3210 3246 ELSE 3211 3247 CALL add_phys_tend & 3212 (d_u_vdf,d_v_vdf,d_t_vdf+d_t_diss,d_q_vdf,dql0,dqi0, paprs,&3248 (d_u_vdf,d_v_vdf,d_t_vdf+d_t_diss,d_q_vdf,dql0,dqi0,d_qbs_vdf,paprs,& 3213 3249 'vdf',abortphy,flag_inhib_tend,itap,0 & 3214 3250 #ifdef ISO … … 3272 3308 3273 3309 ENDIF 3310 3311 ! ================================================================== 3312 ! Blowing snow sublimation and sedimentation 3313 3314 d_t_bs(:,:)=0. 3315 d_q_bs(:,:)=0. 3316 d_qbs_bs(:,:)=0. 3317 bsfl(:,:)=0. 3318 bs_fall(:)=0. 3319 IF (ok_bs) THEN 3320 3321 CALL call_blowing_snow_sublim_sedim(klon,klev,phys_tstep,t_seri,q_seri,qbs_seri,pplay,paprs, & 3322 d_t_bs,d_q_bs,d_qbs_bs,bsfl,bs_fall) 3323 3324 CALL add_phys_tend & 3325 (du0,dv0,d_t_bs,d_q_bs,dql0,dqi0,d_qbs_bs,paprs,& 3326 'bs',abortphy,flag_inhib_tend,itap,0 & 3327 #ifdef ISO 3328 & ,dxt0,dxtl0,dxti0 & 3329 #endif 3330 & ) 3331 3332 ENDIF 3333 3274 3334 ! =================================================================== c 3275 3335 ! Calcul de Qsat … … 3959 4019 !! 3960 4020 !! 3961 CALL add_phys_tend(d_u_con, d_v_con, d_t_con, d_q_con, dql0, dqi0, paprs, &4021 CALL add_phys_tend(d_u_con, d_v_con, d_t_con, d_q_con, dql0, dqi0, dqbs0, paprs, & 3962 4022 'convection',abortphy,flag_inhib_tend,itap,0 & 3963 4023 #ifdef ISO … … 4191 4251 !----------------------------------------------------------------------- 4192 4252 ! ajout des tendances des poches froides 4193 CALL add_phys_tend(du0,dv0,d_t_wake,d_q_wake,dql0,dqi0, paprs,'wake', &4253 CALL add_phys_tend(du0,dv0,d_t_wake,d_q_wake,dql0,dqi0,dqbs0,paprs,'wake', & 4194 4254 abortphy,flag_inhib_tend,itap,0 & 4195 4255 #ifdef ISO … … 4470 4530 ! 4471 4531 CALL add_phys_tend(d_u_ajs,d_v_ajs,d_t_ajs,d_q_ajs, & 4472 dql0,dqi0, paprs,'thermals', abortphy,flag_inhib_tend,itap,0 &4532 dql0,dqi0,dqbs0,paprs,'thermals', abortphy,flag_inhib_tend,itap,0 & 4473 4533 #ifdef ISO 4474 4534 & ,d_xt_ajs,dxtl0,dxti0 & … … 4586 4646 !-------------------------------------------------------------------- 4587 4647 ! ajout des tendances de l'ajustement sec ou des thermiques 4588 CALL add_phys_tend(du0,dv0,d_t_ajsb,d_q_ajsb,dql0,dqi0, paprs, &4648 CALL add_phys_tend(du0,dv0,d_t_ajsb,d_q_ajsb,dql0,dqi0,dqbs0,paprs, & 4589 4649 'ajsb',abortphy,flag_inhib_tend,itap,0 & 4590 4650 #ifdef ISO … … 4730 4790 CALL lscp(klon,klev,phys_tstep,missing_val,paprs,pplay, & 4731 4791 t_seri, q_seri,ptconv,ratqs, & 4732 d_t_lsc, d_q_lsc, d_ql_lsc, d_qi_lsc, rneb, rneblsvol, rneb_seri, & 4733 cldliq, picefra, rain_lsc, snow_lsc, &4792 d_t_lsc, d_q_lsc, d_ql_lsc, d_qi_lsc, rneb, rneblsvol, rneb_seri, & 4793 radocond, picefra, rain_lsc, snow_lsc, & 4734 4794 frac_impa, frac_nucl, beta_prec_fisrt, & 4735 4795 prfl, psfl, rhcl, & … … 4743 4803 CALL fisrtilp(phys_tstep,paprs,pplay, & 4744 4804 t_seri, q_seri,ptconv,ratqs, & 4745 d_t_lsc, d_q_lsc, d_ql_lsc, d_qi_lsc, rneb, cldliq, &4805 d_t_lsc, d_q_lsc, d_ql_lsc, d_qi_lsc, rneb, radocond, & 4746 4806 rain_lsc, snow_lsc, & 4747 4807 pfrac_impa, pfrac_nucl, pfrac_1nucl, & … … 4791 4851 ! write(*,9000) "rcpv","rcw",rcpv,rcw,rcs,t_seri(1,1) 4792 4852 !-JLD 4793 CALL add_phys_tend(du0,dv0,d_t_lsc,d_q_lsc,d_ql_lsc,d_qi_lsc, paprs, &4853 CALL add_phys_tend(du0,dv0,d_t_lsc,d_q_lsc,d_ql_lsc,d_qi_lsc,dqbs0,paprs, & 4794 4854 'lsc',abortphy,flag_inhib_tend,itap,0 & 4795 4855 #ifdef ISO … … 4828 4888 ENDIF 4829 4889 4830 !--------------------------------------------------------------------------- 4890 4891 !--------------------------------------------------------------------------- 4831 4892 DO k = 1, klev 4832 4893 DO i = 1, klon 4833 4894 cldfra(i,k) = rneb(i,k) 4834 4895 !CR: a quoi ca sert? Faut-il ajouter qs_seri? 4835 IF (.NOT.new_oliq) cldliq(i,k) = ql_seri(i,k) 4896 !EV: en effet etrange, j'ajouterais aussi qs_seri 4897 ! plus largement, je nettoierais (enleverrais) ces lignes 4898 IF (.NOT.new_oliq) radocond(i,k) = ql_seri(i,k) 4836 4899 ENDDO 4837 4900 ENDDO 4838 4901 4839 4902 4840 4903 ! Option to activate the radiative effect of blowing snow (ok_rad_bs) 4904 ! makes sense only if the new large scale condensation scheme is active 4905 ! with the ok_icefra_lscp flag active as well 4906 4907 IF (ok_bs .AND. ok_rad_bs) THEN 4908 IF (ok_new_lscp .AND. ok_icefra_lscp) THEN 4909 DO k=1,klev 4910 DO i=1,klon 4911 radocond(i,k)=radocond(i,k)+qbs_seri(i,k) 4912 picefra(i,k)=(radocond(i,k)*picefra(i,k)+qbs_seri(i,k))/(radocond(i,k)) 4913 qbsfra=min(qbs_seri(i,k)/qbst_bs,1.0) 4914 cldfra(i,k)=max(cldfra(i,k),qbsfra) 4915 ENDDO 4916 ENDDO 4917 ELSE 4918 WRITE(lunout,*)"PAY ATTENTION, you try to activate the radiative effect of blowing snow" 4919 WRITE(lunout,*)"with ok_new_lscp=false and/or ok_icefra_lscp=false" 4920 abort_message='inconsistency in cloud phase for blowing snow' 4921 CALL abort_physic(modname,abort_message,1) 4922 ENDIF 4923 4924 ENDIF 4841 4925 #ifdef ISO 4842 4926 !#ifdef ISOVERIF … … 5001 5085 DO i = 1, klon 5002 5086 IF (diafra(i,k).GT.cldfra(i,k)) THEN 5003 cldliq(i,k) = dialiq(i,k)5087 radocond(i,k) = dialiq(i,k) 5004 5088 cldfra(i,k) = diafra(i,k) 5005 5089 ENDIF … … 5038 5122 DO i=1,klon 5039 5123 IF (ptconv(i,k).AND.ptconvth(i,k)) THEN 5040 cldliq(i,k)=cldliq(i,k)+rnebcon(i,k)*clwcon(i,k)5124 radocond(i,k)=radocond(i,k)+rnebcon(i,k)*clwcon(i,k) 5041 5125 cldfra(i,k)=min(cldfra(i,k)+rnebcon(i,k),1.) 5042 5126 ELSE IF (ptconv(i,k)) THEN 5043 5127 cldfra(i,k)=rnebcon(i,k) 5044 cldliq(i,k)=rnebcon(i,k)*clwcon(i,k)5128 radocond(i,k)=rnebcon(i,k)*clwcon(i,k) 5045 5129 ENDIF 5046 5130 ENDDO … … 5051 5135 DO i=1,klon 5052 5136 cldfra(i,k)=min(cldfra(i,k)+rnebcon(i,k),1.) 5053 cldliq(i,k)=cldliq(i,k)+rnebcon(i,k)*clwcon(i,k)5137 radocond(i,k)=radocond(i,k)+rnebcon(i,k)*clwcon(i,k) 5054 5138 ENDDO 5055 5139 ENDDO … … 5069 5153 IF (ptconv(i,k).AND. .NOT.ptconvth(i,k)) THEN 5070 5154 cldfra(i,k)=rnebcon(i,k) 5071 cldliq(i,k)=rnebcon(i,k)*clwcon(i,k)5155 radocond(i,k)=rnebcon(i,k)*clwcon(i,k) 5072 5156 ENDIF 5073 5157 ENDDO … … 5080 5164 ! Ancienne version 5081 5165 cldfra(:,:)=min(max(cldfra(:,:),rnebcon(:,:)),1.) 5082 cldliq(:,:)=cldliq(:,:)+rnebcon(:,:)*clwcon(:,:)5166 radocond(:,:)=radocond(:,:)+rnebcon(:,:)*clwcon(:,:) 5083 5167 ENDIF 5084 5168 … … 5100 5184 DO i = 1, klon 5101 5185 IF (diafra(i,k).GT.cldfra(i,k)) THEN 5102 cldliq(i,k) = dialiq(i,k)5186 radocond(i,k) = dialiq(i,k) 5103 5187 cldfra(i,k) = diafra(i,k) 5104 5188 ENDIF … … 5475 5559 ENDIF 5476 5560 CALL newmicro (flag_aerosol, ok_cdnc, bl95_b0, bl95_b1, & 5477 paprs, pplay, t_seri, cldliq, picefra, cldfra, &5561 paprs, pplay, t_seri, radocond, picefra, cldfra, & 5478 5562 cldtau, cldemi, cldh, cldl, cldm, cldt, cldq, & 5479 5563 flwp, fiwp, flwc, fiwc, & … … 5483 5567 ELSE 5484 5568 CALL nuage (paprs, pplay, & 5485 t_seri, cldliq, picefra, cldfra, cldtau, cldemi, &5569 t_seri, radocond, picefra, cldfra, cldtau, cldemi, & 5486 5570 cldh, cldl, cldm, cldt, cldq, & 5487 5571 ok_aie, & … … 5792 5876 ENDDO 5793 5877 5794 CALL add_phys_tend(du0,dv0,d_t_swr,dq0,dql0,dqi0, paprs,'SW',abortphy,flag_inhib_tend,itap,0 &5878 CALL add_phys_tend(du0,dv0,d_t_swr,dq0,dql0,dqi0,dqbs0,paprs,'SW',abortphy,flag_inhib_tend,itap,0 & 5795 5879 #ifdef ISO 5796 5880 & ,dxt0,dxtl0,dxti0 & … … 5798 5882 & ) 5799 5883 CALL prt_enerbil('SW',itap) 5800 CALL add_phys_tend(du0,dv0,d_t_lwr,dq0,dql0,dqi0, paprs,'LW',abortphy,flag_inhib_tend,itap,0 &5884 CALL add_phys_tend(du0,dv0,d_t_lwr,dq0,dql0,dqi0,dqbs0,paprs,'LW',abortphy,flag_inhib_tend,itap,0 & 5801 5885 #ifdef ISO 5802 5886 & ,dxt0,dxtl0,dxti0 & … … 5846 5930 ! -> condition on zrel_oro can deactivate the drag on tilted planar terrains 5847 5931 ! such as ice sheets (work by V. Wiener) 5848 ! zpmm_orodr_t and zstd_orodr_t are activation thresholds set by F. Lott to 5932 ! zpmm_orodr_t and zstd_orodr_t are activation thresholds set by F. Lott to 5849 5933 ! earn computation time but they are not physical. 5850 5934 IF (((zpic(i)-zmea(i)).GT.zpmm_orodr_t).AND.(zstd(i).GT.zstd_orodr_t).AND.(zrel_oro(i).LE.zrel_oro_t)) THEN … … 5877 5961 !----------------------------------------------------------------------- 5878 5962 ! ajout des tendances de la trainee de l'orographie 5879 CALL add_phys_tend(d_u_oro,d_v_oro,d_t_oro,dq0,dql0,dqi0, paprs,'oro', &5963 CALL add_phys_tend(d_u_oro,d_v_oro,d_t_oro,dq0,dql0,dqi0,dqbs0,paprs,'oro', & 5880 5964 abortphy,flag_inhib_tend,itap,0 & 5881 5965 #ifdef ISO … … 5932 6016 5933 6017 ! ajout des tendances de la portance de l'orographie 5934 CALL add_phys_tend(d_u_lif, d_v_lif, d_t_lif, dq0, dql0, dqi0, paprs, &6018 CALL add_phys_tend(d_u_lif, d_v_lif, d_t_lif, dq0, dql0, dqi0, dqbs0,paprs, & 5935 6019 'lif', abortphy,flag_inhib_tend,itap,0 & 5936 6020 #ifdef ISO … … 5961 6045 d_t_hin(:, :)=0. 5962 6046 CALL add_phys_tend(du_gwd_hines, dv_gwd_hines, d_t_hin, dq0, dql0, & 5963 dqi0, paprs, 'hin', abortphy,flag_inhib_tend,itap,0 &6047 dqi0, dqbs0,paprs, 'hin', abortphy,flag_inhib_tend,itap,0 & 5964 6048 #ifdef ISO 5965 6049 & ,dxt0,dxtl0,dxti0 & … … 5983 6067 ENDDO 5984 6068 5985 CALL add_phys_tend(du_gwd_front, dv_gwd_front, dt0, dq0, dql0, dqi0, &6069 CALL add_phys_tend(du_gwd_front, dv_gwd_front, dt0, dq0, dql0, dqi0, dqbs0, & 5986 6070 paprs, 'front_gwd_rando', abortphy,flag_inhib_tend,itap,0 & 5987 6071 #ifdef ISO … … 5996 6080 rain_fall + snow_fall, zustr_gwd_rando, zvstr_gwd_rando, & 5997 6081 du_gwd_rando, dv_gwd_rando, east_gwstress, west_gwstress) 5998 CALL add_phys_tend(du_gwd_rando, dv_gwd_rando, dt0, dq0, dql0, dqi0, &6082 CALL add_phys_tend(du_gwd_rando, dv_gwd_rando, dt0, dq0, dql0, dqi0, dqbs0, & 5999 6083 paprs, 'flott_gwd_rando', abortphy,flag_inhib_tend,itap,0 & 6000 6084 #ifdef ISO … … 6055 6139 d_xt_ch4_dtime(:,:,:) = d_xt_ch4(:,:,:)*phys_tstep 6056 6140 #endif 6057 CALL add_phys_tend(du0, dv0, dt0, d_q_ch4_dtime, dql0, dqi0, paprs, &6141 CALL add_phys_tend(du0, dv0, dt0, d_q_ch4_dtime, dql0, dqi0, dqbs0, paprs, & 6058 6142 'q_ch4', abortphy,flag_inhib_tend,itap,0 & 6059 6143 #ifdef ISO … … 6121 6205 ! car on peut s'attendre a ce que les petites echelles produisent aussi de la TKE 6122 6206 ! Mais attention, cela ne va pas dans le sens de la conservation de l'energie! 6123 IF ((zstd(i).GT.1.0) .AND.(zrel_oro(i).LE.zrel_oro_t)) THEN6207 IF ((zstd(i).GT.1.0) .AND.(zrel_oro(i).LE.zrel_oro_t)) THEN 6124 6208 itest(i)=1 6125 6209 igwd=igwd+1 … … 6381 6465 ! 6382 6466 6383 IF (type_trac =='repr') THEN6467 IF (type_trac == 'repr') THEN 6384 6468 !MM pas d'impact, car on recupere q_seri,tr_seri,t_seri via phys_local_var_mod 6385 6469 !MM dans Reprobus … … 6431 6515 presnivs, pphis, pphi, albsol1, & 6432 6516 sh_in, ch_in, rhcl, cldfra, rneb, & 6433 diafra, cldliq, itop_con, ibas_con, &6517 diafra, radocond, itop_con, ibas_con, & 6434 6518 pmflxr, pmflxs, prfl, psfl, & 6435 6519 da, phi, mp, upwd, & … … 6448 6532 6449 6533 CALL add_phys_tend & 6450 (du0,dv0,dt0,d_q_rep,d_ql_rep,d_qi_rep, paprs,&6534 (du0,dv0,dt0,d_q_rep,d_ql_rep,d_qi_rep,dqbs0,paprs,& 6451 6535 'rep',abortphy,flag_inhib_tend,itap,0) 6452 6536 IF (abortphy==1) Print*,'ERROR ABORT REP' … … 6525 6609 ! prlw = colonne eau liquide 6526 6610 ! prlw = colonne eau solide 6611 ! prbsw = colonne neige soufflee 6527 6612 prw(:) = 0. 6528 6613 prlw(:) = 0. 6529 6614 prsw(:) = 0. 6615 prbsw(:) = 0. 6530 6616 DO k = 1, klev 6531 6617 prw(:) = prw(:) + q_seri(:,k)*zmasse(:,k) 6532 6618 prlw(:) = prlw(:) + ql_seri(:,k)*zmasse(:,k) 6533 6619 prsw(:) = prsw(:) + qs_seri(:,k)*zmasse(:,k) 6620 prbsw(:)= prbsw(:) + qbs_seri(:,k)*zmasse(:,k) 6534 6621 ENDDO 6535 6622 … … 6602 6689 ENDIF 6603 6690 !--ice_sursat: nqo=4, on ajoute rneb 6604 IF (nqo == 4) THEN6691 IF (nqo.ge.4 .and. ok_ice_sursat) THEN 6605 6692 d_qx(i,k,irneb) = ( rneb_seri(i,k) - qx(i,k,irneb) ) / phys_tstep 6606 6693 ENDIF 6694 6695 IF (nqo.ge.4 .and. ok_bs) THEN 6696 d_qx(i,k,ibs) = ( qbs_seri(i,k) - qx(i,k,ibs) ) / phys_tstep 6697 ENDIF 6698 6699 6607 6700 ENDDO 6608 6701 ENDDO … … 6684 6777 ql_ancien(:,:) = ql_seri(:,:) 6685 6778 qs_ancien(:,:) = qs_seri(:,:) 6779 qbs_ancien(:,:) = qbs_seri(:,:) 6686 6780 rneb_ancien(:,:) = rneb_seri(:,:) 6687 6781 #ifdef ISO … … 6693 6787 CALL water_int(klon,klev,ql_ancien,zmasse,prlw_ancien) 6694 6788 CALL water_int(klon,klev,qs_ancien,zmasse,prsw_ancien) 6789 CALL water_int(klon,klev,qbs_ancien,zmasse,prbsw_ancien) 6695 6790 ! !! RomP >>> 6696 6791 IF (nqtot > nqo) tr_ancien(:,:,:) = tr_seri(:,:,:) … … 6821 6916 CALL phys_output_write(itap, pdtphys, paprs, pphis, & 6822 6917 pplay, lmax_th, aerosol_couple, & 6823 ok_ade, ok_aie, ok_volcan, ivap, iliq, isol, &6918 ok_ade, ok_aie, ok_volcan, ivap, iliq, isol, ibs, & 6824 6919 ok_sync, ptconv, read_climoz, clevSTD, & 6825 6920 ptconvth, d_u, d_t, qx, d_qx, zmasse, & -
LMDZ6/trunk/libf/phylmdiso/surf_land_mod.F90
r4285 r4523 11 11 rlon, rlat, yrmu0, & 12 12 debut, lafin, zlev, ccanopy, swnet, lwnet, albedo, & 13 tsurf, p1lay, cdragh, cdragm, precip_rain, precip_snow, temp_air, spechum, &13 tsurf, p1lay, cdragh, cdragm, precip_rain, precip_snow, precip_bs, temp_air, spechum, & 14 14 AcoefH, AcoefQ, BcoefH, BcoefQ, & 15 15 AcoefU, AcoefV, BcoefU, BcoefV, & … … 17 17 lwdown_m, q2m, t2m, & 18 18 snow, qsol, agesno, tsoil, & 19 z0m, z0h, SFRWL, alb_dir_new, alb_dif_new, evap, fluxsens, fluxlat, &19 z0m, z0h, SFRWL, alb_dir_new, alb_dif_new, evap, fluxsens, fluxlat, fluxbs, & 20 20 qsurf, tsurf_new, dflux_s, dflux_l, & 21 21 flux_u1, flux_v1 , & … … 94 94 REAL, DIMENSION(klon), INTENT(IN) :: p1lay 95 95 REAL, DIMENSION(klon), INTENT(IN) :: cdragh, cdragm 96 REAL, DIMENSION(klon), INTENT(IN) :: precip_rain, precip_snow 96 REAL, DIMENSION(klon), INTENT(IN) :: precip_rain, precip_snow, precip_bs 97 97 REAL, DIMENSION(klon), INTENT(IN) :: temp_air, spechum 98 98 REAL, DIMENSION(klon), INTENT(IN) :: AcoefH, AcoefQ, BcoefH, BcoefQ … … 129 129 !albedo SB <<< 130 130 REAL, DIMENSION(klon), INTENT(OUT) :: evap 131 REAL, DIMENSION(klon), INTENT(OUT) :: fluxsens, fluxlat 131 REAL, DIMENSION(klon), INTENT(OUT) :: fluxsens, fluxlat, fluxbs 132 132 REAL, DIMENSION(klon), INTENT(OUT) :: qsurf 133 133 REAL, DIMENSION(klon), INTENT(OUT) :: tsurf_new … … 152 152 REAL, DIMENSION(klon) :: tsol_rad, emis_new ! output from interfsol not used 153 153 REAL, DIMENSION(klon) :: u0, v0 ! surface speed 154 REAL, DIMENSION(klon) :: precip_totsnow ! total solid precip 154 155 INTEGER :: i 155 156 … … 166 167 #endif 167 168 169 !**************************************************************************************** 170 !Total solid precip 171 172 IF (ok_bs) THEN 173 precip_totsnow=precip_snow+precip_bs 174 ELSE 175 precip_totsnow=precip_snow 176 ENDIF 177 !**************************************************************************************** 168 178 #ifdef ISO 169 179 #ifdef ISOVERIF … … 228 238 zlev, u1, v1, gustiness, temp_air, spechum, epot_air, ccanopy, & 229 239 cdragh, AcoefH, AcoefQ, BcoefH, BcoefQ, & 230 precip_rain, precip_ snow, lwdown_m, swnet, swdown, &240 precip_rain, precip_totsnow, lwdown_m, swnet, swdown, & 231 241 pref_tmp, q2m, t2m, & 232 evap, fluxsens, fluxlat, &242 evap, fluxsens, fluxlat,fluxbs, & 233 243 tsol_rad, tsurf_new, alb1_new, alb2_new, & 234 244 emis_new, z0m, z0h, qsurf, & … … 277 287 #endif 278 288 CALL surf_land_bucket(itime, jour, knon, knindex, debut, dtime,& 279 tsurf, p1lay, cdragh, precip_rain, precip_ snow, temp_air, &289 tsurf, p1lay, cdragh, precip_rain, precip_totsnow, temp_air, & 280 290 spechum, AcoefH, AcoefQ, BcoefH, BcoefQ, pref, & 281 291 u1, v1, gustiness, rugoro, swnet, lwnet, & … … 293 303 ENDIF ! ok_veget 294 304 305 ! blowing snow not treated yet over land 306 fluxbs(:)=0. 295 307 !**************************************************************************************** 296 308 ! Calculation for all land models -
LMDZ6/trunk/libf/phylmdiso/surf_landice_mod.F90
r4285 r4523 12 12 rmu0, lwdownm, albedo, pphi1, & 13 13 swnet, lwnet, tsurf, p1lay, & 14 cdragh, cdragm, precip_rain, precip_snow, temp_air, spechum, &14 cdragh, cdragm, precip_rain, precip_snow, precip_bs, temp_air, spechum, & 15 15 AcoefH, AcoefQ, BcoefH, BcoefQ, & 16 16 AcoefU, AcoefV, BcoefU, BcoefV, & 17 17 ps, u1, v1, gustiness, rugoro, pctsrf, & 18 snow, qsurf, qsol, agesno, &19 tsoil, z0m, z0h, SFRWL, alb_dir, alb_dif, evap, fluxsens, fluxlat, &18 snow, qsurf, qsol, qbs1, agesno, & 19 tsoil, z0m, z0h, SFRWL, alb_dir, alb_dif, evap, fluxsens, fluxlat, fluxbs, & 20 20 tsurf_new, dflux_s, dflux_l, & 21 21 alt, slope, cloudf, & … … 34 34 USE cpl_mod, ONLY : cpl_send_landice_fields 35 35 USE calcul_fluxs_mod 36 USE phys_output_var_mod 36 USE phys_local_var_mod, ONLY : zxrhoslic, zxustartlic 37 USE phys_output_var_mod, ONLY : snow_o,zfra_o 37 38 #ifdef ISO 38 39 USE fonte_neige_mod, ONLY : xtrun_off_lic … … 48 49 !FC 49 50 USE ioipsl_getin_p_mod, ONLY : getin_p 50 51 USE blowing_snow_ini_mod, ONLY : zeta_bs, pbst_bs, prt_bs 51 52 52 53 #ifdef CPP_INLANDSIS … … 72 73 REAL, DIMENSION(klon), INTENT(IN) :: p1lay 73 74 REAL, DIMENSION(klon), INTENT(IN) :: cdragh, cdragm 74 REAL, DIMENSION(klon), INTENT(IN) :: precip_rain, precip_snow 75 REAL, DIMENSION(klon), INTENT(IN) :: precip_rain, precip_snow, precip_bs 75 76 REAL, DIMENSION(klon), INTENT(IN) :: temp_air, spechum 76 77 REAL, DIMENSION(klon), INTENT(IN) :: AcoefH, AcoefQ … … 78 79 REAL, DIMENSION(klon), INTENT(IN) :: AcoefU, AcoefV, BcoefU, BcoefV 79 80 REAL, DIMENSION(klon), INTENT(IN) :: ps 80 REAL, DIMENSION(klon), INTENT(IN) :: u1, v1, gustiness 81 REAL, DIMENSION(klon), INTENT(IN) :: u1, v1, gustiness, qbs1 81 82 REAL, DIMENSION(klon), INTENT(IN) :: rugoro 82 83 REAL, DIMENSION(klon,nbsrf), INTENT(IN) :: pctsrf … … 118 119 !albedo SB <<< 119 120 REAL, DIMENSION(klon), INTENT(OUT) :: evap, fluxsens, fluxlat 121 REAL, DIMENSION(klon), INTENT(OUT) :: fluxbs 120 122 REAL, DIMENSION(klon), INTENT(OUT) :: tsurf_new 121 123 REAL, DIMENSION(klon), INTENT(OUT) :: dflux_s, dflux_l … … 179 181 180 182 REAL,DIMENSION(klon) :: alb1,alb2 183 REAL,DIMENSION(klon) :: precip_totsnow, evap_totsnow 181 184 REAL, DIMENSION (klon,6) :: alb6 185 REAL :: rho0, rhoice, ustart0, hsalt, esalt, qsalt 186 REAL :: tau_dens, tau_dens0, tau_densmin, rhomax, rhohard 187 REAL, DIMENSION(klon) :: ws1, rhos, ustart 182 188 ! End definition 183 189 !**************************************************************************************** … … 214 220 PRINT*, 'alb_nir_sno_lic',alb_nir_sno_lic 215 221 216 ! z0m=1.e-3217 ! z0h = z0m218 222 firstcall=.false. 219 223 ENDIF 220 224 !****************************************************************************************** 221 ! 225 222 226 ! Initialize output variables 223 227 alb3(:) = 999999. 224 228 alb2(:) = 999999. 225 229 alb1(:) = 999999. 226 230 fluxbs(:)=0. 227 231 runoff(:) = 0. 228 232 !**************************************************************************************** … … 232 236 radsol(:) = 0.0 233 237 radsol(1:knon) = swnet(1:knon) + lwnet(1:knon) 238 239 !**************************************************************************************** 234 240 235 241 !**************************************************************************************** … … 327 333 328 334 329 330 335 ELSE 331 336 … … 342 347 IF (soil_model) THEN 343 348 CALL soil(dtime, is_lic, knon, snow, tsurf, qsol, & 344 & longitude(knindex(1:knon)), latitude(knindex(1:knon)), tsoil, soilcap, soilflux) 345 349 & longitude(knindex(1:knon)), latitude(knindex(1:knon)), tsoil, soilcap, soilflux) 346 350 cal(1:knon) = RCPD / soilcap(1:knon) 347 351 radsol(1:knon) = radsol(1:knon) + soilflux(1:knon) … … 406 410 flux_u1, flux_v1) 407 411 408 !**************************************************************************************** 409 ! Calculate snow height, age, run-off,.. 412 413 !**************************************************************************************** 414 ! Calculate albedo 415 ! 416 !**************************************************************************************** 417 418 CALL albsno(klon,knon,dtime,agesno(:),alb_neig(:), precip_snow(:)) 419 420 421 ! EV: following lines are obsolete since we set alb1 and alb2 to constant values 422 ! I therefore comment them 423 ! alb1(1:knon) = alb_neig(1:knon)*zfra(1:knon) + & 424 ! 0.6 * (1.0-zfra(1:knon)) 425 ! 426 !IM: plusieurs choix/tests sur l'albedo des "glaciers continentaux" 427 ! alb1(1 : knon) = 0.6 !IM cf FH/GK 428 ! alb1(1 : knon) = 0.82 429 ! alb1(1 : knon) = 0.77 !211003 Ksta0.77 430 ! alb1(1 : knon) = 0.8 !KstaTER0.8 & LMD_ARMIP5 431 !IM: KstaTER0.77 & LMD_ARMIP6 432 433 ! Attantion: alb1 and alb2 are not the same! 434 alb1(1:knon) = alb_vis_sno_lic 435 alb2(1:knon) = alb_nir_sno_lic 436 437 438 !**************************************************************************************** 439 ! Rugosity 440 ! 441 !**************************************************************************************** 442 z0m = z0m_landice 443 z0h = z0h_landice 444 !z0m = SQRT(z0m**2+rugoro**2) 445 446 447 448 ! Simple blowing snow param 449 if (ok_bs) then 450 ustart0 = 0.211 451 rhoice = 920.0 452 rho0 = 200.0 453 rhomax=450.0 454 rhohard=400.0 455 tau_dens0=86400.0*10. ! 10 days by default, in s 456 tau_densmin=86400.0 ! 1 days according to in situ obs by C. Amory 457 do i = 1, knon 458 ! estimation of snow density 459 ! snow density increases with snow age and 460 ! increases even faster in case of sedimentation of blowing snow 461 tau_dens=max(tau_densmin, tau_dens0*exp(-abs(precip_bs(i))/pbst_bs-abs(precip_rain(i))/prt_bs)) 462 rhos(i)=rho0+(rhohard-rho0)*(1.-exp(-agesno(i)*86400.0/tau_dens)) 463 ! blowing snow flux formula used in MAR 464 ws1(i)=(u1(i)**2+v1(i)**2)**0.5 465 ustar(i)=(cdragm(i)*(u1(i)**2+v1(i)**2))**0.5 466 ustart(i)=ustart0*exp(max(rhoice/rho0-rhoice/rhos(i),0.))*exp(max(0.,rhos(i)-rhomax)) 467 ! we have multiplied by exp to prevent erosion when rhos>rhomax (usefull till 468 ! rhohard<450) 469 esalt=1./(3.25*max(ustar(i),0.001)) 470 hsalt=0.08436*ustar(i)**1.27 471 qsalt=(max(ustar(i)**2-ustart(i)**2,0.))/(RG*hsalt)*esalt 472 !ep=qsalt*cdragm(i)*sqrt(u1(i)**2+v1(i)**2) 473 fluxbs(i)= zeta_bs*p1lay(i)/RD/temp_air(i)*ws1(i)*cdragm(i)*(qbs1(i)-qsalt) 474 enddo 475 476 ! for outputs 477 do j = 1, knon 478 i = knindex(j) 479 zxustartlic(i) = ustart(j) 480 zxrhoslic(i) = rhos(j) 481 enddo 482 483 endif 484 485 486 487 !**************************************************************************************** 488 ! Calculate surface snow amount 410 489 ! 411 490 !**************************************************************************************** 491 IF (ok_bs) THEN 492 precip_totsnow=precip_snow+precip_bs 493 evap_totsnow=evap-fluxbs ! flux bs is positive towards the surface (snow erosion) 494 ELSE 495 precip_totsnow=precip_snow 496 evap_totsnow=evap 497 ENDIF 498 412 499 CALL fonte_neige(knon, is_lic, knindex, dtime, & 413 tsurf, precip_rain, precip_ snow, &414 snow, qsol, tsurf_new, evap &500 tsurf, precip_rain, precip_totsnow, & 501 snow, qsol, tsurf_new, evap_totsnow & 415 502 #ifdef ISO 416 503 & ,fq_fonte_diag,fqfonte_diag,snow_evap_diag,fqcalving_diag & … … 446 533 447 534 448 !**************************************************************************************** 449 ! Calculate albedo 450 ! 451 !**************************************************************************************** 452 CALL albsno(klon,knon,dtime,agesno(:),alb_neig(:), precip_snow(:)) 453 454 WHERE (snow(1 : knon) .LT. 0.0001) agesno(1 : knon) = 0. 455 zfra(1:knon) = MAX(0.0,MIN(1.0,snow(1:knon)/(snow(1:knon)+10.0))) 456 alb1(1:knon) = alb_neig(1:knon)*zfra(1:knon) + & 457 0.6 * (1.0-zfra(1:knon)) 458 ! 459 !IM: plusieurs choix/tests sur l'albedo des "glaciers continentaux" 460 ! alb1(1 : knon) = 0.6 !IM cf FH/GK 461 ! alb1(1 : knon) = 0.82 462 ! alb1(1 : knon) = 0.77 !211003 Ksta0.77 463 ! alb1(1 : knon) = 0.8 !KstaTER0.8 & LMD_ARMIP5 464 !IM: KstaTER0.77 & LMD_ARMIP6 465 466 ! Attantion: alb1 and alb2 are not the same! 467 alb1(1:knon) = alb_vis_sno_lic 468 alb2(1:knon) = alb_nir_sno_lic 469 470 471 !**************************************************************************************** 472 ! Rugosity 473 ! 474 !**************************************************************************************** 475 z0m=1.e-3 476 z0h = z0m 477 z0m = SQRT(z0m**2+rugoro**2) 478 535 WHERE (snow(1 : knon) .LT. 0.0001) agesno(1 : knon) = 0. 536 zfra(1:knon) = MAX(0.0,MIN(1.0,snow(1:knon)/(snow(1:knon)+10.0))) 479 537 480 538 … … 494 552 run_off_lic_frac(j) = pctsrf(i,is_lic) 495 553 ENDDO 496 554 497 555 CALL cpl_send_landice_fields(itime, knon, knindex, run_off_lic, run_off_lic_frac) 498 556 ENDIF … … 501 559 runoff(1:knon)=run_off_lic(1:knon)/dtime 502 560 503 504 !****************************************************************************************505 ! Etienne: comment these lines because of duplication just below506 ! snow_o=0.507 ! zfra_o = 0.508 ! DO j = 1, knon509 ! i = knindex(j)510 ! snow_o(i) = snow(j)511 ! zfra_o(i) = zfra(j)512 ! ENDDO513 !514 !****************************************************************************************515 561 snow_o=0. 516 562 zfra_o = 0. … … 553 599 !albedo SB <<< 554 600 555 556 557 601 558 602 END SUBROUTINE surf_landice -
LMDZ6/trunk/libf/phylmdiso/surf_ocean_mod.F90
r4374 r4523 13 13 windsp, rmu0, fder, tsurf_in, & 14 14 itime, dtime, jour, knon, knindex, & 15 p1lay, z1lay, cdragh, cdragm, precip_rain, precip_snow, temp_air, spechum, &15 p1lay, z1lay, cdragh, cdragm, precip_rain, precip_snow, precip_bs, temp_air, spechum, & 16 16 AcoefH, AcoefQ, BcoefH, BcoefQ, & 17 17 AcoefU, AcoefV, BcoefU, BcoefV, & … … 72 72 REAL, DIMENSION(klon), INTENT(IN) :: cdragh 73 73 REAL, DIMENSION(klon), INTENT(IN) :: cdragm 74 REAL, DIMENSION(klon), INTENT(IN) :: precip_rain, precip_snow 74 REAL, DIMENSION(klon), INTENT(IN) :: precip_rain, precip_snow, precip_bs 75 75 REAL, DIMENSION(klon), INTENT(IN) :: temp_air, spechum 76 76 REAL, DIMENSION(klon), INTENT(IN) :: AcoefH, AcoefQ, BcoefH, BcoefQ … … 169 169 REAL, DIMENSION(klon) :: radsol 170 170 REAL, DIMENSION(klon) :: cdragq ! Cdrag pour l'evaporation 171 REAL, DIMENSION(klon) :: precip_totsnow 171 172 CHARACTER(len=20),PARAMETER :: modname="surf_ocean" 172 173 real rhoa(knon) ! density of moist air (kg / m3) … … 200 201 radsol(1:knon) = swnet(1:knon) + lwnet(1:knon) 201 202 203 204 !**************************************************************************************** 205 !Total solid precip 206 207 IF (ok_bs) THEN 208 precip_totsnow=precip_snow+precip_bs 209 ELSE 210 precip_totsnow=precip_snow 211 ENDIF 212 202 213 !****************************************************************************** 203 214 ! Cdragq computed from cdrag … … 227 238 windsp, fder, & 228 239 itime, dtime, knon, knindex, & 229 p1lay, cdragh, cdragq, cdragm, precip_rain, precip_ snow,temp_air,spechum,&240 p1lay, cdragh, cdragq, cdragm, precip_rain, precip_totsnow,temp_air,spechum,& 230 241 AcoefH, AcoefQ, BcoefH, BcoefQ, & 231 242 AcoefU, AcoefV, BcoefU, BcoefV, & … … 239 250 CALL ocean_slab_noice( & 240 251 itime, dtime, jour, knon, knindex, & 241 p1lay, cdragh, cdragq, cdragm, precip_rain, precip_ snow, temp_air, spechum,&252 p1lay, cdragh, cdragq, cdragm, precip_rain, precip_totsnow, temp_air, spechum,& 242 253 AcoefH, AcoefQ, BcoefH, BcoefQ, & 243 254 AcoefU, AcoefV, BcoefU, BcoefV, & … … 250 261 CALL ocean_forced_noice( & 251 262 itime, dtime, jour, knon, knindex, & 252 p1lay, cdragh, cdragq, cdragm, precip_rain, precip_ snow, &263 p1lay, cdragh, cdragq, cdragm, precip_rain, precip_totsnow, & 253 264 temp_air, spechum, & 254 265 AcoefH, AcoefQ, BcoefH, BcoefQ, & … … 370 381 call bulk_flux(tkt, tks, taur, dter, dser, t_int, s_int, ds_ns, dt_ns, & 371 382 u = windsp(:knon), t_ocean_1 = tsurf_new(:knon), s1 = sss(:knon), & 372 rain = precip_rain(:knon) + precip_ snow(:knon), &383 rain = precip_rain(:knon) + precip_totsnow(:knon), & 373 384 hf = - fluxsens(:knon), hlb = - fluxlat(:knon), & 374 385 rnl = - lwnet(:knon), &
Note: See TracChangeset
for help on using the changeset viewer.
