MODULE mp2m_calmufi use tracer_h use callkeys_mod, only : call_haze_prod_pCH4, haze_rho ! Microphysical model MP2M use mp2m_intgcm use mp2m_diagnostics implicit none !============================================================================ ! ! Purpose ! ------- ! Interface subroutine to YAMMS model for LMD PCM. ! ! The subroutine computes the microphysics processes for a single vertical column. ! - All input vectors are assumed to be defined from GROUND to TOP of the atmosphere. ! - All output vectors are defined from GROUND to TOP of the atmosphere. ! - Only tendencies are returned. ! ! @important ! The method assumes global initialization of YAMMS model (and extras) has been already ! done elsewhere. ! ! @warning ! Microphysical tracers from physics must be in X/kg_of_air and convert into X/m2 for microphysics. ! ! @warning ! We suppose a given order of tracers (1. mu_m0as, 2. mu_m3as, 3. mu_m0af, 4. mu_m3af)! ! ! Authors ! ------- ! B. de Batz de Trenquelléon (11/2024) ! !============================================================================ CONTAINS SUBROUTINE calmufi(dt, plev, zlev, play, zlay, g3d, temp, pq, zdqfi, zdqmufi_prod, zdqmufi) !! Interface subroutine to YAMMS model for LMD PCM. !! !! The subroutine computes the microphysics processes for a single vertical column. !! REAL(kind=8), INTENT(IN) :: dt !! Physics timestep (s). REAL(kind=8), DIMENSION(:,:), INTENT(IN) :: plev ! Pressure levels (Pa). REAL(kind=8), DIMENSION(:,:), INTENT(IN) :: zlev ! Altitude levels (m). REAL(kind=8), DIMENSION(:,:), INTENT(IN) :: play ! Pressure layers (Pa). REAL(kind=8), DIMENSION(:,:), INTENT(IN) :: zlay ! Altitude at the center of each layer (m). REAL(kind=8), DIMENSION(:,:), INTENT(IN) :: g3d ! Latitude-Altitude depending gravitational acceleration (m.s-2). REAL(kind=8), DIMENSION(:,:), INTENT(IN) :: temp ! Temperature at the center of each layer (K). REAL(kind=8), DIMENSION(:,:,:), INTENT(IN) :: pq ! Tracers (X.kg-1). REAL(kind=8), DIMENSION(:,:,:), INTENT(IN) :: zdqfi ! Tendency from former processes for tracers (X.kg-1.s-1). REAL(kind=8), DIMENSION(:,:,:), INTENT(IN) :: zdqmufi_prod ! Aerosols production tendency (kg/kg_of_air/s). REAL(kind=8), DIMENSION(:,:,:), INTENT(OUT) :: zdqmufi ! Microphysical tendency for tracers (X.m-2 --> X.kg-1.s-1). ! Local tracers: !~~~~~~~~~~~~~~~ REAL(kind=8), DIMENSION(:,:,:), ALLOCATABLE :: zq ! Local tracers updated from former processes (X.kg-1). REAL(kind=8), DIMENSION(:), ALLOCATABLE :: m0as ! 0th order moment of the spherical mode (m-2). REAL(kind=8), DIMENSION(:), ALLOCATABLE :: m3as ! 3rd order moment of the spherical mode (m3.m-2). REAL(kind=8), DIMENSION(:), ALLOCATABLE :: m0af ! 0th order moment of the fractal mode (m-2). REAL(kind=8), DIMENSION(:), ALLOCATABLE :: m3af ! 3rd order moment of the fractal mode (m3.m-2). REAL(kind=8), DIMENSION(:), ALLOCATABLE :: m3as_prod ! Production of 3rd order moment of the spherical mode (m3.m-2). REAL(kind=8), DIMENSION(:), ALLOCATABLE :: dm0as ! Tendency of the 0th order moment of the spherical mode distribution (m-2). REAL(kind=8), DIMENSION(:), ALLOCATABLE :: dm3as ! Tendency of the 3rd order moment of the spherical mode distribution (m3.m-2). REAL(kind=8), DIMENSION(:), ALLOCATABLE :: dm0af ! Tendency of the 0th order moment of the fractal mode distribution (m-2). REAL(kind=8), DIMENSION(:), ALLOCATABLE :: dm3af ! Tendency of the 3rd order moment of the fractal mode distribution (m3.m-2). ! Local variables: !~~~~~~~~~~~~~~~~~ REAL(kind=8), DIMENSION(:,:), ALLOCATABLE :: int2ext ! Conversion intensive to extensive (kg.m-2). REAL(kind=8), DIMENSION(:), ALLOCATABLE :: tmp TYPE(error) :: err INTEGER :: ilon,iq INTEGER :: nq,nlon,nlay CHARACTER(len=10) :: tname ! Read size of arrays: !~~~~~~~~~~~~~~~~~~~~~ nq = size(pq,DIM=3) nlon = size(play,DIM=1) nlay = size(play,DIM=2) ! Allocate arrays: !~~~~~~~~~~~~~~~~~ ALLOCATE(zq(nlon,nlay,nq)) ALLOCATE(m0as(nlay)) ALLOCATE(m3as(nlay)) ALLOCATE(m0af(nlay)) ALLOCATE(m3af(nlay)) ALLOCATE(m3as_prod(nlay)) ALLOCATE(dm0as(nlay)) ALLOCATE(dm3as(nlay)) ALLOCATE(dm0af(nlay)) ALLOCATE(dm3af(nlay)) ALLOCATE(int2ext(nlon,nlay)) !------------------ ! 1. Initialization !------------------ ! Initialization of zdqmufi here since intent=out and no action performed on every tracers zdqmufi(:,:,:) = 0.D0 ! Initialize tracers updated with former processes from physics zq(:,:,:) = pq(:,:,:) + zdqfi(:,:,:)*dt ! Loop on horizontal grid points DO ilon = 1, nlon ! Convert tracers to extensive int2ext(ilon,:) = (plev(ilon,1:nlay)-plev(ilon,2:nlay+1)) / g3d(ilon,1:nlay) m0as(:) = zq(ilon,:,micro_indx(1)) * int2ext(ilon,:) m3as(:) = zq(ilon,:,micro_indx(2)) * int2ext(ilon,:) m0af(:) = zq(ilon,:,micro_indx(3)) * int2ext(ilon,:) m3af(:) = zq(ilon,:,micro_indx(4)) * int2ext(ilon,:) ! Production of haze in the atmosphere by photolysis of CH4 if (call_haze_prod_pCH4) then do iq = 1, nq tname = noms(iq) if (tname(1:4).eq."haze") then m3as_prod(:) = zdqmufi_prod(ilon,:,iq) * (int2ext(ilon,:) / haze_rho) * dt endif enddo else m3as_prod(:) = 0.D0 endif ! Hackin the pressure level tmp = plev(ilon,:) if (tmp(nlay+1) == 0.0) then tmp(nlay+1) = 2*tmp(nlay) - tmp(nlay-1) endif ! Initialize YAMMS atmospheric column err = mm_column_init(tmp,zlev(ilon,:),play(ilon,:),zlay(ilon,:),temp(ilon,:)) ; IF (err /= 0) call abort_program(err) ! Initialize YAMMS aerosols moments column err = mm_aerosols_init(m0as,m3as,m0af,m3af) ; IF (err /= 0) call abort_program(err) ! Initializes tendencies dm0as(:) = 0._mm_wp ; dm3as(:) = 0._mm_wp ; dm0af(:) = 0._mm_wp ; dm3af(:) = 0._mm_wp !---------------------------- ! 2. Call microphysical model !---------------------------- ! Call microphysics IF (.NOT.mm_muphys(m3as_prod,dm0as,dm3as,dm0af,dm3af)) THEN call abort_program(error("mm_muphys aborted -> initialization not done !",-1)) ENDIF ! Save diagnostics call mm_diagnostics(dt,mp2m_aer_s_prec(ilon),mp2m_aer_f_prec(ilon), & mp2m_aer_s_w(ilon,:),mp2m_aer_f_w(ilon,:), & mp2m_aer_s_flux(ilon,:),mp2m_aer_f_flux(ilon,:), & mp2m_rc_sph(ilon,:),mp2m_rc_fra(ilon,:)) ! Convert tracers back to intensives zdqmufi(ilon,:,micro_indx(1)) = dm0as(:) / int2ext(ilon,:) zdqmufi(ilon,:,micro_indx(2)) = dm3as(:) / int2ext(ilon,:) zdqmufi(ilon,:,micro_indx(3)) = dm0af(:) / int2ext(ilon,:) zdqmufi(ilon,:,micro_indx(4)) = dm3af(:) / int2ext(ilon,:) END DO ! End loop on ilon ! YAMMS gives a tendency which is integrated for all the timestep but in the GCM ! we want to have routines spitting tendencies in s-1 -> let's divide ! zdqmufi(:,:,:) = zdqmufi(:,:,:) / dt END SUBROUTINE calmufi END MODULE mp2m_calmufi