Changeset 5796 for LMDZ6/branches/contrails/libf/phylmd/lmdz_lscp_main.f90
- Timestamp:
- Aug 4, 2025, 3:03:07 PM (24 hours ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
LMDZ6/branches/contrails/libf/phylmd/lmdz_lscp_main.f90
r5794 r5796 124 124 USE lmdz_lscp_ini, ONLY : ok_radocond_snow, a_tr_sca 125 125 USE lmdz_lscp_ini, ONLY : iflag_cloudth_vert, iflag_t_glace, iflag_fisrtilp_qsat 126 USE lmdz_lscp_ini, ONLY : min_frac_th_cld, temp_nowater 127 USE lmdz_lscp_ini, ONLY : RCPD, RLSTT, RLVTT, RVTMP2, RTT, RD, RG 126 USE lmdz_lscp_ini, ONLY : min_frac_th_cld, temp_nowater, rho_ice 127 USE lmdz_lscp_ini, ONLY : RCPD, RLSTT, RLVTT, RVTMP2, RTT, RD, RG, RPI 128 128 USE lmdz_lscp_ini, ONLY : ok_poprecip, ok_bug_phase_lscp 129 129 USE lmdz_lscp_ini, ONLY : ok_ice_supersat, ok_unadjusted_clouds, iflag_icefrac 130 130 USE lmdz_lscp_ini, ONLY : ok_weibull_warm_clouds, ok_no_issr_strato, ok_ice_sedim 131 131 USE lmdz_lscp_ini, ONLY : ok_plane_contrail 132 USE lmdz_lscp_ini, ONLY : ok_nodeep_lscp, ok_ nodeep_lscp_rad, ok_higher_cirrus_cover132 USE lmdz_lscp_ini, ONLY : ok_nodeep_lscp, ok_higher_cirrus_cover 133 133 USE lmdz_lscp_ini, ONLY : ok_lscp_mergecond, gamma_mixth 134 USE lmdz_lscp_ini, ONLY : eff2vol_radius_contrails 134 135 135 136 ! Temporary call for Lamquin et al (2012) diagnostics … … 144 145 USE phys_local_var_mod, ONLY : dcfc_auto, dqic_auto, dqtc_auto, dnic_auto 145 146 USE phys_local_var_mod, ONLY : dcf_auto, dqi_auto, dqvc_auto 146 USE geometry_mod, ONLY: longitude_deg, latitude_deg 147 USE phys_local_var_mod, ONLY : nice_ygcont, iwc_ygcont, rvol_ygcont, tau_ygcont 148 USE phys_local_var_mod, ONLY : nice_cont, iwc_cont, rvol_cont, tau_cont 147 149 148 150 IMPLICIT NONE … … 362 364 ! for condensation and ice supersaturation 363 365 REAL, DIMENSION(klon) :: qvc, qvcl, shear 366 REAL, DIMENSION(klon) :: zrneb_deep, zcond_deep 364 367 REAL :: delta_z, deepconv_coef 365 368 ! for contrails … … 369 372 REAL, DIMENSION(klon) :: dzsed_cont, flsed_cont, Nflsed_cont, cfsed_cont 370 373 REAL, DIMENSION(klon) :: dzsed_cont_abv, flsed_cont_abv, Nflsed_cont_abv, cfsed_cont_abv 374 REAL :: rho, rhodz, iwp_cont, rei_cont 371 375 !--for Lamquin et al 2012 diagnostics 372 376 REAL, DIMENSION(klon) :: issrfra100to150UP, issrfra150to200UP, issrfra200to250UP … … 805 809 806 810 DO i = 1, klon 807 pt_pron_clds(i) = ( cfcon(i,k) .LT. ( 1. - eps ) )811 pt_pron_clds(i) = .TRUE. 808 812 ENDDO 809 813 IF ( .NOT. ok_weibull_warm_clouds ) THEN … … 982 986 dcfc_sed(:,k), dqic_sed(:,k), dqtc_sed(:,k), dnic_sed(:,k), & 983 987 dcfc_auto(:,k), dqic_auto(:,k), dqtc_auto(:,k), dnic_auto(:,k)) 984 985 IF ( ok_nodeep_lscp ) THEN986 DO i = 1, klon987 !--If prognostic clouds are activated, deep convection vapor is988 !--re-added to the total water vapor989 IF ( keepgoing(i) .AND. ptconv(i,k) .AND. pt_pron_clds(i) ) THEN990 IF ( ( rneb(i,k) + cfcon(i,k) ) .GT. eps ) THEN991 zqn(i) = ( zqn(i) * rneb(i,k) &992 + ( qccon(i,k) + qvcon(i,k) ) * cfcon(i,k) ) &993 / ( rneb(i,k) + cfcon(i,k) )994 ELSE995 zqn(i) = 0.996 ENDIF997 rneb(i,k) = rneb(i,k) + cfcon(i,k)998 qvc(i) = qvc(i) + qvcon(i,k) * cfcon(i,k)999 ENDIF1000 ENDDO1001 ENDIF1002 988 1003 989 ELSE … … 1253 1239 ENDDO 1254 1240 1255 IF (ok_plane_contrail) THEN1256 1257 !--Ice water content of contrails1258 qice_cont(:,k) = qcont(:) - zqs(:) * contfra(:)1259 1260 !--If contrails do not precipitate1261 DO i = 1, klon1262 rneb(i,k) = rneb(i,k) - contfra(i)1263 zoliq(i) = zoliq(i) - qice_cont(i,k)1264 zoliqi(i) = zoliqi(i) - qice_cont(i,k)1265 ENDDO1266 ENDIF1267 1268 1241 !================================================================ 1269 1242 ! Flag for the new and more microphysical treatment of precipitation from Atelier Nuage (R) … … 1302 1275 zifl(:) = zifl(:) + flauto(:) 1303 1276 ziflcld(:) = ziflcld(:) + flauto(:) 1304 ENDIF1305 1306 IF ( ok_plane_contrail ) THEN1307 !--Contrails do not precipitate1308 DO i = 1, klon1309 rneb(i,k) = rneb(i,k) + contfra(i)1310 zoliq(i) = zoliq(i) + qice_cont(i,k)1311 zoliqi(i) = zoliqi(i) + qice_cont(i,k)1312 zradocond(i) = zradocond(i) + qice_cont(i,k)1313 zradoice(i) = zradoice(i) + qice_cont(i,k)1314 qradice_cont(i,k) = qice_cont(i,k)1315 ENDDO1316 1277 ENDIF 1317 1278 … … 1420 1381 qtc_seri(:,k) = qcont(:) 1421 1382 nic_seri(:,k) = Ncont(:) 1383 !--Ice water content of contrails 1384 qice_cont(:,k) = qcont(:) - zqs(:) * contfra(:) 1385 !--Radiative properties 1422 1386 contfrarad(:,k) = contfra(:) 1387 qradice_cont(:,k) = qice_cont(:,k) 1423 1388 ENDIF 1424 1389 … … 1433 1398 !--the sink of condensed water from precipitation 1434 1399 IF ( ptconv(i,k) ) THEN 1435 IF ( zcond(i) .GT. 0. ) THEN 1436 qvcon_old(i,k) = qvcon(i,k) 1437 qccon_old(i,k) = qccon(i,k) * zoliq(i) / zcond(i) 1438 ELSE 1439 qvcon_old(i,k) = 0. 1440 qccon_old(i,k) = 0. 1441 ENDIF 1400 qvcon_old(i,k) = qvcon(i,k) 1401 qccon_old(i,k) = qccon(i,k) 1442 1402 ELSE 1443 1403 qvcon_old(i,k) = 0. 1444 1404 qccon_old(i,k) = 0. 1445 ENDIF1446 1447 !--Deep convection clouds properties are not advected1448 IF ( ptconv(i,k) .AND. pt_pron_clds(i) .AND. ok_nodeep_lscp ) THEN1449 cf_seri(i,k) = MAX(0., cf_seri(i,k) - cfcon(i,k))1450 qvc_seri(i,k) = MAX(0., qvc_seri(i,k) - qvcon_old(i,k) * cfcon(i,k))1451 zoliq(i) = MAX(0., zoliq(i) - qccon_old(i,k) * cfcon(i,k))1452 zoliqi(i) = MAX(0., zoliqi(i) - qccon_old(i,k) * cfcon(i,k))1453 ENDIF1454 !--Deep convection clouds properties are removed from radiative properties1455 !--outputed from lscp (NB. rneb and radocond are only used for the radiative1456 !--properties and are NOT prognostics)1457 !--We must have iflag_coupl == 5 for this coupling to work1458 IF ( ptconv(i,k) .AND. pt_pron_clds(i) .AND. ok_nodeep_lscp_rad ) THEN1459 rneb(i,k) = MAX(0., rneb(i,k) - cfcon(i,k))1460 radocond(i,k) = MAX(0., radocond(i,k) - qccon_old(i,k) * cfcon(i,k))1461 1405 ENDIF 1462 1406 … … 1467 1411 cf_seri(i,k) = 0. 1468 1412 qvc_seri(i,k) = 0. 1469 qvc(i) = 0.1470 1413 ENDIF 1471 1414 1472 1415 !--Diagnostics 1473 1416 gamma_cond(i,k) = gammasat(i) 1474 subfra(i,k) = 1.- cf_seri(i,k) - issrfra(i,k)1475 qsub(i,k) = zq(i) - qvc(i) - qissr(i,k)1476 qcld(i,k) = qvc (i) + zoliq(i)1417 subfra(i,k) = totfra_in(i) - cf_seri(i,k) - issrfra(i,k) 1418 qsub(i,k) = qtot_in(i) - qvc_seri(i,k) - qissr(i,k) 1419 qcld(i,k) = qvc_seri(i,k) + zoliq(i) 1477 1420 1478 1421 IF ( ok_higher_cirrus_cover .AND. pt_pron_clds(i) .AND. .NOT. ptconv(i,k) ) THEN … … 1553 1496 ENDIF 1554 1497 1498 IF ( ok_plane_contrail ) THEN 1499 !--Other useful diagnostics 1500 DO i = 1, klon 1501 !--Very young countrails 1502 IF ( dcfc_ini(i,k) .GT. eps ) THEN 1503 rho = pplay(i,k) / zt(i) / RD 1504 nice_ygcont(i,k) = dnic_ini(i,k) / dcfc_ini(i,k) / 1e6 * rho 1505 iwc_ygcont(i,k) = dqic_ini(i,k) / dcfc_ini(i,k) * 1e3 * rho 1506 rvol_ygcont(i,k) = (dqic_ini(i,k) / MAX(eps, dnic_ini(i,k)) / rho_ice * 3. / 4. / RPI)**(1./3.) * 1e6 1507 1508 rhodz = ( paprs(i,k) - paprs(i,k+1) ) / RG 1509 iwp_cont = 1e3 * dqic_ini(i,k) / dcfc_ini(i,k) * rhodz 1510 rei_cont = MIN(100., MAX(10., rvol_ygcont(i,k) / eff2vol_radius_contrails)) 1511 tau_ygcont(i,k) = iwp_cont*(3.448e-3+2.431/rei_cont) 1512 ELSE 1513 nice_ygcont(i,k) = missing_val 1514 iwc_ygcont(i,k) = missing_val 1515 rvol_ygcont(i,k) = missing_val 1516 tau_ygcont(i,k) = missing_val 1517 ENDIF 1518 !--All contrails 1519 IF ( cfc_seri(i,k) .GT. 1e-3 ) THEN 1520 rho = pplay(i,k) / zt(i) / RD 1521 nice_cont(i,k) = nic_seri(i,k) / cfc_seri(i,k) / 1e6 * rho 1522 iwc_cont(i,k) = qice_cont(i,k) / cfc_seri(i,k) * 1e3 * rho 1523 rvol_cont(i,k) = (qice_cont(i,k) / MAX(eps, nic_seri(i,k)) / rho_ice * 3. / 4. / RPI)**(1./3.) * 1e6 1524 1525 rhodz = ( paprs(i,k) - paprs(i,k+1) ) / RG 1526 iwp_cont = 1e3 * qice_cont(i,k) / contfrarad(i,k) * rhodz 1527 rei_cont = MIN(100., MAX(10., rvol_cont(i,k) / eff2vol_radius_contrails)) 1528 tau_cont(i,k) = iwp_cont*(3.448e-3+2.431/rei_cont) 1529 ELSE 1530 nice_cont(i,k) = missing_val 1531 iwc_cont(i,k) = missing_val 1532 rvol_cont(i,k) = missing_val 1533 tau_cont(i,k) = missing_val 1534 ENDIF 1535 ENDDO 1536 ENDIF 1537 1555 1538 ! Outputs: 1556 1539 !-------------------------------
Note: See TracChangeset
for help on using the changeset viewer.
