- Timestamp:
- May 5, 2025, 3:02:32 PM (5 weeks ago)
- Location:
- LMDZ6/branches/contrails/libf/phylmd
- Files:
-
- 6 edited
Legend:
- Unmodified
- Added
- Removed
-
LMDZ6/branches/contrails/libf/phylmd/lmdz_cloud_optics_prop.f90
r5641 r5643 255 255 DO k = 1, klev 256 256 DO i = 1, klon 257 pclc_nocont(i,k) = pclc(i, k) - lincontfra(i, k) - circontfra(i, k)258 xfiwc_nocont(i, k) = xfiwc(i, k) - qice_lincont(i, k) - qice_circont(i, k)257 pclc_nocont(i,k) = MAX(0., pclc(i, k) - lincontfra(i, k) - circontfra(i, k)) 258 xfiwc_nocont(i, k) = MAX(0., xfiwc(i, k) - qice_lincont(i, k) - qice_circont(i, k)) 259 259 ENDDO 260 260 ENDDO -
LMDZ6/branches/contrails/libf/phylmd/lmdz_lscp.f90
r5641 r5643 123 123 USE lmdz_lscp_ini, ONLY : ok_ice_supersat, ok_unadjusted_clouds, iflag_icefrac 124 124 USE lmdz_lscp_ini, ONLY : ok_weibull_warm_clouds, ok_no_issr_strato 125 USE lmdz_lscp_ini, ONLY : ok_plane_contrail, ok_ice_sedim 125 USE lmdz_lscp_ini, ONLY : ok_plane_contrail, ok_precip_lincontrails, ok_ice_sedim 126 USE lmdz_lscp_ini, ONLY : ok_nodeep_lscp, ok_nodeep_lscp_rad 126 127 127 128 ! Temporary call for Lamquin et al (2012) diagnostics … … 335 336 ! for contrails 336 337 REAL, DIMENSION(klon) :: lincontfra, circontfra, qlincont, qcircont 337 REAL, DIMENSION(klon) :: zq_nodeep338 REAL, DIMENSION(klon) :: totfra_in, qtot_in 338 339 LOGICAL, DIMENSION(klon) :: pt_pron_clds 340 REAL :: qice_cont 339 341 !--for Lamquin et al 2012 diagnostics 340 342 REAL, DIMENSION(klon) :: issrfra100to150UP, issrfra150to200UP, issrfra200to250UP … … 670 672 ENDIF 671 673 672 zq_nodeep(:) = zq(:)673 674 674 DO i = 1, klon 675 676 675 pt_pron_clds(i) = ( ( ( ( zt(i) .LE. temp_nowater ) .OR. ok_weibull_warm_clouds ) & 677 676 .AND. ( .NOT. ok_no_issr_strato .OR. ( stratomask(i,k) .EQ. 0. ) ) ) & 678 677 .AND. ( cfcon(i,k) .LT. ( 1. - eps ) ) ) 679 680 IF ( pt_pron_clds(i) ) THEN 681 678 ENDDO 679 680 totfra_in(:) = 1. 681 qtot_in(:) = zq(:) 682 683 IF ( ok_nodeep_lscp ) THEN 684 DO i = 1, klon 682 685 !--If deep convection is activated, the condensation scheme activates 683 686 !--only in the environment. NB. the clear sky fraction will the be 684 687 !--maximised by 1. - cfcon(i,k) 685 IF ( ptconv(i,k) ) & 686 zq_nodeep(i) = zq(i) - ( qvcon(i,k) + qccon(i,k) ) * cfcon(i,k) 687 688 IF ( pt_pron_clds(i) .AND. ptconv(i,k) ) THEN 689 totfra_in(i) = 1. - cfcon(i,k) 690 qtot_in(i) = zq(i) - ( qvcon(i,k) + qccon(i,k) ) * cfcon(i,k) 691 ENDIF 692 ENDDO 693 ENDIF 694 695 DO i = 1, klon 696 IF ( pt_pron_clds(i) ) THEN 688 697 IF ( cfcon(i,k) .LT. cfcon_old(i,k) ) THEN 689 698 !--If deep convection is weakening, we add the clouds that are not anymore … … 704 713 705 714 !--Barriers 706 cldfra_in(i) = MAX(0., MIN( 1. - cfcon(i,k), cldfra_in(i)))707 qvc_in(i) = MAX(0., MIN( zq_nodeep(i), qvc_in(i)))708 qice_in(i) = MAX(0., MIN( zq_nodeep(i) - qvc_in(i), qice_in(i)))715 cldfra_in(i) = MAX(0., MIN(totfra_in(i), cldfra_in(i))) 716 qvc_in(i) = MAX(0., MIN(qtot_in(i), qvc_in(i))) 717 qice_in(i) = MAX(0., MIN(qtot_in(i) - qvc_in(i), qice_in(i))) 709 718 710 719 !--Calculate the shear value (input for condensation and ice supersat) … … 811 820 CALL condensation_ice_supersat( & 812 821 klon, dtime, pplay(:,k), paprs(:,k), paprs(:,k+1), & 813 cfcon(:,k), cldfra_in, qvc_in, qliq_in, qice_in, &814 shear, tke_dissip(:,k), cell_area, Tbef, zq_nodeep, zqs, &822 totfra_in, cldfra_in, qvc_in, qliq_in, qice_in, & 823 shear, tke_dissip(:,k), cell_area, Tbef, qtot_in, zqs, & 815 824 gammasat, ratqs(:,k), keepgoing, pt_pron_clds, & 816 825 cldfra_above, icesed_flux,& … … 830 839 dcfc_mix(:,k), dqic_mix(:,k), dqtc_mix(:,k)) 831 840 832 DO i = 1, klon 833 !--If prognostic clouds are activated, deep convection vapor is 834 !--re-added to the total water vapor 835 IF ( keepgoing(i) .AND. ptconv(i,k) .AND. pt_pron_clds(i) ) THEN 836 IF ( ( rneb(i,k) + cfcon(i,k) ) .GT. eps ) THEN 837 zqn(i) = ( zqn(i) * rneb(i,k) + qccon(i,k) * cfcon(i,k) ) & 838 / ( rneb(i,k) + cfcon(i,k) ) 839 ELSE 840 zqn(i) = 0. 841 IF ( ok_nodeep_lscp ) THEN 842 DO i = 1, klon 843 !--If prognostic clouds are activated, deep convection vapor is 844 !--re-added to the total water vapor 845 IF ( keepgoing(i) .AND. ptconv(i,k) .AND. pt_pron_clds(i) ) THEN 846 IF ( ( rneb(i,k) + cfcon(i,k) ) .GT. eps ) THEN 847 zqn(i) = ( zqn(i) * rneb(i,k) & 848 + ( qccon(i,k) + qvcon(i,k) ) * cfcon(i,k) ) & 849 / ( rneb(i,k) + cfcon(i,k) ) 850 ELSE 851 zqn(i) = 0. 852 ENDIF 853 rneb(i,k) = rneb(i,k) + cfcon(i,k) 854 qvc(i) = qvc(i) + qvcon(i,k) * cfcon(i,k) 841 855 ENDIF 842 rneb(i,k) = rneb(i,k) + cfcon(i,k) 843 qvc(i) = qvc(i) + qvcon(i,k) * cfcon(i,k) 844 ENDIF 845 ENDDO 856 ENDDO 857 ENDIF 846 858 847 859 ELSE … … 952 964 !------------------------------------------------------------------------ 953 965 DO i=1, klon 966 954 967 ! Overwrite phase partitioning in boundary layer mixed phase clouds when the 955 968 ! iflag_cloudth_vert=7 and specific param is activated … … 1056 1069 !--between natural clouds and contrails 1057 1070 !--NB. we use qlincont / qcircont as a temporary variable to save this partition 1071 IF ( ok_precip_lincontrails ) THEN 1072 DO i = 1, klon 1073 IF ( zoliqi(i) .GT. 0. ) THEN 1074 qlincont(i) = ( qlincont(i) - zqs(i) * lincontfra(i) ) / zoliqi(i) 1075 ELSE 1076 qlincont(i) = 0. 1077 ENDIF 1078 ENDDO 1079 ELSE 1080 !--If linear contrails do not precipitate, they are removed temporarily from 1081 !--the cloud variables 1082 DO i = 1, klon 1083 qice_cont = qlincont(i) - zqs(i) * lincontfra(i) 1084 rneb(i,k) = rneb(i,k) - lincontfra(i) 1085 zoliq(i) = zoliq(i) - qice_cont 1086 zoliqi(i) = zoliqi(i) - qice_cont 1087 ENDDO 1088 ENDIF 1089 1058 1090 DO i = 1, klon 1059 dcf_sub(i,k) = lincontfra(i)1060 dqi_sub(i,k) = qlincont(i)1061 1091 IF ( zoliqi(i) .GT. 0. ) THEN 1062 qlincont(i) = ( qlincont(i) - zqs(i) * lincontfra(i) ) / zoliqi(i)1063 1092 qcircont(i) = ( qcircont(i) - zqs(i) * circontfra(i) ) / zoliqi(i) 1064 1093 ELSE 1065 qlincont(i) = 0.1066 1094 qcircont(i) = 0. 1067 1095 ENDIF … … 1102 1130 ENDIF ! ok_poprecip 1103 1131 1104 IF ( ok_plane_contrail) THEN1132 IF ( ok_plane_contrail ) THEN 1105 1133 !--Contrails fraction is left unchanged, but contrails water has changed 1134 !--We alse compute the ice content that will be seen by radiation (qice_lincont/circont) 1135 IF ( ok_precip_lincontrails ) THEN 1136 DO i = 1, klon 1137 IF ( zoliqi(i) .GT. 0. ) THEN 1138 qice_lincont(i,k) = zradocond(i) * qlincont(i) 1139 qlincont(i) = zqs(i) * lincontfra(i) + zoliqi(i) * qlincont(i) 1140 ELSE 1141 qice_lincont(i,k) = 0. 1142 lincontfra(i) = 0. 1143 qlincont(i) = 0. 1144 ENDIF 1145 ENDDO 1146 ELSE 1147 !--If linear contrails do not precipitate, they are put back into 1148 !--the cloud variables 1149 DO i = 1, klon 1150 qice_cont = qlincont(i) - zqs(i) * lincontfra(i) 1151 rneb(i,k) = rneb(i,k) + lincontfra(i) 1152 zoliq(i) = zoliq(i) + qice_cont 1153 zoliqi(i) = zoliqi(i) + qice_cont 1154 zradocond(i) = zradocond(i) + qice_cont 1155 zradoice(i) = zradoice(i) + qice_cont 1156 qice_lincont(i,k) = qice_cont 1157 ENDDO 1158 ENDIF 1159 1106 1160 DO i = 1, klon 1107 1161 IF ( zoliqi(i) .GT. 0. ) THEN 1108 q lincont(i) = zqs(i) * lincontfra(i) + zoliqi(i) * qlincont(i)1162 qice_circont(i,k) = zradocond(i) * qcircont(i) 1109 1163 qcircont(i) = zqs(i) * circontfra(i) + zoliqi(i) * qcircont(i) 1110 1164 ELSE 1111 lincontfra(i) = 0.1165 qice_circont(i,k) = 0. 1112 1166 circontfra(i) = 0. 1113 qlincont(i) = 0.1114 1167 qcircont(i) = 0. 1115 1168 ENDIF … … 1215 1268 qtl_seri(:,k) = qlincont(:) 1216 1269 qtc_seri(:,k) = qcircont(:) 1217 DO i = 1, klon1218 IF ( zoliqi(i) .GT. 0. ) THEN1219 !--The ice water content seen by radiation is higher than the actual ice1220 !--water content. We take into account this difference1221 qice_lincont(i,k) = ( qlincont(i) - zqs(i) * lincontfra(i) ) &1222 / zoliqi(i) * radocond(i,k)1223 qice_circont(i,k) = ( qcircont(i) - zqs(i) * circontfra(i) ) &1224 / zoliqi(i) * radocond(i,k)1225 ELSE1226 qice_lincont(i,k) = 0.1227 qice_circont(i,k) = 0.1228 ENDIF1229 ENDDO1230 1270 ENDIF 1231 1271 … … 1243 1283 IF ( zoliq(i) .GT. 0. ) THEN 1244 1284 qvcon_old(i,k) = qvcon(i,k) 1245 qccon_old(i,k) = qccon(i,k) * z cond(i) / zoliq(i)1285 qccon_old(i,k) = qccon(i,k) * zoliq(i) / zcond(i) 1246 1286 ELSE 1247 1287 qvcon_old(i,k) = 0. … … 1257 1297 !--properties and are NOT prognostics) 1258 1298 !--We must have iflag_coupl == 5 for this coupling to work 1259 IF ( ptconv(i,k) .AND. pt_pron_clds(i) ) THEN1299 IF ( ptconv(i,k) .AND. pt_pron_clds(i) .AND. ok_nodeep_lscp_rad ) THEN 1260 1300 rneb(i,k) = rneb(i,k) - cfcon(i,k) 1261 1301 radocond(i,k) = radocond(i,k) - qccon_old(i,k) * cfcon(i,k) -
LMDZ6/branches/contrails/libf/phylmd/lmdz_lscp_condensation.f90
r5642 r5643 94 94 !********************************************************************************** 95 95 SUBROUTINE condensation_ice_supersat( & 96 klon, dtime, pplay, paprsdn, paprsup, cfcon, &96 klon, dtime, pplay, paprsdn, paprsup, totfra_in, & 97 97 cldfra_in, qvc_in, qliq_in, qice_in, shear, pbl_eps, cell_area, & 98 98 temp, qtot_in, qsat, gamma_cond, ratqs, keepgoing, pt_pron_clds, & … … 148 148 REAL, INTENT(IN) , DIMENSION(klon) :: paprsdn ! pressure at the lower interface [Pa] 149 149 REAL, INTENT(IN) , DIMENSION(klon) :: paprsup ! pressure at the upper interface [Pa] 150 REAL, INTENT(IN) , DIMENSION(klon) :: cfcon ! cloud fraction from deep convection[-]150 REAL, INTENT(IN) , DIMENSION(klon) :: totfra_in ! total available fraction for stratiform clouds [-] 151 151 REAL, INTENT(IN) , DIMENSION(klon) :: cldfra_in ! cloud fraction [-] 152 152 REAL, INTENT(IN) , DIMENSION(klon) :: qvc_in ! gridbox-mean water vapor in cloud [kg/kg] … … 273 273 REAL :: cldfra_mix, clrfra_mix, sigma_mix 274 274 REAL :: L_shear, shear_fra 275 REAL :: q iceinmix, qvapinmix_lim, qvapinclr_lim275 REAL :: qvapinmix, qiceinmix, qvapinmix_lim, qvapinclr_lim 276 276 REAL :: pdf_fra_above_nuc, pdf_q_above_nuc 277 277 REAL :: pdf_fra_above_lim, pdf_q_above_lim … … 348 348 !--are consistent. In some rare cases, i.e. the cloud water vapor 349 349 !--can be greater than the total water in the gridbox 350 cldfra(i) = MAX(0., MIN( 1. - cfcon(i), cldfra_in(i)))350 cldfra(i) = MAX(0., MIN(totfra_in(i), cldfra_in(i))) 351 351 qcld(i) = MAX(0., MIN(qtot_in(i), qliq_in(i) + qice_in(i) + qvc_in(i))) 352 352 qvc(i) = MAX(0., MIN(qcld(i), qvc_in(i))) 353 353 354 354 !--Initialise clear fraction properties 355 clrfra(i) = MAX(0., MIN(1., ( 1. - cfcon(i) ) - cldfra(i)))355 clrfra(i) = totfra_in(i) - cldfra(i) 356 356 qclr(i) = qtot_in(i) - qcld(i) 357 357 … … 519 519 !--If there is a linear contrail 520 520 IF ( lincontfra(i) .GT. eps ) THEN 521 !--We remove contrails from the main class522 cldfra(i) = cldfra(i) - lincontfra(i)523 qcld(i) = qcld(i) - qlincont(i)524 qvc(i) = qvc(i) - qsat(i) * lincontfra(i)525 521 526 522 !--The contrail is always adjusted to saturation 527 523 qiceincld = ( qlincont(i) / lincontfra(i) - qsat(i) ) 528 529 524 !--If the ice water content is too low, the cloud is purely sublimated 530 IF ( qiceincld .LT. eps) THEN525 IF ( qiceincld .LT. qiceincld_min ) THEN 531 526 dcfl_sub(i) = - lincontfra(i) 532 527 dqil_sub(i) = - qiceincld * lincontfra(i) … … 534 529 lincontfra(i) = 0. 535 530 qlincont(i) = 0. 536 clrfra(i) = MIN( 1., clrfra(i) - dcfl_sub(i))531 clrfra(i) = MIN(totfra_in(i), clrfra(i) - dcfl_sub(i)) 537 532 qclr(i) = qclr(i) - dqtl_sub(i) 538 533 ENDIF ! qiceincld .LT. eps 534 535 !--We remove contrails from the main class 536 cldfra(i) = MAX(0., cldfra(i) - lincontfra(i)) 537 qcld(i) = MAX(0., qcld(i) - qlincont(i)) 538 qvc(i) = MAX(0., qvc(i) - qsat(i) * lincontfra(i)) 539 539 ENDIF ! lincontfra(i) .GT. eps 540 540 541 541 !--If there is a contrail cirrus 542 542 IF ( circontfra(i) .GT. eps ) THEN 543 !--We remove contrails from the main class544 cldfra(i) = cldfra(i) - circontfra(i)545 qcld(i) = qcld(i) - qcircont(i)546 qvc(i) = qvc(i) - qsat(i) * circontfra(i)547 543 548 544 !--The contrail is always adjusted to saturation 549 545 qiceincld = ( qcircont(i) / circontfra(i) - qsat(i) ) 550 551 546 !--If the ice water content is too low, the cloud is purely sublimated 552 IF ( qiceincld .LT. eps) THEN547 IF ( qiceincld .LT. qiceincld_min ) THEN 553 548 dcfc_sub(i) = - circontfra(i) 554 549 dqic_sub(i) = - qiceincld * circontfra(i) … … 556 551 circontfra(i) = 0. 557 552 qcircont(i) = 0. 558 clrfra(i) = MIN( 1., clrfra(i) - dcfc_sub(i))553 clrfra(i) = MIN(totfra_in(i), clrfra(i) - dcfc_sub(i)) 559 554 qclr(i) = qclr(i) - dqtc_sub(i) 560 555 ENDIF ! qiceincld .LT. eps 556 557 !--We remove contrails from the main class 558 cldfra(i) = MAX(0., cldfra(i) - circontfra(i)) 559 qcld(i) = MAX(0., qcld(i) - qcircont(i)) 560 qvc(i) = MAX(0., qvc(i) - qsat(i) * circontfra(i)) 561 561 ENDIF ! circontfra(i) .GT. eps 562 562 … … 587 587 qcld(i) = 0. 588 588 qvc(i) = 0. 589 clrfra(i) = MIN( 1., clrfra(i) - dcf_sub(i))589 clrfra(i) = MIN(totfra_in(i), clrfra(i) - dcf_sub(i)) 590 590 qclr(i) = qclr(i) - dqvc_sub(i) - dqi_sub(i) 591 591 … … 656 656 qcld(i) = qcld(i) + dqvc_sub(i) + dqi_sub(i) 657 657 qvc(i) = qvc(i) + dqvc_sub(i) 658 clrfra(i) = MIN( 1., clrfra(i) - dcf_sub(i))658 clrfra(i) = MIN(totfra_in(i), clrfra(i) - dcf_sub(i)) 659 659 qclr(i) = qclr(i) - dqvc_sub(i) - dqi_sub(i) 660 660 ELSEIF ( qvapincld_new .EQ. 0. ) THEN … … 671 671 qcld(i) = 0. 672 672 qvc(i) = 0. 673 clrfra(i) = MIN( 1., clrfra(i) - dcf_sub(i))673 clrfra(i) = MIN(totfra_in(i), clrfra(i) - dcf_sub(i)) 674 674 qclr(i) = qclr(i) - dqvc_sub(i) - dqi_sub(i) 675 675 ENDIF ! qvapincld_new .GT. qvapincld … … 788 788 789 789 !--Add tendencies 790 cldfra(i) = MIN(1., cldfra(i) + dcf_con(i))790 cldfra(i) = cldfra(i) + dcf_con(i) 791 791 qcld(i) = qcld(i) + dqt_con 792 792 qvc(i) = qvc(i) + dqvc_con(i) 793 clrfra(i) = MAX(0., clrfra(i) - dcf_con(i))793 clrfra(i) = clrfra(i) - dcf_con(i) 794 794 qclr(i) = qclr(i) - dqt_con 795 795 … … 892 892 !-- PART 3 - CALCULATION OF THE MIXING PROPERTIES 893 893 894 clrfra_mix = M AX(eps, MIN(clrfra(i), clrfra_mix))895 cldfra_mix = M AX(eps, MIN(cldfra(i), cldfra_mix))894 clrfra_mix = MIN(clrfra(i), clrfra_mix) 895 cldfra_mix = MIN(cldfra(i), cldfra_mix) 896 896 897 897 !--We compute the limit vapor in clear sky where the mixed cloud could not … … 1060 1060 !-- PART 3 - CALCULATION OF THE MIXING PROPERTIES 1061 1061 1062 clrfra_mix = M AX(eps, MIN(clrfra(i), clrfra_mix))1063 cldfra_mix = M AX(eps, MIN(cldfra(i), cldfra_mix))1062 clrfra_mix = MIN(clrfra(i), clrfra_mix) 1063 cldfra_mix = MIN(lincontfra(i), cldfra_mix) 1064 1064 1065 1065 !--We compute the limit vapor in clear sky where the mixed cloud could not … … 1074 1074 IF ( qvapinclr_lim .LT. 0. ) THEN 1075 1075 !--Whatever we do, the cloud will increase in size 1076 dcfl_mix(i) = clrfra_mix 1077 dqtl_mix(i) = clrfra_mix * qclr(i) / clrfra(i) 1076 !--If the linear contrail increases in size, the increment is considered 1077 !--to be a contrail cirrus 1078 dcfc_mix(i) = dcfc_mix(i) + clrfra_mix 1079 dqtc_mix(i) = dqtc_mix(i) + clrfra_mix * qclr(i) / clrfra(i) 1080 dqic_mix(i) = dqic_mix(i) + clrfra_mix * sigma_mix & 1081 * ( qclr(i) / clrfra(i) - qsat(i) ) 1078 1082 ELSE 1079 1083 !--We then calculate the clear sky part where the humidity is lower than … … 1116 1120 1117 1121 IF ( pdf_fra_above_lim .GT. eps ) THEN 1118 dcfl_mix(i) = clrfra_mix * sigma_mix 1119 dqtl_mix(i) = clrfra_mix * sigma_mix * pdf_q_above_lim / pdf_fra_above_lim 1122 !--If the linear contrail increases in size, the increment is considered 1123 !--to be a contrail cirrus 1124 qvapinmix = ( pdf_q_above_lim / pdf_fra_above_lim * clrfra_mix & 1125 + qlincont(i) / lincontfra(i) * cldfra_mix ) & 1126 / ( clrfra_mix + cldfra_mix ) 1127 qiceinmix = ( qlincont(i) / lincontfra(i) - qsat(i) ) * cldfra_mix & 1128 / ( clrfra_mix + cldfra_mix ) 1129 dcfc_mix(i) = dcfc_mix(i) + clrfra_mix * sigma_mix 1130 dqtc_mix(i) = dqtc_mix(i) + clrfra_mix * sigma_mix * qvapinmix 1131 dqtl_mix(i) = dqtl_mix(i) - cldfra_mix * sigma_mix & 1132 * ( qlincont(i) / lincontfra(i) - qvapinmix ) 1133 dqic_mix(i) = dqic_mix(i) + clrfra_mix * sigma_mix * qiceinmix 1134 dqil_mix(i) = dqil_mix(i) - cldfra_mix * sigma_mix & 1135 * ( qlincont(i) / lincontfra(i) - qsat(i) - qiceinmix ) 1120 1136 ENDIF 1121 1137 1122 1138 IF ( pdf_fra_below_lim .GT. eps ) THEN 1123 qvapincld = qlincont(i) / lincontfra(i)1124 qiceincld = qvapincld - qsat(i)1125 1139 dcfl_mix(i) = dcfl_mix(i) - cldfra_mix * ( 1. - sigma_mix ) 1126 dqtl_mix(i) = dqtl_mix(i) - cldfra_mix * ( 1. - sigma_mix ) * qvapincld 1127 dqil_mix(i) = dqil_mix(i) - cldfra_mix * ( 1. - sigma_mix ) * qiceincld 1140 dqtl_mix(i) = dqtl_mix(i) - cldfra_mix * ( 1. - sigma_mix ) & 1141 * qlincont(i) / lincontfra(i) 1142 dqil_mix(i) = dqil_mix(i) - cldfra_mix * ( 1. - sigma_mix ) & 1143 * ( qlincont(i) / lincontfra(i) - qsat(i) ) 1128 1144 ENDIF 1129 1145 … … 1214 1230 !-- PART 3 - CALCULATION OF THE MIXING PROPERTIES 1215 1231 1216 clrfra_mix = M AX(eps, MIN(clrfra(i), clrfra_mix))1217 cldfra_mix = M AX(eps, MIN(cldfra(i), cldfra_mix))1232 clrfra_mix = MIN(clrfra(i), clrfra_mix) 1233 cldfra_mix = MIN(circontfra(i), cldfra_mix) 1218 1234 1219 1235 !--We compute the limit vapor in clear sky where the mixed cloud could not … … 1228 1244 IF ( qvapinclr_lim .LT. 0. ) THEN 1229 1245 !--Whatever we do, the cloud will increase in size 1230 dcfc_mix(i) = clrfra_mix 1231 dqtc_mix(i) = clrfra_mix * qclr(i) / clrfra(i) 1246 dcfc_mix(i) = dcfc_mix(i) + clrfra_mix 1247 dqtc_mix(i) = dqtc_mix(i) + clrfra_mix * qclr(i) / clrfra(i) 1248 dqic_mix(i) = dqic_mix(i) + clrfra_mix * sigma_mix & 1249 * ( qclr(i) / clrfra(i) - qsat(i) ) 1232 1250 ELSE 1233 1251 !--We then calculate the clear sky part where the humidity is lower than … … 1267 1285 1268 1286 IF ( pdf_fra_above_lim .GT. eps ) THEN 1269 dcfc_mix(i) = clrfra_mix * sigma_mix 1270 dqtc_mix(i) = clrfra_mix * sigma_mix * pdf_q_above_lim / pdf_fra_above_lim 1287 dcfc_mix(i) = dcfc_mix(i) + clrfra_mix * sigma_mix 1288 dqtc_mix(i) = dqtc_mix(i) + clrfra_mix * sigma_mix & 1289 * pdf_q_above_lim / pdf_fra_above_lim 1290 dqic_mix(i) = dqic_mix(i) + clrfra_mix * sigma_mix & 1291 * ( pdf_q_above_lim / pdf_fra_above_lim - qsat(i) ) 1271 1292 ENDIF 1272 1293 1273 1294 IF ( pdf_fra_below_lim .GT. eps ) THEN 1274 qvapincld = qcircont(i) / circontfra(i)1275 qiceincld = qvapincld - qsat(i)1276 1295 dcfc_mix(i) = dcfc_mix(i) - cldfra_mix * ( 1. - sigma_mix ) 1277 dqtc_mix(i) = dqtc_mix(i) - cldfra_mix * ( 1. - sigma_mix ) * qvapincld 1278 dqic_mix(i) = dqic_mix(i) - cldfra_mix * ( 1. - sigma_mix ) * qiceincld 1296 dqtc_mix(i) = dqtc_mix(i) - cldfra_mix * ( 1. - sigma_mix ) & 1297 * qcircont(i) / circontfra(i) 1298 dqic_mix(i) = dqic_mix(i) - cldfra_mix * ( 1. - sigma_mix ) & 1299 * ( qcircont(i) / circontfra(i) - qsat(i) ) 1279 1300 ENDIF 1280 1301 … … 1385 1406 1386 1407 !--Add tendencies 1387 cldfra(i) = MIN( 1., cldfra(i) + dcf_sed(i))1408 cldfra(i) = MIN(totfra_in(i), cldfra(i) + dcf_sed(i)) 1388 1409 qcld(i) = qcld(i) + dqvc_sed(i) + dqi_sed(i) 1389 1410 qvc(i) = qvc(i) + dqvc_sed(i) … … 1395 1416 1396 1417 1418 !--We put back contrails in the clouds class 1397 1419 IF ( ( lincontfra(i) + circontfra(i) ) .GT. 0. ) THEN 1398 !--We put back contrails in the clouds class1399 1420 cldfra(i) = cldfra(i) + lincontfra(i) + circontfra(i) 1400 1421 qcld(i) = qcld(i) + qlincont(i) + qcircont(i) … … 1435 1456 !------------------------------------------- 1436 1457 1458 cldfra(i) = MIN(cldfra(i), totfra_in(i)) 1459 qcld(i) = MIN(qcld(i), qtot_in(i)) 1460 qvc(i) = MIN(qvc(i), qcld(i)) 1461 1437 1462 IF ( cldfra(i) .LT. eps ) THEN 1438 1463 !--If the cloud is too small, it is sublimated. … … 1484 1509 1485 1510 !--Convert existing contrail fraction into "natural" cirrus cloud fraction 1486 IF ( cldfra(i) .GE. ( 1. - cfcon(i) - eps ) ) THEN 1487 contrails_conversion_factor = 1. 1488 ELSEIF ( lincontfra(i) .LT. 1.e-6 ) THEN 1511 IF ( ( cldfra(i) .GE. ( totfra_in(i) - eps ) ) .OR. ( lincontfra(i) .LE. eps ) ) THEN 1489 1512 contrails_conversion_factor = 1. 1490 1513 ELSE … … 1495 1518 !--cannot exist. The exponent is set so that this only happens for 1496 1519 !--very cloudy gridboxes 1497 * ( 1. - cldfra(i) / ( 1. - cfcon(i)) )**0.1 )1520 * ( 1. - cldfra(i) / totfra_in(i) )**0.1 ) 1498 1521 ENDIF 1499 1522 dcfl_cir(i) = - contrails_conversion_factor * lincontfra(i) 1500 1523 dqtl_cir(i) = - contrails_conversion_factor * qlincont(i) 1501 1524 1502 dcfl_ini(i) = MIN(MIN(dcfl_ini(i), issrfra(i)), 1. - cfcon(i) - cldfra(i))1525 dcfl_ini(i) = MIN(MIN(dcfl_ini(i), issrfra(i)), totfra_in(i) - cldfra(i)) 1503 1526 dqtl_ini(i) = MIN(MIN(dqtl_ini(i), qissr(i)), qtot_in(i) - qcld(i)) 1504 1527 … … 1511 1534 cldfra(i) = cldfra(i) + dcfl_ini(i) 1512 1535 qcld(i) = qcld(i) + dqtl_ini(i) 1513 qvc(i) = MIN(qcld(i), qvc(i) + dcfl_ini(i) * qsat(i))1536 qvc(i) = qvc(i) + dcfl_ini(i) * qsat(i) 1514 1537 lincontfra(i) = lincontfra(i) + dcfl_cir(i) + dcfl_ini(i) 1515 1538 qlincont(i) = qlincont(i) + dqtl_cir(i) + dqtl_ini(i) … … 1540 1563 !------------------------------------------- 1541 1564 1565 cldfra(i) = MIN(cldfra(i), totfra_in(i)) 1566 qcld(i) = MIN(qcld(i), qtot_in(i)) 1567 qvc(i) = MIN(qvc(i), qcld(i)) 1568 1542 1569 IF ( cldfra(i) .LT. eps ) THEN 1543 1570 !--If the cloud is too small, it is sublimated. … … 1554 1581 ENDIF ! cldfra .LT. eps 1555 1582 1556 IF ( lincontfra(i) .LT. eps) THEN1583 IF ( (lincontfra(i) .LT. eps) .OR. (qlincont(i) .LT. (qsat(i) * lincontfra(i))) ) THEN 1557 1584 lincontfra(i) = 0. 1558 1585 qlincont(i) = 0. 1559 1586 ENDIF 1560 1587 1561 IF ( circontfra(i) .LT. eps) THEN1588 IF ( (circontfra(i) .LT. eps) .OR. (qcircont(i) .LT. (qsat(i) * circontfra(i))) ) THEN 1562 1589 circontfra(i) = 0. 1563 1590 qcircont(i) = 0. -
LMDZ6/branches/contrails/libf/phylmd/lmdz_lscp_ini.f90
r5641 r5643 162 162 !$OMP THREADPRIVATE(ok_weibull_warm_clouds) 163 163 164 LOGICAL, SAVE, PROTECTED :: ok_nodeep_lscp=.FALSE. ! if True, the deep convection clouds are removed from the lscp calculations 165 !$OMP THREADPRIVATE(ok_nodeep_lscp) 166 167 LOGICAL, SAVE, PROTECTED :: ok_nodeep_lscp_rad=.FALSE. ! if True, the deep convection clouds are not accounted two times in radiative transfer 168 !$OMP THREADPRIVATE(ok_nodeep_lscp_rad) 169 164 170 REAL, SAVE, PROTECTED :: ffallv_issr ! tuning coefficient crystal fall velocity, cirrus clouds (with ISSR) 165 171 !$OMP THREADPRIVATE(ffallv_issr) … … 221 227 LOGICAL, SAVE, PROTECTED :: ok_plane_contrail ! activates the contrails parameterisation 222 228 !$OMP THREADPRIVATE(ok_plane_contrail) 229 230 LOGICAL, SAVE, PROTECTED :: ok_precip_lincontrails=.TRUE. ! if True, linear contrails can precipitate 231 !$OMP THREADPRIVATE(ok_precip_lincontrails) 223 232 224 233 REAL, SAVE, PROTECTED :: aspect_ratio_lincontrails=.1 ! [-] aspect ratio of linear contrails … … 482 491 CALL getin_p('ok_unadjusted_clouds',ok_unadjusted_clouds) 483 492 CALL getin_p('ok_weibull_warm_clouds',ok_weibull_warm_clouds) 493 CALL getin_p('ok_nodeep_lscp',ok_nodeep_lscp) 494 CALL getin_p('ok_nodeep_lscp_rad',ok_nodeep_lscp_rad) 484 495 ffallv_issr=ffallv_lsc 485 496 CALL getin_p('ffallv_issr',ffallv_issr) … … 501 512 CALL getin_p('coef_shear_lscp',coef_shear_lscp) 502 513 ! for aviation 514 CALL getin_p('ok_precip_lincontrails',ok_precip_lincontrails) 503 515 CALL getin_p('aspect_ratio_lincontrails',aspect_ratio_lincontrails) 504 516 coef_mixing_lincontrails=coef_mixing_lscp … … 583 595 WRITE(lunout,*) 'lscp_ini, ok_unadjusted_clouds:', ok_unadjusted_clouds 584 596 WRITE(lunout,*) 'lscp_ini, ok_weibull_warm_clouds:', ok_weibull_warm_clouds 597 WRITE(lunout,*) 'lscp_ini, ok_nodeep_lscp:', ok_nodeep_lscp 598 WRITE(lunout,*) 'lscp_ini, ok_nodeep_lscp_rad:', ok_nodeep_lscp_rad 585 599 WRITE(lunout,*) 'lscp_ini, ffallv_issr', ffallv_issr 586 600 WRITE(lunout,*) 'lscp_ini, cooling_rate_ice_thresh', cooling_rate_ice_thresh … … 601 615 WRITE(lunout,*) 'lscp_ini, coef_shear_lscp:', coef_shear_lscp 602 616 ! for aviation 617 WRITE(lunout,*) 'lscp_ini, ok_precip_lincontrails:', ok_precip_lincontrails 603 618 WRITE(lunout,*) 'lscp_ini, aspect_ratio_lincontrails:', aspect_ratio_lincontrails 604 619 WRITE(lunout,*) 'lscp_ini, coef_mixing_lincontrails:', coef_mixing_lincontrails -
LMDZ6/branches/contrails/libf/phylmd/phys_local_var_mod.F90
r5641 r5643 705 705 REAL, SAVE, ALLOCATABLE :: fiwp_nocont(:), fiwc_nocont(:,:), ref_ice_nocont(:,:) 706 706 !$OMP THREADPRIVATE(fiwp_nocont, fiwc_nocont, ref_ice_nocont) 707 REAL, SAVE, ALLOCATABLE :: topsw_nocont(:), solsw_nocont(:) 708 !$OMP THREADPRIVATE(topsw_nocont, solsw_nocont) 709 REAL, SAVE, ALLOCATABLE :: toplw_nocont(:), sollw_nocont(:) 710 !$OMP THREADPRIVATE(toplw_nocont, sollw_nocont) 707 REAL, SAVE, ALLOCATABLE :: topsw_nocont(:), toplw_nocont(:) 708 !$OMP THREADPRIVATE(topsw_nocont, toplw_nocont) 709 REAL, SAVE, ALLOCATABLE :: solsw_nocont(:), sollw_nocont(:) 710 !$OMP THREADPRIVATE(solsw_nocont, sollw_nocont) 711 REAL, SAVE, ALLOCATABLE :: topsw_nocontp(:), toplw_nocontp(:) 712 !$OMP THREADPRIVATE(topsw_nocontp, toplw_nocontp) 713 REAL, SAVE, ALLOCATABLE :: solsw_nocontp(:), sollw_nocontp(:) 714 !$OMP THREADPRIVATE(solsw_nocontp, sollw_nocontp) 711 715 712 716 !-- LSCP - mixed phase clouds variables … … 1277 1281 ALLOCATE(cldh_nocont(klon), contcov(klon), conttau(klon,klev), contemi(klon,klev)) 1278 1282 ALLOCATE(fiwp_nocont(klon), fiwc_nocont(klon,klev), ref_ice_nocont(klon,klev)) 1279 ALLOCATE(topsw_nocont(klon), solsw_nocont(klon)) 1280 ALLOCATE(toplw_nocont(klon), sollw_nocont(klon)) 1283 ALLOCATE(topsw_nocont(klon), toplw_nocont(klon)) 1284 ALLOCATE(solsw_nocont(klon), sollw_nocont(klon)) 1285 ALLOCATE(topsw_nocontp(klon), toplw_nocontp(klon)) 1286 ALLOCATE(solsw_nocontp(klon), sollw_nocontp(klon)) 1281 1287 1282 1288 !-- LSCP - POPRECIP variables … … 1693 1699 DEALLOCATE(cldfra_nocont, cldtau_nocont, cldemi_nocont, conttau, contemi) 1694 1700 DEALLOCATE(cldh_nocont, contcov, fiwp_nocont, fiwc_nocont, ref_ice_nocont) 1695 DEALLOCATE(topsw_nocont, solsw_nocont, toplw_nocont, sollw_nocont) 1701 DEALLOCATE(topsw_nocont, toplw_nocont) 1702 DEALLOCATE(solsw_nocont, sollw_nocont) 1703 DEALLOCATE(topsw_nocontp, toplw_nocontp) 1704 DEALLOCATE(solsw_nocontp, sollw_nocontp) 1696 1705 1697 1706 !-- LSCP - POPRECIP variables -
LMDZ6/branches/contrails/libf/phylmd/physiq_mod.F90
r5641 r5643 338 338 cldfra_nocont, cldtau_nocont, cldemi_nocont, cldh_nocont, & 339 339 conttau, contemi, contcov, fiwp_nocont, fiwc_nocont, ref_ice_nocont, & 340 topsw_nocont, solsw_nocont, toplw_nocont, sollw_nocont, & 340 topsw_nocont, toplw_nocont, solsw_nocont, sollw_nocont, & 341 topsw_nocontp, toplw_nocontp, solsw_nocontp, sollw_nocontp, & 341 342 ! 342 343 stratomask, & … … 4830 4831 !--AB contrails radiative effects 4831 4832 cldfrarad_nocont, fiwc_nocont, ref_ice_nocont, & 4832 topsw_nocont , solsw_nocont, toplw_nocont, sollw_nocont)4833 topsw_nocontp, solsw_nocontp, toplw_nocontp, sollw_nocontp) 4833 4834 ENDIF !ok_4xCO2atm 4834 4835
Note: See TracChangeset
for help on using the changeset viewer.