Changeset 4669 for LMDZ6/branches/LMDZ_cdrag_LSCE/libf/phylmdiso
- Timestamp:
- Sep 4, 2023, 10:17:16 AM (17 months ago)
- Location:
- LMDZ6/branches/LMDZ_cdrag_LSCE
- Files:
-
- 1 deleted
- 14 edited
- 5 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/trunk/libf/phylmdiso/blowing_snow_ini_mod.F90)
-
libf/phylmdiso/blowing_snow_sublim_sedim.F90 (copied) (copied from LMDZ6/trunk/libf/phylmdiso/blowing_snow_sublim_sedim.F90)
-
libf/phylmdiso/call_atke_mod.F90 (copied) (copied from LMDZ6/trunk/libf/phylmdiso/call_atke_mod.F90)
-
libf/phylmdiso/call_blowing_snow_sublim_sedim.F90 (copied) (copied from LMDZ6/trunk/libf/phylmdiso/call_blowing_snow_sublim_sedim.F90)
-
libf/phylmdiso/climb_qbs_mod.F90 (copied) (copied from LMDZ6/trunk/libf/phylmdiso/climb_qbs_mod.F90)
-
libf/phylmdiso/fisrtilp.F90 (modified) (2 diffs)
-
libf/phylmdiso/fisrtilp.h (deleted)
-
libf/phylmdiso/pbl_surface_mod.F90 (modified) (45 diffs)
-
libf/phylmdiso/phyetat0_mod.F90 (modified) (4 diffs)
-
libf/phylmdiso/phyredem.F90 (modified) (2 diffs)
-
libf/phylmdiso/phys_local_var_mod.F90 (modified) (24 diffs)
-
libf/phylmdiso/phys_output_ctrlout_mod.F90 (modified) (11 diffs)
-
libf/phylmdiso/phys_output_mod.F90 (modified) (2 diffs)
-
libf/phylmdiso/phys_output_var_mod.F90 (modified) (4 diffs)
-
libf/phylmdiso/physiq_mod.F90 (modified) (66 diffs)
-
libf/phylmdiso/surf_land_mod.F90 (modified) (9 diffs)
-
libf/phylmdiso/surf_landice_mod.F90 (modified) (15 diffs)
-
libf/phylmdiso/surf_ocean_mod.F90 (modified) (8 diffs)
Legend:
- Unmodified
- Added
- Removed
-
LMDZ6/branches/LMDZ_cdrag_LSCE
- Property svn:mergeinfo changed
-
LMDZ6/branches/LMDZ_cdrag_LSCE/libf/phylmdiso/add_phys_tend_mod.F90
r4491 r4669 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/branches/LMDZ_cdrag_LSCE/libf/phylmdiso/fisrtilp.F90
r4491 r4669 26 26 ! flag to include modifications to ensure energy conservation (if flag >0) 27 27 USE add_phys_tend_mod, only : fl_cor_ebil 28 USE lscp_ini_mod, ONLY: iflag_t_glace,t_glace_min, t_glace_max, exposant_glace 29 USE lscp_ini_mod, ONLY: iflag_cloudth_vert, iflag_rain_incloud_vol 30 USE lscp_ini_mod, ONLY: coef_eva, coef_eva_i, ffallv_lsc, ffallv_con 31 USE lscp_ini_mod, ONLY: cld_tau_lsc, cld_tau_con, cld_lc_lsc, cld_lc_con 32 USE lscp_ini_mod, ONLY: reevap_ice, iflag_bergeron, iflag_fisrtilp_qsat, iflag_pdf 33 34 35 28 36 #ifdef ISO 29 37 USE infotrac_phy, ONLY: ntraciso=>ntiso,niso,itZonIso … … 82 90 !====================================================================== 83 91 include "YOMCST.h" 84 include "fisrtilp.h"85 include "nuage.h" ! JBM (3/14)86 87 92 ! 88 93 ! Principaux inputs: -
LMDZ6/branches/LMDZ_cdrag_LSCE/libf/phylmdiso/pbl_surface_mod.F90
r4491 r4669 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 diffsivity coefficient for 2201 ! suspended particles is larger than Km by a factor zeta_bs 2202 ! which is equal to 3 by default 2203 do k=1,klev 2204 do j=1,knon 2205 ycoefqbs(j,k)=ycoefm(j,k)*zeta_bs 2206 enddo 2207 enddo 2208 CALL climb_qbs_down(knon, ycoefqbs, ypaprs, ypplay, & 2209 ydelp, yt, yqbs, dtime, & 2210 CcoefQBS, DcoefQBS, & 2211 Kcoef_qbs, gama_qbs, & 2212 AcoefQBS, BcoefQBS) 2213 ENDIF 2214 2215 2173 2216 2174 2217 !**************************************************************************************** … … 2356 2399 debut, lafin, ydelp(:,1), r_co2_ppm, ysolsw, ysollw, yalb, & 2357 2400 !!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,&2401 yts, ypplay(:,1), ycdragh, ycdragm, yrain_f, ysnow_f, ybs_f, yt1, yq1,& 2359 2402 AcoefH, AcoefQ, BcoefH, BcoefQ, & 2360 2403 AcoefU, AcoefV, BcoefU, BcoefV, & … … 2362 2405 ylwdown, yq2m, yt2m, & 2363 2406 ysnow, yqsol, yagesno, ytsoil, & 2364 yz0m, yz0h, SFRWL, yalb_dir_new, yalb_dif_new, yevap, yfluxsens,yfluxlat, &2407 yz0m, yz0h, SFRWL, yalb_dir_new, yalb_dif_new, yevap, yfluxsens,yfluxlat,yfluxbs,& 2365 2408 yqsurf, ytsurf_new, y_dflux_t, y_dflux_q, & 2366 2409 y_flux_u1, y_flux_v1, & … … 2433 2476 yrmu0, ylwdown, yalb, zgeo1, & 2434 2477 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,& 2478 ycdragh, ycdragm, yrain_f, ysnow_f, ybs_f, yt1, yq1,& 2437 2479 AcoefH, AcoefQ, BcoefH, BcoefQ, & 2438 2480 AcoefU, AcoefV, BcoefU, BcoefV, & 2481 AcoefQBS, BcoefQBS, & 2439 2482 ypsref, yu1, yv1, ygustiness, yrugoro, pctsrf, & 2440 ysnow, yqsurf, yqsol, yagesno, &2483 ysnow, yqsurf, yqsol,yqbs1, yagesno, & 2441 2484 ytsoil, yz0m, yz0h, SFRWL, yalb_dir_new, yalb_dif_new, yevap,yfluxsens,yfluxlat, & 2442 y tsurf_new, y_dflux_t, y_dflux_q, &2485 yfluxbs, ytsurf_new, y_dflux_t, y_dflux_q, & 2443 2486 yzmea, yzsig, ycldt, & 2444 2487 ysnowhgt, yqsnow, ytoice, ysissnow, & … … 2499 2542 itap, dtime, jour, knon, ni, & 2500 2543 !!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 init2544 ypplay(:,1), zgeo1(1:knon)/RG, ycdragh, ycdragm, yrain_f, ysnow_f, ybs_f, yt(:,1), yq(:,1),& ! ym missing init 2502 2545 AcoefH, AcoefQ, BcoefH, BcoefQ, & 2503 2546 AcoefU, AcoefV, BcoefU, BcoefV, & … … 2664 2707 ENDDO 2665 2708 ENDIF ! (ok_flux_surf) 2709 2710 ! flux of blowing snow at the first level 2711 IF (ok_bs) THEN 2712 DO j=1,knon 2713 y_flux_bs(j)=yfluxbs(j) 2714 ENDDO 2715 ENDIF 2666 2716 ! 2667 2717 ! ------------------------------------------------------------------------------ … … 2991 3041 ! 2992 3042 ENDIF ! (iflag_split .eq.0) 3043 3044 IF (ok_bs) THEN 3045 CALL climb_qbs_up(knon, dtime, yqbs, & 3046 y_flux_bs, ypaprs, ypplay, & 3047 AcoefQBS, BcoefQBS, & 3048 CcoefQBS, DcoefQBS, & 3049 Kcoef_qbs, gama_qbs, & 3050 y_flux_qbs(:,:), y_d_qbs(:,:)) 3051 ENDIF 3052 2993 3053 !!! 2994 3054 !! … … 3157 3217 !!! 3158 3218 3159 ! print*,'Dans pbl OK1' 3160 3161 !jyg< 3162 !! evap(:,nsrf) = - flux_q(:,1,nsrf) 3163 !>jyg 3219 ! tendencies of blowing snow 3220 IF (ok_bs) THEN 3221 DO k = 1, klev 3222 DO j = 1, knon 3223 i = ni(j) 3224 y_d_qbs(j,k)=y_d_qbs(j,k) * ypct(j) 3225 flux_qbs(i,k,nsrf) = y_flux_qbs(j,k) 3226 ENDDO 3227 ENDDO 3228 ENDIF 3229 3230 3164 3231 DO j = 1, knon 3165 3232 i = ni(j) 3166 3233 evap(i,nsrf) = - flux_q(i,1,nsrf) !jyg 3234 if (ok_bs) then ; snowerosion(i,nsrf)=flux_qbs(i,1,nsrf); endif 3167 3235 beta(i,nsrf) = ybeta(j) !jyg 3168 3236 d_ts(i,nsrf) = y_d_ts(j) … … 3392 3460 ENDDO 3393 3461 ENDDO 3462 3463 3464 IF (ok_bs) THEN 3465 DO k = 1, klev 3466 DO j = 1, knon 3467 i = ni(j) 3468 d_qbs(i,k) = d_qbs(i,k) + y_d_qbs(j,k) 3469 ENDDO 3470 ENDDO 3471 ENDIF 3472 3394 3473 3395 3474 #ifdef ISO … … 3894 3973 fder_print(i) = fder(i) + dflux_t(i) + dflux_q(i) 3895 3974 ENDDO 3975 3976 ! if blowing snow 3977 if (ok_bs) then 3978 DO nsrf = 1, nbsrf 3979 DO k = 1, klev 3980 DO i = 1, klon 3981 zxfluxqbs(i,k) = zxfluxqbs(i,k) + flux_qbs(i,k,nsrf) * pctsrf(i,nsrf) 3982 ENDDO 3983 ENDDO 3984 ENDDO 3985 3986 DO i = 1, klon 3987 zxsnowerosion(i) = zxfluxqbs(i,1) ! blowings snow flux at the surface 3988 END DO 3989 endif 3990 3991 3992 3896 3993 #ifdef ISO 3897 3994 DO i = 1, klon -
LMDZ6/branches/LMDZ_cdrag_LSCE/libf/phylmdiso/phyetat0_mod.F90
r4389 r4669 24 24 qsol, fevap, z0m, z0h, agesno, & 25 25 du_gwd_rando, du_gwd_front, entr_therm, f0, fm_therm, & 26 falb_dir, falb_dif, prw_ancien, prlw_ancien, prsw_ancien, &27 ftsol, pbl_tke, pctsrf, q_ancien, ql_ancien, qs_ancien, rneb_ancien, radpas, radsol, rain_fall, ratqs, &28 rnebcon, rugoro, sig1, snow_fall, solaire_etat0, sollw, sollwdown, &26 falb_dir, falb_dif, prw_ancien, prlw_ancien, prsw_ancien, prbsw_ancien, & 27 ftsol, pbl_tke, pctsrf, q_ancien, ql_ancien, qs_ancien, qbs_ancien, rneb_ancien, radpas, radsol, rain_fall, ratqs, & 28 rnebcon, rugoro, sig1, snow_fall, bs_fall, solaire_etat0, sollw, sollwdown, & 29 29 solsw, solswfdiff, t_ancien, u_ancien, v_ancien, w01, wake_cstar, wake_deltaq, & 30 30 wake_deltat, wake_delta_pbl_TKE, delta_tsurf, beta_aridity, wake_fip, wake_pe, & … … 349 349 found=phyetat0_get(rain_fall,"rain_f","rain fall",0.) 350 350 351 IF (ok_bs) THEN 352 found=phyetat0_get(bs_fall,"bs_f","blowing snow fall",0.) 353 ELSE 354 bs_fall(:)=0. 355 ENDIF 356 357 351 358 !======================================================================= 352 359 ! Radiation … … 410 417 ancien_ok=ancien_ok.AND.phyetat0_get(prsw_ancien,"PRSWANCIEN","PRSWANCIEN",0.) 411 418 419 ! cas specifique des variables de la neige soufflee 420 IF (ok_bs) THEN 421 ancien_ok=ancien_ok.AND.phyetat0_get(qbs_ancien,"QBSANCIEN","QBSANCIEN",0.) 422 ancien_ok=ancien_ok.AND.phyetat0_get(prbsw_ancien,"PRBSWANCIEN","PRBSWANCIEN",0.) 423 ELSE 424 qbs_ancien(:,:)=0. 425 prbsw_ancien(:)=0. 426 ENDIF 427 428 412 429 ! Ehouarn: addtional tests to check if t_ancien, q_ancien contain 413 430 ! dummy values (as is the case when generated by ce0l, … … 423 440 ancien_ok=.false. 424 441 ENDIF 442 443 IF (ok_bs) THEN 444 IF ( (maxval(qbs_ancien).EQ.minval(qbs_ancien)) .OR. & 445 (maxval(prbsw_ancien).EQ.minval(prbsw_ancien)) ) THEN 446 ancien_ok=.false. 447 ENDIF 448 ENDIF 449 425 450 426 451 found=phyetat0_get(clwcon,"CLWCON","CLWCON",0.) -
LMDZ6/branches/LMDZ_cdrag_LSCE/libf/phylmdiso/phyredem.F90
r4491 r4669 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/branches/LMDZ_cdrag_LSCE/libf/phylmdiso/phys_local_var_mod.F90
r4143 r4669 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(:,:) … … 313 317 !$OMP THREADPRIVATE(sens, flwp, fiwp) 314 318 !! 319 !FC 320 REAL,ALLOCATABLE,SAVE,DIMENSION(:,:) :: zxfluxt, zxfluxq 321 !$OMP THREADPRIVATE(zxfluxt, zxfluxq) 322 !FC 315 323 !! Wake variables 316 324 REAL,ALLOCATABLE,SAVE,DIMENSION(:) :: alp_wake … … 361 369 REAL,ALLOCATABLE,SAVE,DIMENSION(:) :: JrNt 362 370 !$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)371 REAL,ALLOCATABLE,SAVE,DIMENSION(:) :: dthmin, evap, snowerosion, fder, plcl, plfc, prw, prlw, prsw, prbsw 372 !$OMP THREADPRIVATE(dthmin, evap, snowerosion, fder, plcl, plfc, prw, prlw, prsw, prbsw) 365 373 REAL,ALLOCATABLE,SAVE,DIMENSION(:) :: zustar, zu10m, zv10m, rh2m 366 374 !$OMP THREADPRIVATE(zustar, zu10m, zv10m, rh2m) … … 379 387 REAL,ALLOCATABLE,SAVE,DIMENSION(:) :: tpot, tpote, ue, uq, uwat, ve, vq, vwat, zxffonte 380 388 !$OMP THREADPRIVATE(tpot, tpote, ue, uq, uwat, ve, vq, vwat, zxffonte) 389 REAL,ALLOCATABLE,SAVE,DIMENSION(:) :: zxustartlic, zxrhoslic 390 !$OMP THREADPRIVATE(zxustartlic, zxrhoslic) 381 391 REAL,ALLOCATABLE,SAVE,DIMENSION(:) :: zxfqcalving 382 392 !$OMP THREADPRIVATE(zxfqcalving) … … 567 577 REAL,ALLOCATABLE,SAVE,DIMENSION(:,:) :: zx_rh, zx_rhl, zx_rhi 568 578 !$OMP THREADPRIVATE(zx_rh, zx_rhl, zx_rhi) 569 REAL,ALLOCATABLE,SAVE,DIMENSION(:,:) :: prfl, psfl, fraca 570 !$OMP THREADPRIVATE(prfl, psfl, fraca )579 REAL,ALLOCATABLE,SAVE,DIMENSION(:,:) :: prfl, psfl, fraca, bsfl 580 !$OMP THREADPRIVATE(prfl, psfl, fraca, bsfl) 571 581 REAL,ALLOCATABLE,SAVE,DIMENSION(:,:) :: Vprecip, zw2 572 582 !$OMP THREADPRIVATE(Vprecip, zw2) … … 585 595 REAL, ALLOCATABLE, SAVE, DIMENSION(:,:) :: rneb,rnebjn,rneblsvol 586 596 !$OMP THREADPRIVATE(rneb,rnebjn,rneblsvol) 597 REAL, ALLOCATABLE, SAVE, DIMENSION(:,:) :: pfraclr,pfracld 598 !$OMP THREADPRIVATE(pfraclr,pfracld) 599 REAL, ALLOCATABLE, SAVE, DIMENSION(:,:) :: distcltop 600 !$OMP THREADPRIVATE(distcltop) 587 601 588 602 ! variables de sorties MM … … 734 748 735 749 IMPLICIT NONE 736 ALLOCATE(t_seri(klon,klev),q_seri(klon,klev),ql_seri(klon,klev),qs_seri(klon,klev) )750 ALLOCATE(t_seri(klon,klev),q_seri(klon,klev),ql_seri(klon,klev),qs_seri(klon,klev), qbs_seri(klon,klev)) 737 751 ALLOCATE(u_seri(klon,klev),v_seri(klon,klev)) 738 752 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 755 ALLOCATE(tr_seri(klon,klev,nbtr)) 742 756 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) )757 ALLOCATE(d_ql_dyn(klon,klev),d_qs_dyn(klon,klev), d_qbs_dyn(klon,klev)) 758 ALLOCATE(d_q_dyn2d(klon),d_ql_dyn2d(klon),d_qs_dyn2d(klon), d_qbs_dyn2d(klon)) 745 759 ALLOCATE(d_u_dyn(klon,klev),d_v_dyn(klon,klev)) 746 760 ALLOCATE(d_tr_dyn(klon,klev,nbtr)) !RomP … … 765 779 ALLOCATE(plul_st(klon),plul_th(klon)) 766 780 ALLOCATE(d_t_vdf(klon,klev),d_q_vdf(klon,klev),d_t_diss(klon,klev)) 767 781 ALLOCATE (d_qbs_vdf(klon,klev)) 782 ALLOCATE(d_t_bs(klon,klev),d_q_bs(klon,klev),d_qbs_bs(klon,klev)) 768 783 ALLOCATE(d_t_vdf_w(klon,klev),d_q_vdf_w(klon,klev)) 769 784 ALLOCATE(d_t_vdf_x(klon,klev),d_q_vdf_x(klon,klev)) … … 925 940 ALLOCATE(cldm(klon), cldq(klon), cldt(klon), qsat2m(klon)) 926 941 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))942 ALLOCATE(dthmin(klon), evap(klon), snowerosion(klon), fder(klon), plcl(klon), plfc(klon)) 943 ALLOCATE(prw(klon), prlw(klon), prsw(klon), prbsw(klon), zustar(klon), zu10m(klon), zv10m(klon), rh2m(klon)) 929 944 ALLOCATE(s_lcl(klon)) 930 945 ALLOCATE(s_pblh(klon), s_pblt(klon), s_therm(klon)) … … 1012 1027 ALLOCATE(wfevap(klon, nbsrf), wfrain(klon,nbsrf), wfsnow(klon, nbsrf)) 1013 1028 ALLOCATE(evap_pot(klon, nbsrf)) 1029 ! FC 1030 ALLOCATE(zxfluxq(klon,klev),zxfluxt(klon,klev)) 1031 ! 1014 1032 ! 1015 1033 ! Deep convective variables used in phytrac … … 1055 1073 ALLOCATE(prfl(klon, klev+1)) 1056 1074 ALLOCATE(psfl(klon, klev+1), fraca(klon, klev+1), Vprecip(klon, klev+1)) 1075 ALLOCATE(bsfl(klon,klev+1)) 1057 1076 ALLOCATE(zw2(klon, klev+1)) 1058 1077 … … 1068 1087 ALLOCATE(beta_prec(klon,klev)) 1069 1088 ALLOCATE(rneb(klon,klev),rnebjn(klon,klev),rneblsvol(klon,klev)) 1070 1089 ALLOCATE(pfraclr(klon,klev),pfracld(klon,klev)) 1090 pfraclr(:,:)=0. ; pfracld(:,:)=0. ! because not always defined 1091 ALLOCATE(distcltop(klon,klev)) 1071 1092 1072 1093 ALLOCATE (zxsnow(klon),snowhgt(klon),qsnow(klon),to_ice(klon)) … … 1141 1162 USE indice_sol_mod 1142 1163 IMPLICIT NONE 1143 DEALLOCATE(t_seri,q_seri,ql_seri,qs_seri )1164 DEALLOCATE(t_seri,q_seri,ql_seri,qs_seri, qbs_seri) 1144 1165 DEALLOCATE(u_seri,v_seri) 1145 1166 DEALLOCATE(l_mixmin,l_mix, tke_dissip,wprime) … … 1147 1168 DEALLOCATE(tr_seri) 1148 1169 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 )1170 DEALLOCATE(d_ql_dyn,d_qs_dyn, d_qbs_dyn) 1171 DEALLOCATE(d_q_dyn2d,d_ql_dyn2d,d_qs_dyn2d, d_qbs_dyn2d) 1151 1172 DEALLOCATE(d_u_dyn,d_v_dyn) 1152 1173 DEALLOCATE(d_tr_dyn) !RomP … … 1171 1192 DEALLOCATE(plul_st,plul_th) 1172 1193 DEALLOCATE(d_t_vdf,d_q_vdf,d_t_diss) 1194 DEALLOCATE(d_qbs_vdf) 1195 DEALLOCATE(d_t_bs,d_q_bs,d_qbs_bs) 1173 1196 #ifdef ISO 1174 1197 deallocate(xt_seri,xtl_seri,xts_seri) … … 1308 1331 DEALLOCATE(cldm, cldq, cldt, qsat2m) 1309 1332 DEALLOCATE(JrNt) 1310 DEALLOCATE(dthmin, evap, fder, plcl, plfc)1311 DEALLOCATE(prw, prlw, prsw, zustar, zu10m, zv10m, rh2m, s_lcl)1333 DEALLOCATE(dthmin, evap, snowerosion, fder, plcl, plfc) 1334 DEALLOCATE(prw, prlw, prsw, prbsw, zustar, zu10m, zv10m, rh2m, s_lcl) 1312 1335 DEALLOCATE(s_pblh, s_pblt, s_therm) 1313 1336 ! … … 1322 1345 DEALLOCATE(zxfqcalving, zxfluxlat) 1323 1346 DEALLOCATE(zxrunofflic) 1347 DEALLOCATE(zxustartlic, zxrhoslic) 1324 1348 DEALLOCATE(zxtsol, snow_lsc, zxfqfonte, zxqsurf) 1325 1349 DEALLOCATE(rain_lsc) … … 1364 1388 DEALLOCATE(alp_bl_stat, n2, s2) 1365 1389 DEALLOCATE(proba_notrig, random_notrig) 1390 !FC 1391 DEALLOCATE(zxfluxq,zxfluxt) 1366 1392 1367 1393 DEALLOCATE(dnwd0) … … 1423 1449 1424 1450 1425 DEALLOCATE(prfl, psfl, fraca, Vprecip)1451 DEALLOCATE(prfl, psfl, bsfl, fraca, Vprecip) 1426 1452 DEALLOCATE(zw2) 1427 1453 … … 1436 1462 DEALLOCATE(beta_prec) 1437 1463 DEALLOCATE(rneb) 1464 DEALLOCATE(pfraclr,pfracld) 1465 DEALLOCATE(distcltop) 1438 1466 DEALLOCATE (zxsnow,snowhgt,qsnow,to_ice,sissnow,runoff,albsol3_lic) 1439 1467 #ifdef ISO -
LMDZ6/branches/LMDZ_cdrag_LSCE/libf/phylmdiso/phys_output_ctrlout_mod.F90
r4065 r4669 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) /)) … … 1462 1473 TYPE(ctrl_out), SAVE :: o_rneblsvol = ctrl_out((/ 2, 5, 10, 10, 10, 10, 11, 11, 11, 11/), & 1463 1474 'rneblsvol', 'LS Cloud fraction by volume', '-', (/ ('', i=1, 10) /)) 1475 TYPE(ctrl_out), SAVE :: o_pfraclr = ctrl_out((/ 11, 11, 11, 11, 11, 11, 11, 11, 11, 11/), & 1476 'pfraclr', 'LS precipitation fraction clear-sky part', '-', (/ ('', i=1, 10) /)) 1477 TYPE(ctrl_out), SAVE :: o_pfracld = ctrl_out((/ 11, 11, 11, 11, 11, 11, 11, 11, 11, 11/), & 1478 'pfracld', 'LS precipitation fraction cloudy part', '-', (/ ('', i=1, 10) /)) 1464 1479 TYPE(ctrl_out), SAVE :: o_rhum = ctrl_out((/ 2, 5, 10, 10, 10, 10, 11, 11, 11, 11/), & 1465 1480 'rhum', 'Relative humidity', '-', (/ ('', i=1, 10) /)) … … 1494 1509 TYPE(ctrl_out), SAVE :: o_dqsphy2d = ctrl_out((/ 2, 10, 10, 10, 10, 10, 11, 11, 11, 11/), & 1495 1510 'dqsphy2d', 'Physics dQS', '(kg/m2)/s', (/ ('', i=1, 10) /)) 1511 TYPE(ctrl_out), SAVE :: o_dqbsphy = ctrl_out((/ 10, 10, 10, 10, 10, 10, 11, 11, 11, 11/), & 1512 'dqbsphy', 'Physics dQBS', '(kg/kg)/s', (/ ('', i=1, 10) /)) 1513 TYPE(ctrl_out), SAVE :: o_dqbsphy2d = ctrl_out((/ 10, 10, 10, 10, 10, 10, 11, 11, 11, 11/), & 1514 'dqbsphy2d', 'Physics dQBS', '(kg/m2)/s', (/ ('', i=1, 10) /)) 1496 1515 TYPE(ctrl_out), SAVE :: o_pr_con_l = ctrl_out((/ 2, 10, 10, 10, 10, 10, 11, 11, 11, 11/), & 1497 1516 'pr_con_l', 'Convective precipitation lic', ' ', (/ ('', i=1, 10) /)) … … 1502 1521 TYPE(ctrl_out), SAVE :: o_pr_lsc_i = ctrl_out((/ 2, 10, 10, 10, 10, 10, 11, 11, 11, 11/), & 1503 1522 'pr_lsc_i', 'Large scale precipitation ice', ' ', (/ ('', i=1, 10) /)) 1523 TYPE(ctrl_out), SAVE :: o_pr_bs = ctrl_out((/ 10, 10, 10, 10, 10, 10, 11, 11, 11, 11/), & 1524 'pr_bs', 'profile of blowing snow flux', ' ', (/ ('', i=1, 10) /)) 1504 1525 TYPE(ctrl_out), SAVE :: o_re = ctrl_out((/ 5, 10, 10, 10, 10, 10, 11, 11, 11, 11/), & 1505 1526 're', 'Cloud droplet effective radius', 'um', (/ ('', i=1, 10) /)) … … 1530 1551 TYPE(ctrl_out), SAVE :: o_stratomask = ctrl_out((/ 2, 6, 10, 10, 10, 10, 11, 11, 11, 11/), & 1531 1552 'stratomask', 'Stratospheric fraction', '1', (/ ('', i=1, 10) /)) 1553 !FC 1554 TYPE(ctrl_out), SAVE :: o_zxfluxt = ctrl_out((/ 2, 6, 10, 10, 10, 10, 11, 11, 11, 11/), & 1555 'fluxt', 'flux h ', 'W/m2', (/ ('', i=1, 10) /)) 1556 TYPE(ctrl_out), SAVE :: o_zxfluxq = ctrl_out((/ 2, 6, 10, 10, 10, 10, 11, 11, 11, 11/), & 1557 'fluxq', 'flux q ', 'kg/(s*m2)', (/ ('', i=1, 10) /)) 1532 1558 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 1533 1559 … … 1599 1625 TYPE(ctrl_out), SAVE :: o_dqsdyn2d = ctrl_out((/ 4, 10, 10, 10, 10, 10, 11, 11, 11, 11/), & 1600 1626 'dqsdyn2d', 'Dynamics dQS', '(kg/m2)/s', (/ ('', i=1, 10) /)) 1627 TYPE(ctrl_out), SAVE :: o_dqbsdyn = ctrl_out((/ 10, 10, 10, 10, 10, 10, 11, 11, 11, 11/), & 1628 'dqbsdyn', 'Dynamics dQBS', '(kg/kg)/s', (/ ('', i=1, 10) /)) 1629 TYPE(ctrl_out), SAVE :: o_dqbsdyn2d = ctrl_out((/ 10, 10, 10, 10, 10, 10, 11, 11, 11, 11/), & 1630 'dqbsdyn2d', 'Dynamics dQBS', '(kg/m2)/s', (/ ('', i=1, 10) /)) 1601 1631 TYPE(ctrl_out), SAVE :: o_dudyn = ctrl_out((/ 4, 10, 10, 10, 10, 10, 11, 11, 11, 11/), & 1602 1632 'dudyn', 'Dynamics dU', 'm/s2', (/ ('', i=1, 10) /)) … … 1673 1703 TYPE(ctrl_out), SAVE :: o_dqeva2d = ctrl_out((/ 4, 10, 10, 10, 10, 10, 11, 11, 11, 11/), & 1674 1704 'dqeva2d', 'Reevaporation dQ', '(kg/m2)/s', (/ ('', i=1, 10) /)) 1705 TYPE(ctrl_out), SAVE :: o_dqbsvdf = ctrl_out((/ 10, 10, 10, 10, 10, 10, 11, 11, 11, 11/), & 1706 'dqbsvdf', 'Boundary-layer dQBS', '(kg/kg)/s', (/ ('', i=1, 10) /)) 1707 TYPE(ctrl_out), SAVE :: o_dqbsbs = ctrl_out((/ 10, 10, 10, 10, 10, 10, 11, 11, 11, 11/), & 1708 'dqbsbs', 'Blowing snow dQBS', '(kg/kg)/s', (/ ('', i=1, 10) /)) 1709 TYPE(ctrl_out), SAVE :: o_dtbs = ctrl_out((/ 10, 10, 10, 10, 10, 10, 11, 11, 11, 11/), & 1710 'dtbs', 'Blowing snow dT', '(K)/s', (/ ('', i=1, 10) /)) 1711 TYPE(ctrl_out), SAVE :: o_dqbs = ctrl_out((/ 10, 10, 10, 10, 10, 10, 11, 11, 11, 11/), & 1712 'dqbs', 'Blowing snow dQ', '(kg/kg)/s', (/ ('', i=1, 10) /)) 1675 1713 1676 1714 !!!!!!!!!!!!!!!! Specifique thermiques … … 1835 1873 TYPE(ctrl_out), SAVE, ALLOCATABLE :: o_xtprecip(:) 1836 1874 TYPE(ctrl_out), SAVE, ALLOCATABLE :: o_xtevap(:) 1875 TYPE(ctrl_out), SAVE, ALLOCATABLE :: o_xtevap_srf(:,:) ! ajout Camille 8 mai 2023 1837 1876 TYPE(ctrl_out), SAVE, ALLOCATABLE :: o_xtplul(:) 1838 1877 TYPE(ctrl_out), SAVE, ALLOCATABLE :: o_xtpluc(:) -
LMDZ6/branches/LMDZ_cdrag_LSCE/libf/phylmdiso/phys_output_mod.F90
r4170 r4669 178 178 ALLOCATE(o_xtpluc(ntraciso)) 179 179 ALLOCATE(o_xtevap(ntraciso)) 180 ALLOCATE(o_xtevap_srf(ntraciso,4)) 180 181 ALLOCATE(o_xtovap(ntraciso)) 181 182 ALLOCATE(o_xtoliq(ntraciso)) … … 558 559 o_xtevap (ixt)=ctrl_out(flag, 'evap'//TRIM(outiso), 'Evaporat.', unit, [('',i=1,nfiles)]) 559 560 561 ! ajout Camille 8 mai 2023 562 flag = [1, 6, 10, 10, 10, 10, 11, 11, 11, 11] 563 o_xtevap_srf (ixt,1)=ctrl_out(flag, 'evap_ter'//TRIM(outiso), 'Evap sfc'//clnsurf(1), unit, [('',i=1,nfiles)]) 564 o_xtevap_srf (ixt,2)=ctrl_out(flag, 'evap_lic'//TRIM(outiso), 'Evap sfc'//clnsurf(2), unit, [('',i=1,nfiles)]) 565 o_xtevap_srf (ixt,3)=ctrl_out(flag, 'evap_oce'//TRIM(outiso), 'Evap sfc'//clnsurf(3), unit, [('',i=1,nfiles)]) 566 o_xtevap_srf (ixt,4)=ctrl_out(flag, 'evap_sic'//TRIM(outiso), 'Evap sfc'//clnsurf(4), unit, [('',i=1,nfiles)]) 567 560 568 flag = [2, 3, 4, 10, 10, 10, 11, 11, 11, 11]; unit = 'kg/kg' 561 569 o_xtovap (ixt)=ctrl_out(flag, 'ovap'//TRIM(outiso), 'Specific humidity', unit, [('',i=1,nfiles)]) -
LMDZ6/branches/LMDZ_cdrag_LSCE/libf/phylmdiso/phys_output_var_mod.F90
r4374 r4669 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/branches/LMDZ_cdrag_LSCE/libf/phylmdiso/physiq_mod.F90
r4495 r4669 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, & … … 328 331 ! 329 332 rneblsvol, & 333 pfraclr,pfracld, & 334 distcltop, & 330 335 zqsatl, zqsats, & 331 336 qclr, qcld, qss, qvc, rnebclr, rnebss, gamma_ss, & … … 343 348 fsolsw, wfbils, wfbilo, & 344 349 wfevap, wfrain, wfsnow, & 345 prfl, psfl, fraca, Vprecip, &350 prfl, psfl,bsfl, fraca, Vprecip, & 346 351 zw2, & 347 352 ! … … 355 360 beta_prec, & 356 361 rneb, & 357 zxsnow,snowhgt,qsnow,to_ice,sissnow,runoff,albsol3_lic 362 zxsnow,snowhgt,qsnow,to_ice,sissnow,runoff,albsol3_lic, & 363 zxfluxt,zxfluxq 358 364 359 365 … … 526 532 !====================================================================== 527 533 ! 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 )534 ! indices de traceurs eau vapeur, liquide, glace, fraction nuageuse LS (optional), blowing snow (optional) 535 INTEGER,SAVE :: ivap, iliq, isol, irneb, ibs 536 !$OMP THREADPRIVATE(ivap, iliq, isol, irneb, ibs) 531 537 ! 532 538 ! … … 905 911 REAL dialiq(klon,klev) ! eau liquide nuageuse 906 912 REAL diafra(klon,klev) ! fraction nuageuse 907 REAL cldliq(klon,klev) ! eau liquide nuageuse913 REAL radocond(klon,klev) ! eau condensee nuageuse 908 914 ! 909 915 !XXX PB 910 916 REAL fluxq(klon,klev, nbsrf) ! flux turbulent d'humidite 911 ! 912 REAL zxfluxt(klon, klev) 913 REAL zxfluxq(klon, klev) 917 REAL fluxqbs(klon,klev, nbsrf) ! flux turbulent de neige soufflee 918 ! 919 !FC REAL zxfluxt(klon, klev) 920 !FC REAL zxfluxq(klon, klev) 921 REAL zxfluxqbs(klon,klev) 914 922 REAL zxfluxu(klon, klev) 915 923 REAL zxfluxv(klon, klev) … … 1009 1017 ! 1010 1018 ! tendance nulles 1011 REAL, dimension(klon,klev):: du0, dv0, dt0, dq0, dql0, dqi0 1019 REAL, dimension(klon,klev):: du0, dv0, dt0, dq0, dql0, dqi0, dqbs0 1012 1020 #ifdef ISO 1013 1021 REAL, dimension(ntraciso,klon,klev):: dxt0, dxtl0, dxti0 … … 1156 1164 REAL ztsol(klon) 1157 1165 REAL q2m(klon,nbsrf) ! humidite a 2m 1166 REAL fsnowerosion(klon,nbsrf) ! blowing snow flux at surface 1167 REAL qbsfra ! blowing snow fraction 1158 1168 #ifdef ISO 1159 1169 REAL d_xtw(ntraciso),d_xtl(ntraciso), d_xts(ntraciso) … … 1234 1244 !IM 100106 BEG : pouvoir sortir les ctes de la physique 1235 1245 include "conema3.h" 1236 include "fisrtilp.h"1237 1246 include "nuage.h" 1238 1247 include "compbl.h" … … 1372 1381 isol = strIdx(tracers(:)%name, addPhase('H2O', 's')) 1373 1382 irneb= strIdx(tracers(:)%name, addPhase('H2O', 'r')) 1383 ibs = strIdx(tracers(:)%name, addPhase('H2O', 'b')) 1374 1384 CALL init_etat0_limit_unstruct 1375 1385 IF (.NOT. create_etat0_limit) CALL init_limit_read(days_elapsed) … … 1421 1431 ENDIF 1422 1432 1423 IF (ok_ice_sursat.AND.(nqo. NE.4)) THEN1433 IF (ok_ice_sursat.AND.(nqo.LT.4)) THEN 1424 1434 WRITE (lunout, *) ' ok_ice_sursat=y requires 4 H2O tracers ', & 1425 1435 '(H2O_g, H2O_l, H2O_s, H2O_r) but nqo=', nqo, '. Might as well stop here.' … … 1440 1450 ENDIF 1441 1451 1452 IF (ok_bs) THEN 1453 abort_message='blowing snow cannot be activated with water isotopes yet' 1454 CALL abort_physic(modname,abort_message, 1) 1455 IF ((ok_ice_sursat.AND.nqo .LT.5).OR.(.NOT.ok_ice_sursat.AND.nqo.LT.4)) THEN 1456 WRITE (lunout, *) 'activation of blowing snow needs a specific H2O tracer', & 1457 'but nqo=', nqo 1458 abort_message='see above' 1459 CALL abort_physic(modname,abort_message, 1) 1460 ENDIF 1461 ENDIF 1442 1462 Ncvpaseq1 = 0 1443 1463 dnwd0=0.0 … … 1890 1910 CALL thermcell_ini(iflag_thermals,prt_level,tau_thermals,lunout, & 1891 1911 & RG,RD,RCPD,RKAPPA,RLVTT,RETV) 1892 IF (ok_new_lscp) then 1893 CALL lscp_ini(pdtphys,ok_ice_sursat) 1894 endif 1912 CALL lscp_ini(pdtphys,ok_ice_sursat,RCPD, RLSTT, RLVTT, RLMLT, RVTMP2, RTT,RD,RG) 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 … … 4627 4687 ptconv,ptconvth,clwcon0th, rnebcon0th, & 4628 4688 paprs,pplay,t_seri,q_seri, qtc_cv, sigt_cv, zqsat, & 4629 pbl_tke(:,:,is_ave),tke_dissip_ave,l_mix_ave,wprime_ave,t2m,q2m,fm_therm, &4689 pbl_tke(:,:,is_ave),tke_dissip_ave,l_mix_ave,wprime_ave,t2m,q2m,fm_therm,cell_area, & 4630 4690 ratqs,ratqsc,ratqs_inter) 4631 4691 … … 4731 4791 t_seri, q_seri,ptconv,ratqs, & 4732 4792 d_t_lsc, d_q_lsc, d_ql_lsc, d_qi_lsc, rneb, rneblsvol, rneb_seri, & 4733 cldliq, picefra, rain_lsc, snow_lsc, & 4793 pfraclr,pfracld, & 4794 radocond, picefra, rain_lsc, snow_lsc, & 4734 4795 frac_impa, frac_nucl, beta_prec_fisrt, & 4735 4796 prfl, psfl, rhcl, & 4736 4797 zqasc, fraca,ztv,zpspsk,ztla,zthl,iflag_cld_th, & 4737 iflag_ice_thermo, ok_ice_sursat, zqsatl, zqsats, &4798 iflag_ice_thermo, ok_ice_sursat, zqsatl, zqsats, distcltop, & 4738 4799 qclr, qcld, qss, qvc, rnebclr, rnebss, gamma_ss, & 4739 4800 Tcontr, qcontr, qcontr2, fcontrN, fcontrP ) … … 4743 4804 CALL fisrtilp(phys_tstep,paprs,pplay, & 4744 4805 t_seri, q_seri,ptconv,ratqs, & 4745 d_t_lsc, d_q_lsc, d_ql_lsc, d_qi_lsc, rneb, cldliq, &4806 d_t_lsc, d_q_lsc, d_ql_lsc, d_qi_lsc, rneb, radocond, & 4746 4807 rain_lsc, snow_lsc, & 4747 4808 pfrac_impa, pfrac_nucl, pfrac_1nucl, & … … 4791 4852 ! write(*,9000) "rcpv","rcw",rcpv,rcw,rcs,t_seri(1,1) 4792 4853 !-JLD 4793 CALL add_phys_tend(du0,dv0,d_t_lsc,d_q_lsc,d_ql_lsc,d_qi_lsc, paprs, &4854 CALL add_phys_tend(du0,dv0,d_t_lsc,d_q_lsc,d_ql_lsc,d_qi_lsc,dqbs0,paprs, & 4794 4855 'lsc',abortphy,flag_inhib_tend,itap,0 & 4795 4856 #ifdef ISO … … 4828 4889 ENDIF 4829 4890 4830 !--------------------------------------------------------------------------- 4891 4892 !--------------------------------------------------------------------------- 4831 4893 DO k = 1, klev 4832 4894 DO i = 1, klon 4833 4895 cldfra(i,k) = rneb(i,k) 4834 4896 !CR: a quoi ca sert? Faut-il ajouter qs_seri? 4835 IF (.NOT.new_oliq) cldliq(i,k) = ql_seri(i,k) 4897 !EV: en effet etrange, j'ajouterais aussi qs_seri 4898 ! plus largement, je nettoierais (enleverrais) ces lignes 4899 IF (.NOT.new_oliq) radocond(i,k) = ql_seri(i,k) 4836 4900 ENDDO 4837 4901 ENDDO 4838 4902 4839 4903 4840 4904 ! Option to activate the radiative effect of blowing snow (ok_rad_bs) 4905 ! makes sense only if the new large scale condensation scheme is active 4906 ! with the ok_icefra_lscp flag active as well 4907 4908 IF (ok_bs .AND. ok_rad_bs) THEN 4909 IF (ok_new_lscp .AND. ok_icefra_lscp) THEN 4910 DO k=1,klev 4911 DO i=1,klon 4912 radocond(i,k)=radocond(i,k)+qbs_seri(i,k) 4913 picefra(i,k)=(radocond(i,k)*picefra(i,k)+qbs_seri(i,k))/(radocond(i,k)) 4914 qbsfra=min(qbs_seri(i,k)/qbst_bs,1.0) 4915 cldfra(i,k)=max(cldfra(i,k),qbsfra) 4916 ENDDO 4917 ENDDO 4918 ELSE 4919 WRITE(lunout,*)"PAY ATTENTION, you try to activate the radiative effect of blowing snow" 4920 WRITE(lunout,*)"with ok_new_lscp=false and/or ok_icefra_lscp=false" 4921 abort_message='inconsistency in cloud phase for blowing snow' 4922 CALL abort_physic(modname,abort_message,1) 4923 ENDIF 4924 4925 ENDIF 4841 4926 #ifdef ISO 4842 4927 !#ifdef ISOVERIF … … 5001 5086 DO i = 1, klon 5002 5087 IF (diafra(i,k).GT.cldfra(i,k)) THEN 5003 cldliq(i,k) = dialiq(i,k)5088 radocond(i,k) = dialiq(i,k) 5004 5089 cldfra(i,k) = diafra(i,k) 5005 5090 ENDIF … … 5038 5123 DO i=1,klon 5039 5124 IF (ptconv(i,k).AND.ptconvth(i,k)) THEN 5040 cldliq(i,k)=cldliq(i,k)+rnebcon(i,k)*clwcon(i,k)5125 radocond(i,k)=radocond(i,k)+rnebcon(i,k)*clwcon(i,k) 5041 5126 cldfra(i,k)=min(cldfra(i,k)+rnebcon(i,k),1.) 5042 5127 ELSE IF (ptconv(i,k)) THEN 5043 5128 cldfra(i,k)=rnebcon(i,k) 5044 cldliq(i,k)=rnebcon(i,k)*clwcon(i,k)5129 radocond(i,k)=rnebcon(i,k)*clwcon(i,k) 5045 5130 ENDIF 5046 5131 ENDDO … … 5051 5136 DO i=1,klon 5052 5137 cldfra(i,k)=min(cldfra(i,k)+rnebcon(i,k),1.) 5053 cldliq(i,k)=cldliq(i,k)+rnebcon(i,k)*clwcon(i,k)5138 radocond(i,k)=radocond(i,k)+rnebcon(i,k)*clwcon(i,k) 5054 5139 ENDDO 5055 5140 ENDDO … … 5069 5154 IF (ptconv(i,k).AND. .NOT.ptconvth(i,k)) THEN 5070 5155 cldfra(i,k)=rnebcon(i,k) 5071 cldliq(i,k)=rnebcon(i,k)*clwcon(i,k)5156 radocond(i,k)=rnebcon(i,k)*clwcon(i,k) 5072 5157 ENDIF 5073 5158 ENDDO … … 5080 5165 ! Ancienne version 5081 5166 cldfra(:,:)=min(max(cldfra(:,:),rnebcon(:,:)),1.) 5082 cldliq(:,:)=cldliq(:,:)+rnebcon(:,:)*clwcon(:,:)5167 radocond(:,:)=radocond(:,:)+rnebcon(:,:)*clwcon(:,:) 5083 5168 ENDIF 5084 5169 … … 5100 5185 DO i = 1, klon 5101 5186 IF (diafra(i,k).GT.cldfra(i,k)) THEN 5102 cldliq(i,k) = dialiq(i,k)5187 radocond(i,k) = dialiq(i,k) 5103 5188 cldfra(i,k) = diafra(i,k) 5104 5189 ENDIF … … 5475 5560 ENDIF 5476 5561 CALL newmicro (flag_aerosol, ok_cdnc, bl95_b0, bl95_b1, & 5477 paprs, pplay, t_seri, cldliq, picefra, cldfra, &5562 paprs, pplay, t_seri, radocond, picefra, cldfra, & 5478 5563 cldtau, cldemi, cldh, cldl, cldm, cldt, cldq, & 5479 5564 flwp, fiwp, flwc, fiwc, & 5480 5565 mass_solu_aero, mass_solu_aero_pi, & 5481 cldtaupi, latitude_deg, re, fl, ref_liq, ref_ice, &5566 cldtaupi, latitude_deg, distcltop, re, fl, ref_liq, ref_ice, & 5482 5567 ref_liq_pi, ref_ice_pi) 5483 5568 ELSE 5484 5569 CALL nuage (paprs, pplay, & 5485 t_seri, cldliq, picefra, cldfra, cldtau, cldemi, &5570 t_seri, radocond, picefra, cldfra, cldtau, cldemi, & 5486 5571 cldh, cldl, cldm, cldt, cldq, & 5487 5572 ok_aie, & 5488 5573 mass_solu_aero, mass_solu_aero_pi, & 5489 bl95_b0, bl95_b1, &5574 bl95_b0, bl95_b1, distcltop, & 5490 5575 cldtaupi, re, fl) 5491 5576 ENDIF … … 5792 5877 ENDDO 5793 5878 5794 CALL add_phys_tend(du0,dv0,d_t_swr,dq0,dql0,dqi0, paprs,'SW',abortphy,flag_inhib_tend,itap,0 &5879 CALL add_phys_tend(du0,dv0,d_t_swr,dq0,dql0,dqi0,dqbs0,paprs,'SW',abortphy,flag_inhib_tend,itap,0 & 5795 5880 #ifdef ISO 5796 5881 & ,dxt0,dxtl0,dxti0 & … … 5798 5883 & ) 5799 5884 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 &5885 CALL add_phys_tend(du0,dv0,d_t_lwr,dq0,dql0,dqi0,dqbs0,paprs,'LW',abortphy,flag_inhib_tend,itap,0 & 5801 5886 #ifdef ISO 5802 5887 & ,dxt0,dxtl0,dxti0 & … … 5846 5931 ! -> condition on zrel_oro can deactivate the drag on tilted planar terrains 5847 5932 ! such as ice sheets (work by V. Wiener) 5848 ! zpmm_orodr_t and zstd_orodr_t are activation thresholds set by F. Lott to 5933 ! zpmm_orodr_t and zstd_orodr_t are activation thresholds set by F. Lott to 5849 5934 ! earn computation time but they are not physical. 5850 5935 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 5962 !----------------------------------------------------------------------- 5878 5963 ! 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', &5964 CALL add_phys_tend(d_u_oro,d_v_oro,d_t_oro,dq0,dql0,dqi0,dqbs0,paprs,'oro', & 5880 5965 abortphy,flag_inhib_tend,itap,0 & 5881 5966 #ifdef ISO … … 5932 6017 5933 6018 ! 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, &6019 CALL add_phys_tend(d_u_lif, d_v_lif, d_t_lif, dq0, dql0, dqi0, dqbs0,paprs, & 5935 6020 'lif', abortphy,flag_inhib_tend,itap,0 & 5936 6021 #ifdef ISO … … 5961 6046 d_t_hin(:, :)=0. 5962 6047 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 &6048 dqi0, dqbs0,paprs, 'hin', abortphy,flag_inhib_tend,itap,0 & 5964 6049 #ifdef ISO 5965 6050 & ,dxt0,dxtl0,dxti0 & … … 5983 6068 ENDDO 5984 6069 5985 CALL add_phys_tend(du_gwd_front, dv_gwd_front, dt0, dq0, dql0, dqi0, &6070 CALL add_phys_tend(du_gwd_front, dv_gwd_front, dt0, dq0, dql0, dqi0, dqbs0, & 5986 6071 paprs, 'front_gwd_rando', abortphy,flag_inhib_tend,itap,0 & 5987 6072 #ifdef ISO … … 5996 6081 rain_fall + snow_fall, zustr_gwd_rando, zvstr_gwd_rando, & 5997 6082 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, &6083 CALL add_phys_tend(du_gwd_rando, dv_gwd_rando, dt0, dq0, dql0, dqi0, dqbs0, & 5999 6084 paprs, 'flott_gwd_rando', abortphy,flag_inhib_tend,itap,0 & 6000 6085 #ifdef ISO … … 6055 6140 d_xt_ch4_dtime(:,:,:) = d_xt_ch4(:,:,:)*phys_tstep 6056 6141 #endif 6057 CALL add_phys_tend(du0, dv0, dt0, d_q_ch4_dtime, dql0, dqi0, paprs, &6142 CALL add_phys_tend(du0, dv0, dt0, d_q_ch4_dtime, dql0, dqi0, dqbs0, paprs, & 6058 6143 'q_ch4', abortphy,flag_inhib_tend,itap,0 & 6059 6144 #ifdef ISO … … 6121 6206 ! car on peut s'attendre a ce que les petites echelles produisent aussi de la TKE 6122 6207 ! 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)) THEN6208 IF ((zstd(i).GT.1.0) .AND.(zrel_oro(i).LE.zrel_oro_t)) THEN 6124 6209 itest(i)=1 6125 6210 igwd=igwd+1 … … 6381 6466 ! 6382 6467 6383 IF (type_trac =='repr') THEN6468 IF (type_trac == 'repr') THEN 6384 6469 !MM pas d'impact, car on recupere q_seri,tr_seri,t_seri via phys_local_var_mod 6385 6470 !MM dans Reprobus … … 6431 6516 presnivs, pphis, pphi, albsol1, & 6432 6517 sh_in, ch_in, rhcl, cldfra, rneb, & 6433 diafra, cldliq, itop_con, ibas_con, &6518 diafra, radocond, itop_con, ibas_con, & 6434 6519 pmflxr, pmflxs, prfl, psfl, & 6435 6520 da, phi, mp, upwd, & … … 6448 6533 6449 6534 CALL add_phys_tend & 6450 (du0,dv0,dt0,d_q_rep,d_ql_rep,d_qi_rep, paprs,&6535 (du0,dv0,dt0,d_q_rep,d_ql_rep,d_qi_rep,dqbs0,paprs,& 6451 6536 'rep',abortphy,flag_inhib_tend,itap,0) 6452 6537 IF (abortphy==1) Print*,'ERROR ABORT REP' … … 6525 6610 ! prlw = colonne eau liquide 6526 6611 ! prlw = colonne eau solide 6612 ! prbsw = colonne neige soufflee 6527 6613 prw(:) = 0. 6528 6614 prlw(:) = 0. 6529 6615 prsw(:) = 0. 6616 prbsw(:) = 0. 6530 6617 DO k = 1, klev 6531 6618 prw(:) = prw(:) + q_seri(:,k)*zmasse(:,k) 6532 6619 prlw(:) = prlw(:) + ql_seri(:,k)*zmasse(:,k) 6533 6620 prsw(:) = prsw(:) + qs_seri(:,k)*zmasse(:,k) 6621 prbsw(:)= prbsw(:) + qbs_seri(:,k)*zmasse(:,k) 6534 6622 ENDDO 6535 6623 … … 6602 6690 ENDIF 6603 6691 !--ice_sursat: nqo=4, on ajoute rneb 6604 IF (nqo == 4) THEN6692 IF (nqo.ge.4 .and. ok_ice_sursat) THEN 6605 6693 d_qx(i,k,irneb) = ( rneb_seri(i,k) - qx(i,k,irneb) ) / phys_tstep 6606 6694 ENDIF 6695 6696 IF (nqo.ge.4 .and. ok_bs) THEN 6697 d_qx(i,k,ibs) = ( qbs_seri(i,k) - qx(i,k,ibs) ) / phys_tstep 6698 ENDIF 6699 6700 6607 6701 ENDDO 6608 6702 ENDDO … … 6684 6778 ql_ancien(:,:) = ql_seri(:,:) 6685 6779 qs_ancien(:,:) = qs_seri(:,:) 6780 qbs_ancien(:,:) = qbs_seri(:,:) 6686 6781 rneb_ancien(:,:) = rneb_seri(:,:) 6687 6782 #ifdef ISO … … 6693 6788 CALL water_int(klon,klev,ql_ancien,zmasse,prlw_ancien) 6694 6789 CALL water_int(klon,klev,qs_ancien,zmasse,prsw_ancien) 6790 CALL water_int(klon,klev,qbs_ancien,zmasse,prbsw_ancien) 6695 6791 ! !! RomP >>> 6696 6792 IF (nqtot > nqo) tr_ancien(:,:,:) = tr_seri(:,:,:) … … 6821 6917 CALL phys_output_write(itap, pdtphys, paprs, pphis, & 6822 6918 pplay, lmax_th, aerosol_couple, & 6823 ok_ade, ok_aie, ok_volcan, ivap, iliq, isol, &6919 ok_ade, ok_aie, ok_volcan, ivap, iliq, isol, ibs, & 6824 6920 ok_sync, ptconv, read_climoz, clevSTD, & 6825 6921 ptconvth, d_u, d_t, qx, d_qx, zmasse, & -
LMDZ6/branches/LMDZ_cdrag_LSCE/libf/phylmdiso/surf_land_mod.F90
r4285 r4669 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, & 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/branches/LMDZ_cdrag_LSCE/libf/phylmdiso/surf_landice_mod.F90
r4285 r4669 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 AcoefQBS, BcoefQBS, & 17 18 ps, u1, v1, gustiness, rugoro, pctsrf, & 18 snow, qsurf, qsol, agesno, &19 tsoil, z0m, z0h, SFRWL, alb_dir, alb_dif, evap, fluxsens, fluxlat, &19 snow, qsurf, qsol, qbs1, agesno, & 20 tsoil, z0m, z0h, SFRWL, alb_dir, alb_dif, evap, fluxsens, fluxlat, fluxbs, & 20 21 tsurf_new, dflux_s, dflux_l, & 21 22 alt, slope, cloudf, & … … 34 35 USE cpl_mod, ONLY : cpl_send_landice_fields 35 36 USE calcul_fluxs_mod 36 USE phys_output_var_mod 37 USE phys_local_var_mod, ONLY : zxrhoslic, zxustartlic 38 USE phys_output_var_mod, ONLY : snow_o,zfra_o 37 39 #ifdef ISO 38 40 USE fonte_neige_mod, ONLY : xtrun_off_lic … … 48 50 !FC 49 51 USE ioipsl_getin_p_mod, ONLY : getin_p 50 52 USE blowing_snow_ini_mod, ONLY : zeta_bs, pbst_bs, prt_bs, iflag_saltation_bs 51 53 52 54 #ifdef CPP_INLANDSIS … … 72 74 REAL, DIMENSION(klon), INTENT(IN) :: p1lay 73 75 REAL, DIMENSION(klon), INTENT(IN) :: cdragh, cdragm 74 REAL, DIMENSION(klon), INTENT(IN) :: precip_rain, precip_snow 76 REAL, DIMENSION(klon), INTENT(IN) :: precip_rain, precip_snow, precip_bs 75 77 REAL, DIMENSION(klon), INTENT(IN) :: temp_air, spechum 76 78 REAL, DIMENSION(klon), INTENT(IN) :: AcoefH, AcoefQ 77 79 REAL, DIMENSION(klon), INTENT(IN) :: BcoefH, BcoefQ 78 80 REAL, DIMENSION(klon), INTENT(IN) :: AcoefU, AcoefV, BcoefU, BcoefV 81 REAL, DIMENSION(klon), INTENT(IN) :: AcoefQBS, BcoefQBS 79 82 REAL, DIMENSION(klon), INTENT(IN) :: ps 80 REAL, DIMENSION(klon), INTENT(IN) :: u1, v1, gustiness 83 REAL, DIMENSION(klon), INTENT(IN) :: u1, v1, gustiness, qbs1 81 84 REAL, DIMENSION(klon), INTENT(IN) :: rugoro 82 85 REAL, DIMENSION(klon,nbsrf), INTENT(IN) :: pctsrf … … 118 121 !albedo SB <<< 119 122 REAL, DIMENSION(klon), INTENT(OUT) :: evap, fluxsens, fluxlat 123 REAL, DIMENSION(klon), INTENT(OUT) :: fluxbs 120 124 REAL, DIMENSION(klon), INTENT(OUT) :: tsurf_new 121 125 REAL, DIMENSION(klon), INTENT(OUT) :: dflux_s, dflux_l … … 179 183 180 184 REAL,DIMENSION(klon) :: alb1,alb2 185 REAL,DIMENSION(klon) :: precip_totsnow, evap_totsnow 181 186 REAL, DIMENSION (klon,6) :: alb6 187 REAL :: rho0, rhoice, ustart0, hsalt, esalt, rhod 188 REAL :: lambdasalt,fluxsalt, csalt, nunu, aa, bb, cc 189 REAL :: tau_dens, tau_dens0, tau_densmin, rhomax, rhohard 190 REAL, DIMENSION(klon) :: ws1, rhos, ustart, qsalt 182 191 ! End definition 183 192 !**************************************************************************************** … … 214 223 PRINT*, 'alb_nir_sno_lic',alb_nir_sno_lic 215 224 216 ! z0m=1.e-3217 ! z0h = z0m218 225 firstcall=.false. 219 226 ENDIF 220 227 !****************************************************************************************** 221 ! 228 222 229 ! Initialize output variables 223 230 alb3(:) = 999999. 224 231 alb2(:) = 999999. 225 232 alb1(:) = 999999. 226 233 fluxbs(:)=0. 227 234 runoff(:) = 0. 228 235 !**************************************************************************************** … … 232 239 radsol(:) = 0.0 233 240 radsol(1:knon) = swnet(1:knon) + lwnet(1:knon) 241 242 !**************************************************************************************** 234 243 235 244 !**************************************************************************************** … … 327 336 328 337 329 330 338 ELSE 331 339 … … 342 350 IF (soil_model) THEN 343 351 CALL soil(dtime, is_lic, knon, snow, tsurf, qsol, & 344 & longitude(knindex(1:knon)), latitude(knindex(1:knon)), tsoil, soilcap, soilflux) 345 352 & longitude(knindex(1:knon)), latitude(knindex(1:knon)), tsoil, soilcap, soilflux) 346 353 cal(1:knon) = RCPD / soilcap(1:knon) 347 354 radsol(1:knon) = radsol(1:knon) + soilflux(1:knon) … … 406 413 flux_u1, flux_v1) 407 414 408 !**************************************************************************************** 409 ! Calculate snow height, age, run-off,.. 415 416 !**************************************************************************************** 417 ! Calculate albedo 418 ! 419 !**************************************************************************************** 420 421 CALL albsno(klon,knon,dtime,agesno(:),alb_neig(:), precip_snow(:)) 422 423 424 ! EV: following lines are obsolete since we set alb1 and alb2 to constant values 425 ! I therefore comment them 426 ! alb1(1:knon) = alb_neig(1:knon)*zfra(1:knon) + & 427 ! 0.6 * (1.0-zfra(1:knon)) 428 ! 429 !IM: plusieurs choix/tests sur l'albedo des "glaciers continentaux" 430 ! alb1(1 : knon) = 0.6 !IM cf FH/GK 431 ! alb1(1 : knon) = 0.82 432 ! alb1(1 : knon) = 0.77 !211003 Ksta0.77 433 ! alb1(1 : knon) = 0.8 !KstaTER0.8 & LMD_ARMIP5 434 !IM: KstaTER0.77 & LMD_ARMIP6 435 436 ! Attantion: alb1 and alb2 are not the same! 437 alb1(1:knon) = alb_vis_sno_lic 438 alb2(1:knon) = alb_nir_sno_lic 439 440 441 !**************************************************************************************** 442 ! Rugosity 443 ! 444 !**************************************************************************************** 445 z0m = z0m_landice 446 z0h = z0h_landice 447 !z0m = SQRT(z0m**2+rugoro**2) 448 449 450 451 ! Simple blowing snow param 452 if (ok_bs) then 453 ustart0 = 0.211 454 rhoice = 920.0 455 rho0 = 200.0 456 rhomax=450.0 457 rhohard=400.0 458 tau_dens0=86400.0*10. ! 10 days by default, in s 459 tau_densmin=86400.0 ! 1 days according to in situ obs by C. Amory 460 461 ! computation of threshold friction velocity 462 ! which depends on surface snow density 463 do i = 1, knon 464 ! estimation of snow density 465 ! snow density increases with snow age and 466 ! increases even faster in case of sedimentation of blowing snow 467 tau_dens=max(tau_densmin, tau_dens0*exp(-abs(precip_bs(i))/pbst_bs-abs(precip_rain(i))/prt_bs)) 468 rhos(i)=rho0+(rhohard-rho0)*(1.-exp(-agesno(i)*86400.0/tau_dens)) 469 ! blowing snow flux formula used in MAR 470 ws1(i)=(u1(i)**2+v1(i)**2)**0.5 471 ustar(i)=(cdragm(i)*(u1(i)**2+v1(i)**2))**0.5 472 ustart(i)=ustart0*exp(max(rhoice/rho0-rhoice/rhos(i),0.))*exp(max(0.,rhos(i)-rhomax)) 473 ! we have multiplied by exp to prevent erosion when rhos>rhomax (usefull till 474 ! rhohard<450) 475 enddo 476 477 ! computation of qbs at the top of the saltation layer 478 ! two formulations possible 479 ! pay attention that qbs is a mixing ratio and has to be converted 480 ! to specific content 481 482 if (iflag_saltation_bs .eq. 1) then 483 ! expression from CRYOWRF (Sharma et al. 2022) 484 aa=2.6 485 bb=2.5 486 cc=2.0 487 lambdasalt=0.45 488 do i =1, knon 489 rhod=p1lay(i)/RD/temp_air(i) 490 nunu=max(ustar(i)/ustart(i),1.e-3) 491 fluxsalt=rhod/RG*(ustar(i)**3)*(1.-nunu**(-2)) * & 492 (aa+bb*nunu**(-2)+cc*nunu**(-1)) 493 csalt=fluxsalt/(2.8*ustart(i)) 494 hsalt=0.08436*ustar(i)**1.27 495 qsalt(i)=1./rhod*csalt*lambdasalt*RG/(max(ustar(i)**2,1E-6)) & 496 * exp(-lambdasalt*RG*hsalt/max(ustar(i)**2,1E-6)) 497 qsalt(i)=max(qsalt(i),0.) 498 enddo 499 500 501 else 502 ! default formulation from MAR model (Amory et al. 2021, Gallee et al. 2001) 503 do i=1, knon 504 esalt=1./(3.25*max(ustar(i),0.001)) 505 hsalt=0.08436*ustar(i)**1.27 506 qsalt(i)=(max(ustar(i)**2-ustart(i)**2,0.))/(RG*hsalt)*esalt 507 !ep=qsalt*cdragm(i)*sqrt(u1(i)**2+v1(i)**2) 508 enddo 509 endif 510 511 ! calculation of erosion (emission flux towards the first atmospheric level) 512 ! consistent with implicit resolution of turbulent mixing equation 513 do i=1, knon 514 rhod=p1lay(i)/RD/temp_air(i) 515 fluxbs(i)=rhod*ws1(i)*cdragm(i)*zeta_bs*(AcoefQBS(i)-qsalt(i)) & 516 / (1.-rhod*ws1(i)*zeta_bs*cdragm(i)*BcoefQBS(i)*dtime) 517 !fluxbs(i)= zeta_bs*rhod*ws1(i)*cdragm(i)*(qbs1(i)-qsalt(i)) 518 enddo 519 520 ! for outputs 521 do j = 1, knon 522 i = knindex(j) 523 zxustartlic(i) = ustart(j) 524 zxrhoslic(i) = rhos(j) 525 enddo 526 527 endif 528 529 530 531 !**************************************************************************************** 532 ! Calculate surface snow amount 410 533 ! 411 534 !**************************************************************************************** 535 IF (ok_bs) THEN 536 precip_totsnow(:)=precip_snow(:)+precip_bs(:) 537 evap_totsnow(:)=evap(:)-fluxbs(:) ! flux bs is positive towards the surface (snow erosion) 538 ELSE 539 precip_totsnow(:)=precip_snow(:) 540 evap_totsnow(:)=evap(:) 541 ENDIF 542 412 543 CALL fonte_neige(knon, is_lic, knindex, dtime, & 413 tsurf, precip_rain, precip_ snow, &414 snow, qsol, tsurf_new, evap &544 tsurf, precip_rain, precip_totsnow, & 545 snow, qsol, tsurf_new, evap_totsnow & 415 546 #ifdef ISO 416 547 & ,fq_fonte_diag,fqfonte_diag,snow_evap_diag,fqcalving_diag & … … 446 577 447 578 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 579 WHERE (snow(1 : knon) .LT. 0.0001) agesno(1 : knon) = 0. 580 zfra(1:knon) = MAX(0.0,MIN(1.0,snow(1:knon)/(snow(1:knon)+10.0))) 479 581 480 582 … … 494 596 run_off_lic_frac(j) = pctsrf(i,is_lic) 495 597 ENDDO 496 598 497 599 CALL cpl_send_landice_fields(itime, knon, knindex, run_off_lic, run_off_lic_frac) 498 600 ENDIF … … 501 603 runoff(1:knon)=run_off_lic(1:knon)/dtime 502 604 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 605 snow_o=0. 516 606 zfra_o = 0. … … 553 643 !albedo SB <<< 554 644 555 556 557 645 558 646 END SUBROUTINE surf_landice -
LMDZ6/branches/LMDZ_cdrag_LSCE/libf/phylmdiso/surf_ocean_mod.F90
r4374 r4669 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.
