Changeset 5488


Ignore:
Timestamp:
Jan 17, 2025, 6:12:48 PM (12 days ago)
Author:
aborella
Message:

Added dependance of rei to contrail fraction

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

Legend:

Unmodified
Added
Removed
  • LMDZ6/branches/contrails/libf/phylmd/lmdz_aviation.f90

    r5466 r5488  
    678678!  INCLUDE 'netcdf.inc'
    679679!
    680 !  !--------------------------------------------------------
    681 !  !--input variables
    682 !  !--------------------------------------------------------
    683 !  LOGICAL, INTENT(IN) :: debut
    684 !  REAL, INTENT(IN)    :: pphis(klon), pplay(klon,klev), paprs(klon,klev+1), t_seri(klon,klev)
    685 !
    686 !  !--------------------------------------------------------
    687 !  !    ... Local variables
    688 !  !--------------------------------------------------------
    689 !
    690 !  CHARACTER (LEN=20) :: modname='airplane_mod'
    691 !  INTEGER :: i, k, kori, iret, varid, error, ncida, klona
    692 !  INTEGER,SAVE :: nleva, ntimea
    693 !!$OMP THREADPRIVATE(nleva,ntimea)
    694 !  REAL, ALLOCATABLE :: pkm_airpl_glo(:,:,:)    !--km/s
    695 !  REAL, ALLOCATABLE :: ph2o_airpl_glo(:,:,:)   !--molec H2O/cm3/s
    696 !  REAL, ALLOCATABLE, SAVE :: zmida(:), zinta(:)
    697 !  REAL, ALLOCATABLE, SAVE :: pkm_airpl(:,:,:)
    698 !  REAL, ALLOCATABLE, SAVE :: ph2o_airpl(:,:,:)
    699 !!$OMP THREADPRIVATE(pkm_airpl,ph2o_airpl,zmida,zinta)
    700 !  REAL :: zalt(klon,klev+1)
    701 !  REAL :: zrho, zdz(klon,klev), zfrac
    702 !
    703 !  !
    704 !  IF (debut) THEN
    705 !  !--------------------------------------------------------------------------------
    706 !  !       ... Open the file and read airplane emissions
    707 !  !--------------------------------------------------------------------------------
    708 !  !
    709 !  IF (is_mpi_root .AND. is_omp_root) THEN
    710 !      !
    711 !      iret = nf_open('aircraft_phy.nc', 0, ncida)
    712 !      IF (iret /= NF_NOERR) CALL abort_physic(modname,'problem to open aircraft_phy.nc file',1)
    713 !      ! ... Get lengths
    714 !      iret = nf_inq_dimid(ncida, 'time', varid)
    715 !      IF (iret /= NF_NOERR) CALL abort_physic(modname,'problem to get time dimid in aircraft_phy.nc file',1)
    716 !      iret = nf_inq_dimlen(ncida, varid, ntimea)
    717 !      IF (iret /= NF_NOERR) CALL abort_physic(modname,'problem to get time dimlen aircraft_phy.nc file',1)
    718 !      iret = nf_inq_dimid(ncida, 'vector', varid)
    719 !      IF (iret /= NF_NOERR) CALL abort_physic(modname,'problem to get vector dimid aircraft_phy.nc file',1)
    720 !      iret = nf_inq_dimlen(ncida, varid, klona)
    721 !      IF (iret /= NF_NOERR) CALL abort_physic(modname,'problem to get vector dimlen aircraft_phy.nc file',1)
    722 !      iret = nf_inq_dimid(ncida, 'lev', varid)
    723 !      IF (iret /= NF_NOERR) CALL abort_physic(modname,'problem to get lev dimid aircraft_phy.nc file',1)
    724 !      iret = nf_inq_dimlen(ncida, varid, nleva)
    725 !      IF (iret /= NF_NOERR) CALL abort_physic(modname,'problem to get lev dimlen aircraft_phy.nc file',1)
    726 !      !
    727 !      IF ( klona /= klon_glo ) THEN
    728 !        WRITE(lunout,*) 'klona & klon_glo =', klona, klon_glo
    729 !        CALL abort_physic(modname,'problem klon in aircraft_phy.nc file',1)
    730 !      ENDIF
    731 !      !
    732 !      IF ( ntimea /= 12 ) THEN
    733 !        WRITE(lunout,*) 'ntimea=', ntimea
    734 !        CALL abort_physic(modname,'problem ntime<>12 in aircraft_phy.nc file',1)
    735 !      ENDIF
    736 !      !
    737 !      ALLOCATE(zmida(nleva), STAT=error)
    738 !      IF (error /= 0) CALL abort_physic(modname,'problem to allocate zmida',1)
    739 !      ALLOCATE(pkm_airpl_glo(klona,nleva,ntimea), STAT=error)
    740 !      IF (error /= 0) CALL abort_physic(modname,'problem to allocate pkm_airpl_glo',1)
    741 !      ALLOCATE(ph2o_airpl_glo(klona,nleva,ntimea), STAT=error)
    742 !      IF (error /= 0) CALL abort_physic(modname,'problem to allocate ph2o_airpl_glo',1)
    743 !      !
    744 !      iret = nf_inq_varid(ncida, 'lev', varid)
    745 !      IF (iret /= NF_NOERR) CALL abort_physic(modname,'problem to get lev dimid aircraft_phy.nc file',1)
    746 !      iret = nf_get_var_double(ncida, varid, zmida)
    747 !      IF (iret /= NF_NOERR) CALL abort_physic(modname,'problem to read zmida file',1)
    748 !      !
    749 !      iret = nf_inq_varid(ncida, 'emi_co2_aircraft', varid)  !--CO2 as a proxy for m flown -
    750 !      IF (iret /= NF_NOERR) CALL abort_physic(modname,'problem to get emi_distance dimid aircraft_phy.nc file',1)
    751 !      iret = nf_get_var_double(ncida, varid, pkm_airpl_glo)
    752 !      IF (iret /= NF_NOERR) CALL abort_physic(modname,'problem to read pkm_airpl file',1)
    753 !      !
    754 !      iret = nf_inq_varid(ncida, 'emi_h2o_aircraft', varid)
    755 !      IF (iret /= NF_NOERR) CALL abort_physic(modname,'problem to get emi_h2o_aircraft dimid aircraft_phy.nc file',1)
    756 !      iret = nf_get_var_double(ncida, varid, ph2o_airpl_glo)
    757 !      IF (iret /= NF_NOERR) CALL abort_physic(modname,'problem to read ph2o_airpl file',1)
    758 !      !
    759 !     ENDIF    !--is_mpi_root and is_omp_root
    760 !     !
    761 !     CALL bcast(nleva)
    762 !     CALL bcast(ntimea)
    763 !     !
    764 !     IF (.NOT.ALLOCATED(zmida)) ALLOCATE(zmida(nleva), STAT=error)
    765 !     IF (.NOT.ALLOCATED(zinta)) ALLOCATE(zinta(nleva+1), STAT=error)
    766 !     !
    767 !     ALLOCATE(pkm_airpl(klon,nleva,ntimea))
    768 !     ALLOCATE(ph2o_airpl(klon,nleva,ntimea))
    769 !     !
    770 !     ALLOCATE(flight_m(klon,klev))
    771 !     ALLOCATE(flight_h2o(klon,klev))
    772 !     !
    773 !     CALL bcast(zmida)
    774 !     zinta(1)=0.0                                   !--surface
    775 !     DO k=2, nleva
    776 !       zinta(k) = (zmida(k-1)+zmida(k))/2.0*1000.0  !--conversion from km to m
    777 !     ENDDO
    778 !     zinta(nleva+1)=zinta(nleva)+(zmida(nleva)-zmida(nleva-1))*1000.0 !--extrapolation for last interface
    779 !     !print *,'zinta=', zinta
    780 !     !
    781 !     CALL scatter(pkm_airpl_glo,pkm_airpl)
    782 !     CALL scatter(ph2o_airpl_glo,ph2o_airpl)
    783 !     !
    784 !!$OMP MASTER
    785 !     IF (is_mpi_root .AND. is_omp_root) THEN
    786 !        DEALLOCATE(pkm_airpl_glo)
    787 !        DEALLOCATE(ph2o_airpl_glo)
    788 !     ENDIF   !--is_mpi_root
    789 !!$OMP END MASTER
    790 !
    791 !  ENDIF !--debut
    792 !!
    793 !!--compute altitude of model level interfaces
    794 !!
    795 !  DO i = 1, klon
    796 !    zalt(i,1)=pphis(i)/RG         !--in m
    797 !  ENDDO
    798 !!
    799 !  DO k=1, klev
    800 !    DO i = 1, klon
    801 !      zrho=pplay(i,k)/t_seri(i,k)/RD
    802 !      zdz(i,k)=(paprs(i,k)-paprs(i,k+1))/zrho/RG
    803 !      zalt(i,k+1)=zalt(i,k)+zdz(i,k)   !--in m
    804 !    ENDDO
    805 !  ENDDO
    806 !!
    807 !!--vertical reprojection
    808 !!
    809 !  flight_m(:,:)=0.0
    810 !  flight_h2o(:,:)=0.0
    811 !!
    812 !  DO k=1, klev
    813 !    DO kori=1, nleva
    814 !      DO i=1, klon
    815 !        !--fraction of layer kori included in layer k
    816 !        zfrac=max(0.0,min(zalt(i,k+1),zinta(kori+1))-max(zalt(i,k),zinta(kori)))/(zinta(kori+1)-zinta(kori))
    817 !        !--reproject
    818 !        flight_m(i,k)=flight_m(i,k) + pkm_airpl(i,kori,mth_cur)*zfrac
    819 !        !--reproject
    820 !        flight_h2o(i,k)=flight_h2o(i,k) + ph2o_airpl(i,kori,mth_cur)*zfrac   
    821 !      ENDDO
    822 !    ENDDO
    823 !  ENDDO
    824 !!
    825 !  DO k=1, klev
    826 !    DO i=1, klon
    827 !      !--molec.cm-3.s-1 / (molec/mol) * kg CO2/mol * m2 * m * cm3/m3 / (kg CO2/m) => m s-1 per cell
    828 !      flight_m(i,k)=flight_m(i,k)/RNAVO*44.e-3*cell_area(i)*zdz(i,k)*1.e6/16.37e-3
    829 !      flight_m(i,k)=flight_m(i,k)*100.0  !--x100 to augment signal to noise
    830 !      !--molec.cm-3.s-1 / (molec/mol) * kg H2O/mol * m2 * m * cm3/m3 => kg H2O s-1 per cell
    831 !      flight_h2o(i,k)=flight_h2o(i,k)/RNAVO*18.e-3*cell_area(i)*zdz(i,k)*1.e6
    832 !    ENDDO
    833 !  ENDDO
    834680!!
    835681!END SUBROUTINE airplane
  • LMDZ6/branches/contrails/libf/phylmd/lmdz_call_cloud_optics_prop.f90

    r5268 r5488  
    1010    reliq_pi, reice_pi, scdnc, cldncl, reffclwtop, lcc, reffclws, &
    1111    reffclwc, cldnvi, lcc3d, lcc3dcon, lcc3dstra, icc3dcon, icc3dstra,  &
    12     icefrac_optics, dNovrN, ptconv,rnebcon, ccwcon)
     12    icefrac_optics, dNovrN, ptconv,rnebcon, ccwcon, rcontrail)
    1313
    1414  ! Interface between the LMDZ physics monitor and the cloud properties calculation routines
     
    4747  LOGICAL, INTENT(IN) :: ptconv(klon, klev) ! flag for grid points affected by deep convection
    4848  LOGICAL, INTENT(IN) :: ok_newmicro, ok_aie
     49
     50  REAL, INTENT(IN) :: rcontrail(klon, klev) ! ratio of contrail to total cloud fraction, used only if ok_plane_contrail=y [-]
    4951
    5052  ! inout:
     
    116118    reliq_pi, reice_pi, scdnc, cldncl, reffclwtop, lcc, reffclws, &
    117119    reffclwc, cldnvi, lcc3d, lcc3dcon, lcc3dstra, icc3dcon, icc3dstra,  &
    118     icefrac_optics, dNovrN, ptconv,rnebcon, ccwcon)
     120    icefrac_optics, dNovrN, ptconv,rnebcon, ccwcon, rcontrail)
    119121  ELSE
    120122    CALL nuage (paprs, pplay, &
  • LMDZ6/branches/contrails/libf/phylmd/lmdz_cloud_optics_prop.f90

    r5400 r5488  
    99    reliq_pi, reice_pi, scdnc, cldncl, reffclwtop, lcc, reffclws, &
    1010    reffclwc, cldnvi, lcc3d, lcc3dcon, lcc3dstra, icc3dcon, icc3dstra,  &
    11     icefrac_optics, dNovrN, ptconv,rnebcon, ccwcon)
     11    icefrac_optics, dNovrN, ptconv, rnebcon, ccwcon, rcontrail)
    1212
    1313  USE lmdz_cloud_optics_prop_ini , ONLY : flag_aerosol, ok_cdnc
     
    2828  USE lmdz_cloud_optics_prop_ini , ONLY : ok_icefra_lscp, rei_max, rei_min
    2929  USE lmdz_cloud_optics_prop_ini , ONLY : zepsec, novlp, iflag_ice_thermo, ok_new_lscp
     30  USE lmdz_cloud_optics_prop_ini , ONLY : ok_plane_contrail, re_ice_crystals_contrails
    3031 
    3132
     
    6970
    7071  LOGICAL, INTENT(IN) :: ptconv(klon, klev) ! flag for grid points affected by deep convection
     72
     73  REAL, INTENT(IN) :: rcontrail(klon, klev) ! ratio of contrails to total cloud fraction, used only if ok_plane_contrail=y [-]
    7174
    7275  ! inout:
     
    333336
    334337          IF (zfiwp_var==0. .OR. rei<=0.) rei = 1.
     338          IF ( ok_plane_contrail ) THEN
     339            !--If contrails are activated, rei is a weighted average between the natural
     340            !--rei and the contrails rei, with the weights being the fraction of natural
     341            !--vs contrail cirrus in the gridbox
     342            rei = rei * ( 1. - rcontrail(i,k) ) + re_ice_crystals_contrails * rcontrail(i,k)
     343          ENDIF
    335344          pcldtaupi(i, k) = 3.0/2.0*zflwp_var/rad_chaud_pi(i, k) + &
    336345            zfiwp_var*(3.448E-03+2.431/rei)
     
    442451        IF (zflwp_var==0.) rel = 1.
    443452        IF (zfiwp_var==0. .OR. rei<=0.) rei = 1.
     453        IF ( ok_plane_contrail ) THEN
     454          !--If contrails are activated, rei is a weighted average between the natural
     455          !--rei and the contrails rei, with the weights being the fraction of natural
     456          !--vs contrail cirrus in the gridbox
     457          rei = rei * ( 1. - rcontrail(i,k) ) + re_ice_crystals_contrails * rcontrail(i,k)
     458        ENDIF
    444459        pcltau(i, k) = 3.0/2.0*(zflwp_var/rel) + zfiwp_var*(3.448E-03+2.431/ &
    445460          rei)
  • LMDZ6/branches/contrails/libf/phylmd/lmdz_cloud_optics_prop_ini.f90

    r5400 r5488  
    1111  LOGICAL, PROTECTED :: ok_cdnc
    1212  LOGICAL, PROTECTED :: ok_icefra_lscp, ok_new_lscp
     13  LOGICAL, PROTECTED :: ok_plane_contrail
    1314  REAL, PROTECTED :: bl95_b0, bl95_b1 ! Parameter in B&L 95-Formula
    1415  REAL, ALLOCATABLE :: latitude_deg(:)
     
    2223  REAL, PROTECTED :: rei_max, rei_min
    2324  REAL, PROTECTED :: zepsec
     25  REAL, PROTECTED :: re_ice_crystals_contrails=7.5E-6 ! [m] effective radius of ice crystals in contrails
    2426  REAL, PARAMETER :: thres_tau=0.3, thres_neb=0.001
    2527  REAL, PARAMETER :: prmhc=440.*100. ! Pressure between medium and high level cloud in Pa
     
    3941!$OMP THREADPRIVATE(rad_chau1, rad_chau2, rad_froid, rei_max, rei_min)
    4042!$OMP THREADPRIVATE(zepsec)
     43!$OMP THREADPRIVATE(re_ice_crystals_contrails)
    4144
    4245 
     
    4649       & ok_cdnc_in, bl95_b0_in, &
    4750       & bl95_b1_in, latitude_deg_in, rpi_in, rg_in, rd_in, zepsec_in, novlp_in, &
    48        & iflag_ice_thermo_in, ok_new_lscp_in)
     51       & iflag_ice_thermo_in, ok_new_lscp_in, &
     52       & ok_plane_contrail_in)
    4953
    5054    USE ioipsl_getin_p_mod, ONLY : getin_p
     
    5660    INTEGER, INTENT(IN) :: novlp_in, iflag_ice_thermo_in
    5761    LOGICAL, INTENT(IN) :: ok_cdnc_in, ok_new_lscp_in
     62    LOGICAL, INTENT(IN) :: ok_plane_contrail_in
    5863    REAL, INTENT(IN) :: bl95_b0_in, bl95_b1_in
    5964    REAL, INTENT(IN) :: latitude_deg_in(klon)
     
    7782    iflag_ice_thermo = iflag_ice_thermo_in
    7883    ok_new_lscp = ok_new_lscp_in
     84    ok_plane_contrail = ok_plane_contrail_in
    7985   
    8086    call getin_p('cdnc_min',cdnc_min)
     
    98104    rei_max = 61.29
    99105    CALL getin_p('rei_max',rei_max)
     106    CALL getin_p('re_ice_crystals_contrails', re_ice_crystals_contrails)
    100107
    101108   
  • LMDZ6/branches/contrails/libf/phylmd/physiq_mod.F90

    r5456 r5488  
    18771877                                  & ok_cdnc, bl95_b0, &
    18781878                                  & bl95_b1, latitude_deg, rpi, rg, rd, &
    1879                                   & zepsec, novlp, iflag_ice_thermo, ok_new_lscp)
     1879                                  & zepsec, novlp, iflag_ice_thermo, ok_new_lscp, &
     1880                                  & ok_plane_contrail)
    18801881!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    18811882
     
    44654466               ref_liq_pi, ref_ice_pi, scdnc, cldncl, reffclwtop, lcc, reffclws, &
    44664467               reffclwc, cldnvi, lcc3d, lcc3dcon, lcc3dstra, icc3dcon, icc3dstra,  &
    4467                zfice, dNovrN, ptconv, rnebcon, clwcon)
     4468               zfice, dNovrN, ptconv, rnebcon, clwcon, rcont_seri)
    44684469
    44694470       !
Note: See TracChangeset for help on using the changeset viewer.