Changeset 3952 for trunk/LMDZ.PLUTO/libf/phypluto/mp2m_diagnostics.F90
- Timestamp:
- Nov 5, 2025, 6:17:11 PM (8 weeks ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/LMDZ.PLUTO/libf/phypluto/mp2m_diagnostics.F90
r3951 r3952 10 10 ! 11 11 ! The module also contains three methods: 12 ! - inimuphy_diag(ngrid,nlayer,nq,pq,int2ext) 13 ! - alpha_s(k) 14 ! - alpha_f(k) 12 ! - inimuphy_diag(ngrid,nlayer,nq,pq,int2ext) | Initialize the variables associated to microphysics diagnostics. 13 ! - alpha_s(k) | Inter-moment relation for spherical aerosols size distribution law. 14 ! - alpha_f(k) | Inter-moment relation for fractal aerosols size distribution law. 15 ! 16 ! @warning 17 ! We suppose a given order of microphysical tracers in micro_indx and micro_ice_indx: 18 ! 1. mu_m0as, 2. mu_m3as, 3. mu_m0af, 4. mu_m3af. 19 ! If clouds are activated: 20 ! 5. mu_m0ccn, 6. mu_m3ccn, 7(+). mu_m3ices. 15 21 ! 16 22 ! Authors … … 20 26 21 27 USE tracer_h 22 28 USE callkeys_mod, only : haze_rc_prod, haze_rm, callmuclouds 29 23 30 IMPLICIT NONE 24 31 32 ! Haze model diagnostics 25 33 REAL(kind=8), ALLOCATABLE, DIMENSION(:) :: mp2m_aer_s_prec ! Spherical aerosols precipitation (kg.m-2.s-1). 26 34 REAL(kind=8), ALLOCATABLE, DIMENSION(:) :: mp2m_aer_f_prec ! Fractal aerosols precipitation (kg.m-2.s-1). … … 31 39 REAL(kind=8), ALLOCATABLE, DIMENSION(:,:) :: mp2m_rc_sph ! Spherical mode characteristic radius, i.e. bulk radius (m). 32 40 REAL(kind=8), ALLOCATABLE, DIMENSION(:,:) :: mp2m_rc_fra ! Fractal mode characteristic radius, i.e. bulk radius (m). 33 34 !$OMP THREADPRIVATE(mp2m_aer_s_prec,mp2m_aer_f_prec,mp2m_aer_s_w,mp2m_aer_f_w,mp2m_aer_s_flux,mp2m_aer_f_flux) 35 !$OMP THREADPRIVATE(mp2m_rc_sph,mp2m_rc_fra) 41 !$OMP THREADPRIVATE(mp2m_aer_s_prec,mp2m_aer_f_prec,mp2m_aer_s_w,mp2m_aer_f_w,mp2m_aer_s_flux,mp2m_aer_f_flux) 42 !$OMP THREADPRIVATE(mp2m_rc_sph,mp2m_rc_fra) 43 44 ! Cloud model diagnostics 45 REAL(kind=8), ALLOCATABLE, DIMENSION(:) :: mp2m_ccn_prec ! CCN precipitation (kg.m-2.s-1). 46 REAL(kind=8), ALLOCATABLE, DIMENSION(:,:) :: mp2m_ice_prec ! Ice precipitation (kg.m-2.s-1). 47 REAL(kind=8), ALLOCATABLE, DIMENSION(:,:) :: mp2m_cld_w ! Cloud drop settling velocity (m.s-1). 48 REAL(kind=8), ALLOCATABLE, DIMENSION(:,:) :: mp2m_ccn_flux ! CCN mass flux (kg.m-2.s-1). 49 REAL(kind=8), ALLOCATABLE, DIMENSION(:,:,:) :: mp2m_ice_fluxes ! Ice mass fluxes (kg.m-2.s-1). 50 REAL(kind=8), ALLOCATABLE, DIMENSION(:,:) :: mp2m_rc_cld ! Cloud drop radius (m). 51 REAL(kind=8), ALLOCATABLE, DIMENSION(:,:,:) :: mp2m_gas_sat ! Condensible gaz saturation ratios. 52 REAL(kind=8), ALLOCATABLE, DIMENSION(:,:,:) :: mp2m_nrate ! Condensible species nucleation rate (m-2.s-1). 53 REAL(kind=8), ALLOCATABLE, DIMENSION(:,:,:) :: mp2m_grate ! Condensible species growth rate (m2.s-1). 54 !$OMP THREADPRIVATE(mp2m_ccn_prec,mp2m_ice_prec,mp2m_cld_w,mp2m_ccn_flux,mp2m_ice_fluxes) 55 !$OMP THREADPRIVATE(mp2m_rc_cld,mp2m_gas_sat,mp2m_nrate,mp2m_grate) 36 56 37 57 CONTAINS … … 40 60 !! Initialize the variables associated to microphysics diagnostics. 41 61 !! 42 use callkeys_mod, only : haze_rc_prod, haze_rm43 44 62 INTEGER, INTENT(in) :: ngrid ! Number of points of the horizontal grid. 45 63 INTEGER, INTENT(in) :: nlayer ! Number of points of the vertical grid (layers). … … 51 69 ! Local variables: 52 70 !~~~~~~~~~~~~~~~~~ 53 REAL, DIMENSION(:,:), ALLOCATABLE :: m0as ! 0th order moment of the spherical mode (m-3). 54 REAL, DIMENSION(:,:), ALLOCATABLE :: m3as ! 3rd order moment of the spherical mode (m3.m-3). 55 REAL, DIMENSION(:,:), ALLOCATABLE :: m0af ! 0th order moment of the fractal mode (m-3). 56 REAL, DIMENSION(:,:), ALLOCATABLE :: m3af ! 3rd order moment of the fractal mode (m3.m-3). 71 INTEGER :: i 72 REAL(kind=8), DIMENSION(:,:), ALLOCATABLE :: m0as ! 0th order moment of the spherical mode (m-3). 73 REAL(kind=8), DIMENSION(:,:), ALLOCATABLE :: m3as ! 3rd order moment of the spherical mode (m3.m-3). 74 REAL(kind=8), DIMENSION(:,:), ALLOCATABLE :: m0af ! 0th order moment of the fractal mode (m-3). 75 REAL(kind=8), DIMENSION(:,:), ALLOCATABLE :: m3af ! 3rd order moment of the fractal mode (m3.m-3). 76 REAL(kind=8), DIMENSION(:,:), ALLOCATABLE :: m0ccn ! 0th order moment of the cloud condensation nuclei (m-3). 77 REAL(kind=8), DIMENSION(:,:), ALLOCATABLE :: m3ccn ! 3rd order moment of the cloud condensation nuclei (m3.m-3). 78 REAL(kind=8), DIMENSION(:,:), ALLOCATABLE :: m3itot ! 3rd order moment of the total ices (m3.m-3). 57 79 58 80 IF (.NOT.ALLOCATED(mp2m_aer_s_prec)) ALLOCATE(mp2m_aer_s_prec(ngrid)) … … 64 86 IF (.NOT.ALLOCATED(mp2m_rc_sph)) ALLOCATE(mp2m_rc_sph(ngrid,nlayer)) 65 87 IF (.NOT.ALLOCATED(mp2m_rc_fra)) ALLOCATE(mp2m_rc_fra(ngrid,nlayer)) 66 88 89 IF (.NOT.ALLOCATED(mp2m_ccn_prec)) ALLOCATE(mp2m_ccn_prec(ngrid)) 90 IF (.NOT.ALLOCATED(mp2m_ice_prec)) ALLOCATE(mp2m_ice_prec(ngrid,nmicro_ices)) 91 IF (.NOT.ALLOCATED(mp2m_cld_w)) ALLOCATE(mp2m_cld_w(ngrid,nlayer)) 92 IF (.NOT.ALLOCATED(mp2m_ccn_flux)) ALLOCATE(mp2m_ccn_flux(ngrid,nlayer)) 93 IF (.NOT.ALLOCATED(mp2m_ice_fluxes)) ALLOCATE(mp2m_ice_fluxes(ngrid,nlayer,nmicro_ices)) 94 IF (.NOT.ALLOCATED(mp2m_rc_cld)) ALLOCATE(mp2m_rc_cld(ngrid,nlayer)) 95 IF (.NOT.ALLOCATED(mp2m_gas_sat)) ALLOCATE(mp2m_gas_sat(ngrid,nlayer,nmicro_ices)) 96 IF (.NOT.ALLOCATED(mp2m_nrate)) ALLOCATE(mp2m_nrate(ngrid,nlayer,nmicro_ices)) 97 IF (.NOT.ALLOCATED(mp2m_grate)) ALLOCATE(mp2m_grate(ngrid,nlayer,nmicro_ices)) 98 99 ALLOCATE(m0as(ngrid,nlayer)) 100 ALLOCATE(m3as(ngrid,nlayer)) 101 ALLOCATE(m0af(ngrid,nlayer)) 102 ALLOCATE(m3af(ngrid,nlayer)) 103 ALLOCATE(m0ccn(ngrid,nlayer)) 104 ALLOCATE(m3ccn(ngrid,nlayer)) 105 ALLOCATE(m3itot(ngrid,nlayer)) 106 107 ! Set to 0: 108 !~~~~~~~~~~ 67 109 mp2m_aer_s_prec(:) = 0d0 68 110 mp2m_aer_f_prec(:) = 0d0 … … 71 113 mp2m_aer_s_flux(:,:) = 0d0 72 114 mp2m_aer_f_flux(:,:) = 0d0 73 74 ! Initializes the radius to their first value (useful for radiative transfer). 75 m0as = pq(:,:,micro_indx(1)) * int2ext 76 m3as = pq(:,:,micro_indx(2)) * int2ext 77 m0af = pq(:,:,micro_indx(3)) * int2ext 78 m3af = pq(:,:,micro_indx(4)) * int2ext 79 115 mp2m_rc_sph(:,:) = 0d0 116 mp2m_rc_fra(:,:) = 0d0 117 118 mp2m_ccn_prec(:) = 0d0 119 mp2m_ice_prec(:,:) = 0d0 120 mp2m_cld_w(:,:) = 0d0 121 mp2m_ccn_flux(:,:) = 0d0 122 mp2m_ice_fluxes(:,:,:) = 0d0 123 mp2m_rc_cld(:,:) = 0d0 124 mp2m_gas_sat(:,:,:) = 0d0 125 mp2m_nrate(:,:,:) = 0d0 126 mp2m_grate(:,:,:) = 0d0 127 128 m0as(:,:) = 0d0 129 m3as(:,:) = 0d0 130 m0af(:,:) = 0d0 131 m3af(:,:) = 0d0 132 m0ccn(:,:) = 0d0 133 m3ccn(:,:) = 0d0 134 m3itot(:,:) = 0d0 135 136 ! Initializes the radius to their first value (useful for radiative transfer): 137 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 138 ! Spherical aerosols 139 m0as(:,:) = pq(:,:,micro_indx(1)) * int2ext 140 m3as(:,:) = pq(:,:,micro_indx(2)) * int2ext 141 80 142 WHERE(m0as > 1e-8 .AND. m3as > (1e-8*alpha_s(3.)*haze_rc_prod**3)) 81 143 mp2m_rc_sph = (m3as / (m0as*alpha_s(3.)))**(1./3.) … … 84 146 ENDWHERE 85 147 148 ! Fractal aerosols 149 m0af(:,:) = pq(:,:,micro_indx(3)) * int2ext 150 m3af(:,:) = pq(:,:,micro_indx(4)) * int2ext 151 86 152 WHERE(m0af > 1e-8 .AND. m3af > (1e-8*alpha_f(3.)*haze_rm**3)) 87 153 mp2m_rc_fra = (m3af / (m0af*alpha_f(3.)))**(1./3.) … … 89 155 mp2m_rc_fra = 0d0 90 156 ENDWHERE 91 157 158 ! Cloud drops 159 IF (callmuclouds) THEN 160 m0ccn(:,:) = pq(:,:,micro_indx(5)) * int2ext 161 m3ccn(:,:) = pq(:,:,micro_indx(6)) * int2ext 162 DO i=1, size(micro_ice_indx) 163 m3itot(:,:) = m3itot(:,:) + (pq(:,:,micro_ice_indx(i)) * int2ext) 164 ENDDO 165 166 WHERE(m0ccn > 1e-8 .AND. (m3ccn+m3itot) > (1e-8*alpha_f(3.)*haze_rm**3)) 167 mp2m_rc_cld = ((m3ccn+m3itot) / (m0ccn))**(1./3.) 168 ELSEWHERE 169 mp2m_rc_cld = 0d0 170 ENDWHERE 171 ENDIF ! end of callmuclouds 172 92 173 CONTAINS 93 174
Note: See TracChangeset
for help on using the changeset viewer.
