Changeset 5794 for LMDZ6/branches


Ignore:
Timestamp:
Jul 29, 2025, 5:41:19 PM (8 days ago)
Author:
aborella
Message:

Added an option to increase cirrus cover for radiative transfer (Brooks et al, 2005)

Location:
LMDZ6/branches/contrails/libf/phylmd
Files:
5 edited

Legend:

Unmodified
Added
Removed

  • LMDZ6/branches/contrails/libf/phylmd/lmdz_cloud_optics_prop_ini.f90

    r5790 r5794  
    1212  LOGICAL, PROTECTED :: ok_icefra_lscp, ok_new_lscp
    1313  LOGICAL, PROTECTED :: ok_plane_contrail
     14  LOGICAL, PROTECTED :: ok_higher_cirrus_cover
    1415  REAL, PROTECTED :: bl95_b0, bl95_b1 ! Parameter in B&L 95-Formula
    1516  REAL, ALLOCATABLE :: latitude_deg(:)
    … …  
    4546!$OMP THREADPRIVATE(zepsec)
    4647!$OMP THREADPRIVATE(eff2vol_radius_contrails, rho_ice)
     48!$OMP THREADPRIVATE(ok_plane_contrail, ok_higher_cirrus_cover)
    4749
    4850 
    … …  
    6870    REAL, INTENT(IN) :: rpi_in, rg_in, rd_in
    6971    REAL, INTENT(IN) :: zepsec_in
     72
     73    character (len=20) :: modname='cloud_optics_ini_mod'
     74    character (len=80) :: abort_message
    7075
    7176    ALLOCATE(latitude_deg(klon))
    … …  
    112117    CALL getin_p('eff2vol_radius_contrails', eff2vol_radius_contrails)
    113118    write(lunout,*)'eff2vol_radius_contrails=',eff2vol_radius_contrails
     119    CALL getin_p('ok_higher_cirrus_cover', ok_higher_cirrus_cover)
     120    write(lunout,*)'ok_higher_cirrus_cover=',ok_higher_cirrus_cover
    114121
     122    IF ( ok_higher_cirrus_cover .AND. iflag_rei .GT. 0 ) THEN
     123      abort_message = 'in cloud_optics, ok_higher_cirrus_cover is not implemented for iflag_rei > 0'
     124      CALL abort_physic (modname,abort_message,1)
     125    ENDIF
    115126   
    116127  END SUBROUTINE cloud_optics_prop_ini

  • LMDZ6/branches/contrails/libf/phylmd/lmdz_lscp_ini.f90

    r5790 r5794  
    168168  LOGICAL, SAVE, PROTECTED :: ok_nodeep_lscp_rad=.FALSE.     ! if True, the deep convection clouds are not accounted two times in radiative transfer
    169169  !$OMP THREADPRIVATE(ok_nodeep_lscp_rad)
     170
     171  LOGICAL, SAVE, PROTECTED :: ok_higher_cirrus_cover=.FALSE. ! if True, the cirrus cover is increased for radiative transfer, following Brooks et al. (2005)
     172  !$OMP THREADPRIVATE(ok_higher_cirrus_cover)
    170173
    171174  REAL, SAVE, PROTECTED :: ffallv_issr                       ! tuning coefficient crystal fall velocity, cirrus clouds (with ISSR)
    … …  
    584587    CALL getin_p('ok_nodeep_lscp',ok_nodeep_lscp)
    585588    CALL getin_p('ok_nodeep_lscp_rad',ok_nodeep_lscp_rad)
     589    CALL getin_p('ok_higher_cirrus_cover',ok_higher_cirrus_cover)
    586590    ffallv_issr=ffallv_lsc
    587591    CALL getin_p('ffallv_issr',ffallv_issr)
    … …  
    717721    WRITE(lunout,*) 'lscp_ini, ok_nodeep_lscp:', ok_nodeep_lscp
    718722    WRITE(lunout,*) 'lscp_ini, ok_nodeep_lscp_rad:', ok_nodeep_lscp_rad
     723    WRITE(lunout,*) 'lscp_ini, ok_higher_cirrus_cover:', ok_higher_cirrus_cover
    719724    WRITE(lunout,*) 'lscp_ini, ffallv_issr', ffallv_issr
    720725    WRITE(lunout,*) 'lscp_ini, cooling_rate_ice_thresh', cooling_rate_ice_thresh

  • LMDZ6/branches/contrails/libf/phylmd/lmdz_lscp_main.f90

    r5791 r5794  
    3131     dqvc_sub, dqvc_con, dqvc_mix, qsatl, qsati,        &
    3232     cfc_seri, qtc_seri, nic_seri,                      &
    33      qice_cont, flight_dist, flight_fuel, qradice_cont, &
     33     qice_cont, flight_dist, flight_fuel,               &
     34     contfrarad, qradice_cont,                          &
    3435     Tcritcont, qcritcont, potcontfraP, potcontfraNP,   &
    3536     cloudth_sth,                                       &
    … …  
    129130USE lmdz_lscp_ini, ONLY : ok_weibull_warm_clouds, ok_no_issr_strato, ok_ice_sedim
    130131USE lmdz_lscp_ini, ONLY : ok_plane_contrail
    131 USE lmdz_lscp_ini, ONLY : ok_nodeep_lscp, ok_nodeep_lscp_rad
     132USE lmdz_lscp_ini, ONLY : ok_nodeep_lscp, ok_nodeep_lscp_rad, ok_higher_cirrus_cover
    132133USE lmdz_lscp_ini, ONLY : ok_lscp_mergecond, gamma_mixth
    133134
    … …  
    281282
    282283  REAL, DIMENSION(klon,klev),      INTENT(OUT)  :: qice_cont      !--condensed water in contrails [kg/kg]
     284  REAL, DIMENSION(klon,klev),      INTENT(OUT)  :: contfrarad     !--contrail fraction for radiation [-]
    283285  REAL, DIMENSION(klon,klev),      INTENT(OUT)  :: qradice_cont   !--condensed water in contrails used in the radiation scheme [kg/kg]
    284286  REAL, DIMENSION(klon,klev),      INTENT(OUT)  :: Tcritcont      !--critical temperature for contrail formation [K]
    … …  
    356358  REAL, DIMENSION(klon) :: zradocond, zradoice
    357359  REAL, DIMENSION(klon) :: zrho_up, zvelo_up
     360  REAL :: dz, coef_cover
    358361 
    359362  ! for condensation and ice supersaturation
    … …  
    742745
    743746
     747        DO i = 1, klon
     748          !--Calculate the shear value (input for condensation and ice supersat)
     749          !--Cell thickness [m]
     750          delta_z = ( paprs(i,k) - paprs(i,k+1) ) / RG / pplay(i,k) * zt(i) * RD
     751          IF ( iftop ) THEN
     752            ! top
     753            shear(i) = SQRT( ( (u_seri(i,k) - u_seri(i,k-1)) / delta_z )**2. &
     754                           + ( (v_seri(i,k) - v_seri(i,k-1)) / delta_z )**2. )
     755          ELSEIF ( k .EQ. 1 ) THEN
     756            ! surface
     757            shear(i) = SQRT( ( (u_seri(i,k+1) - u_seri(i,k)) / delta_z )**2. &
     758                           + ( (v_seri(i,k+1) - v_seri(i,k)) / delta_z )**2. )
     759          ELSE
     760            ! other layers
     761            shear(i) = SQRT( ( ( (u_seri(i,k+1) + u_seri(i,k)) / 2. &
     762                               - (u_seri(i,k) + u_seri(i,k-1)) / 2. ) / delta_z )**2. &
     763                           + ( ( (v_seri(i,k+1) + v_seri(i,k)) / 2. &
     764                               - (v_seri(i,k) + v_seri(i,k-1)) / 2. ) / delta_z )**2. )
     765          ENDIF
     766        ENDDO
     767
    744768        IF ( ok_ice_supersat ) THEN
    745769
    … …  
    832856                  nic_seri(i,k) = nic_seri(i,k) * deepconv_coef
    833857                ENDIF
    834               ENDIF
    835 
    836               !--Calculate the shear value (input for condensation and ice supersat)
    837               !--Cell thickness [m]
    838               delta_z = ( paprs(i,k) - paprs(i,k+1) ) / RG / pplay(i,k) * zt(i) * RD
    839               IF ( iftop ) THEN
    840                 ! top
    841                 shear(i) = SQRT( ( (u_seri(i,k) - u_seri(i,k-1)) / delta_z )**2. &
    842                                + ( (v_seri(i,k) - v_seri(i,k-1)) / delta_z )**2. )
    843               ELSEIF ( k .EQ. 1 ) THEN
    844                 ! surface
    845                 shear(i) = SQRT( ( (u_seri(i,k+1) - u_seri(i,k)) / delta_z )**2. &
    846                                + ( (v_seri(i,k+1) - v_seri(i,k)) / delta_z )**2. )
    847               ELSE
    848                 ! other layers
    849                 shear(i) = SQRT( ( ( (u_seri(i,k+1) + u_seri(i,k)) / 2. &
    850                                    - (u_seri(i,k) + u_seri(i,k-1)) / 2. ) / delta_z )**2. &
    851                                + ( ( (v_seri(i,k+1) + v_seri(i,k)) / 2. &
    852                                    - (v_seri(i,k) + v_seri(i,k-1)) / 2. ) / delta_z )**2. )
    853858              ENDIF
    854859            ENDIF
    … …  
    14151420      qtc_seri(:,k) = qcont(:)
    14161421      nic_seri(:,k) = Ncont(:)
     1422      contfrarad(:,k) = contfra(:)
    14171423    ENDIF
    14181424
    14191425    IF ( ok_ice_supersat ) THEN
    1420 
    14211426      DO i = 1, klon
    14221427
    … …  
    14701475        qsub(i,k) = zq(i) - qvc(i) - qissr(i,k)
    14711476        qcld(i,k) = qvc(i) + zoliq(i)
     1477
     1478        IF ( ok_higher_cirrus_cover .AND. pt_pron_clds(i) .AND. .NOT. ptconv(i,k) ) THEN
     1479          !--Following Brooks et al. (2005)
     1480          !--This is only valid for cirrus clouds
     1481          !--We do not apply it do convective clouds
     1482          IF ( ( rneb(i,k) .GT. eps ) .AND. ( rneb(i,k) .LT. (1. - eps) ) ) THEN
     1483            dz = ( paprs(i,k) - paprs(i,k+1) ) / RG / pplay(i,k) * zt(i) * RD
     1484            coef_cover = (0.0706 + 0.1274 * shear(i)**0.3015) &
     1485                * dz**0.7679 / SQRT(cell_area(i))**0.2254
     1486            rneb(i,k) = 1. / (1. + EXP(-coef_cover) * (1. / rneb(i,k) - 1.))
     1487            IF ( contfrarad(i,k) .GT. eps ) THEN
     1488              contfrarad(i,k) = cfc_seri(i,k) / cf_seri(i,k) * rneb(i,k)
     1489            ENDIF
     1490          ENDIF
     1491        ENDIF
    14721492
    14731493        !--Calculation of the ice supersaturated fraction following Lamquin et al (2012)

  • LMDZ6/branches/contrails/libf/phylmd/phys_local_var_mod.F90

    r5791 r5794  
    724724      REAL, SAVE, ALLOCATABLE :: qice_cont(:,:)
    725725      !$OMP THREADPRIVATE(qice_cont)
    726       REAL, SAVE, ALLOCATABLE :: qradice_cont(:,:)
    727       !$OMP THREADPRIVATE(qradice_cont)
     726      REAL, SAVE, ALLOCATABLE :: contfra(:,:), qradice_cont(:,:)
     727      !$OMP THREADPRIVATE(contfra, qradice_cont)
    728728      REAL, SAVE, ALLOCATABLE :: dcfc_ini(:,:), dqic_ini(:,:), dqtc_ini(:,:), dnic_ini(:,:)
    729729      !$OMP THREADPRIVATE(dcfc_ini, dqic_ini, dqtc_ini, dnic_ini)
    … …  
    13341334      ALLOCATE(fsurv_contrails(klon,klev), section_contrails(klon,klev))
    13351335      ALLOCATE(qice_cont(klon,klev))
    1336       ALLOCATE(qradice_cont(klon,klev))
     1336      ALLOCATE(contfra(klon,klev), qradice_cont(klon,klev))
    13371337      ALLOCATE(dcfc_ini(klon,klev), dqic_ini(klon,klev), dqtc_ini(klon,klev), dnic_ini(klon,klev))
    13381338      ALLOCATE(dcfc_sub(klon,klev), dqic_sub(klon,klev), dqtc_sub(klon,klev), dnic_sub(klon,klev))
    … …  
    17791779      DEALLOCATE(Tcritcont, qcritcont, potcontfraP, potcontfraNP)
    17801780      DEALLOCATE(AEI_contrails, AEI_surv_contrails, fsurv_contrails, section_contrails)
    1781       DEALLOCATE(qice_cont, qradice_cont)
     1781      DEALLOCATE(qice_cont, contfra, qradice_cont)
    17821782      DEALLOCATE(dcfc_ini, dqic_ini, dqtc_ini, dnic_ini)
    17831783      DEALLOCATE(dcfc_sub, dqic_sub, dqtc_sub, dnic_sub)

  • LMDZ6/branches/contrails/libf/phylmd/physiq_mod.F90

    r5791 r5794  
    343343       cfc_seri, qtc_seri, nic_seri, d_cfc_dyn, d_qtc_dyn, d_nic_dyn, &
    344344       d_q_avi, flight_dist, flight_fuel, &
    345        qice_cont, qradice_cont, &
     345       qice_cont, contfra, qradice_cont, &
    346346       Tcritcont, qcritcont, potcontfraP, potcontfraNP, &
    347347       cldfra_nocont, cldtau_nocont, cldemi_nocont, cldh_nocont, &
    … …  
    40634063         dqvc_adj, dqvc_sub, dqvc_con, dqvc_mix, qsatliq, qsatice, &
    40644064         cfc_seri, qtc_seri, nic_seri, qice_cont, &
    4065          flight_dist, flight_fuel, qradice_cont, &
     4065         flight_dist, flight_fuel, contfra, qradice_cont, &
    40664066         Tcritcont, qcritcont, potcontfraP, potcontfraNP, &
    40674067         cloudth_sth,cloudth_senv,cloudth_sigmath,cloudth_sigmaenv, &
    … …  
    46134613               zfice, dNovrN, ptconv, rnebcon, clwcon, &
    46144614               !--AB contrails
    4615                cfc_seri, qradice_cont, nic_seri, cldfra_nocont, &
     4615               contfra, qradice_cont, nic_seri, cldfra_nocont, &
    46164616               cldtau_nocont, cldemi_nocont, conttau, contemi, cldh_nocont, contcov, &
    46174617               fiwp_nocont, fiwc_nocont, ref_ice_nocont)
Note: See TracChangeset for help on using the changeset viewer.