19 #include "inc_openmp.h" 56 private :: mp_kessler_vterm
62 logical,
private :: mp_donegative_fixer = .true.
63 logical,
private :: mp_doprecipitation = .true.
64 logical,
private :: mp_couple_aerosol = .false.
66 real(RP),
private,
allocatable :: factor_vterm(:)
68 logical,
private :: first = .true.
70 integer,
private,
save :: mp_ntmax_sedimentation = 1
71 integer,
private,
save :: mp_nstep_sedimentation
72 real(RP),
private,
save :: mp_rnstep_sedimentation
73 real(DP),
private,
save :: mp_dtsec_sedimentation
90 character(len=*),
intent(in) :: MP_TYPE
92 namelist / param_atmos_phy_mp / &
94 mp_donegative_fixer, &
95 mp_ntmax_sedimentation, &
98 real(RP),
parameter :: max_term_vel = 10.0_rp
104 if(
io_l )
write(
io_fid_log,*)
'++++++ Module[Cloud Microphysics] / Categ[ATMOS PHYSICS] / Origin[SCALElib]' 105 if(
io_l )
write(
io_fid_log,*)
'*** KESSLER-type 1-moment bulk 3 category' 107 if ( mp_type /=
'KESSLER' )
then 108 write(*,*)
'xxx ATMOS_PHY_MP_TYPE is not KESSLER. Check!' 114 .OR. i_qr <= 0 )
then 115 write(*,*)
'xxx KESSLER needs QV, QC, QR tracer. Check!' 119 allocate( factor_vterm(
ka) )
123 read(
io_fid_conf,nml=param_atmos_phy_mp,iostat=ierr)
125 if(
io_l )
write(
io_fid_log,*)
'*** Not found namelist. Default used.' 126 elseif( ierr > 0 )
then 127 write(*,*)
'xxx Not appropriate names in namelist PARAM_ATMOS_PHY_MP. Check!' 132 if( mp_couple_aerosol )
then 133 write(*,*)
'xxx MP_aerosol_couple should be .false. for KESSLER type MP!' 138 if (
io_l )
write(
io_fid_log,*)
'*** Enable negative fixer? : ', mp_donegative_fixer
139 if (
io_l )
write(
io_fid_log,*)
'*** Enable sedimentation (precipitation)? : ', mp_doprecipitation
145 mp_ntmax_sedimentation = max( mp_ntmax_sedimentation, nstep_max )
147 mp_nstep_sedimentation = mp_ntmax_sedimentation
148 mp_rnstep_sedimentation = 1.0_rp /
real(mp_ntmax_sedimentation,kind=
rp)
152 if (
io_l )
write(
io_fid_log,*)
'*** Timestep of sedimentation is divided into : ', mp_ntmax_sedimentation,
' step' 153 if (
io_l )
write(
io_fid_log,*)
'*** DT of sedimentation is : ', mp_dtsec_sedimentation,
'[s]' 179 thermodyn_rhoe => atmos_thermodyn_rhoe, &
180 thermodyn_rhot => atmos_thermodyn_rhot, &
181 thermodyn_temp_pres_e => atmos_thermodyn_temp_pres_e
188 real(RP),
intent(inout) :: dens(
ka,
ia,
ja)
189 real(RP),
intent(inout) :: MOMZ(
ka,
ia,
ja)
190 real(RP),
intent(inout) :: MOMX(
ka,
ia,
ja)
191 real(RP),
intent(inout) :: MOMY(
ka,
ia,
ja)
192 real(RP),
intent(inout) :: RHOT(
ka,
ia,
ja)
193 real(RP),
intent(inout) :: QTRC(
ka,
ia,
ja,qad)
194 real(RP),
intent(in) :: CCN(
ka,
ia,
ja)
195 real(RP),
intent(out) :: EVAPORATE(
ka,
ia,
ja)
196 real(RP),
intent(out) :: SFLX_rain(
ia,
ja)
197 real(RP),
intent(out) :: SFLX_snow(
ia,
ja)
199 real(RP) :: RHOE_t(
ka,
ia,
ja)
200 real(RP) :: QTRC_t(
ka,
ia,
ja,qad)
201 real(RP) :: RHOE (
ka,
ia,
ja)
202 real(RP) :: temp (
ka,
ia,
ja)
203 real(RP) :: pres (
ka,
ia,
ja)
205 real(RP) :: vterm (
ka,
ia,
ja,qad)
206 real(RP) :: FLX_rain(
ka,
ia,
ja)
207 real(RP) :: FLX_snow(
ka,
ia,
ja)
208 real(RP) :: wflux_rain(
ka,
ia,
ja)
209 real(RP) :: wflux_snow(
ka,
ia,
ja)
212 real(RP) :: rho_prof(
ka)
216 if(
io_l )
write(
io_fid_log,*)
'*** Physics step: Cloud microphysics(kessler)' 221 rho_prof(:) = rho_prof(:) * 1.e-3_rp
224 factor_vterm(k) = sqrt( rho_prof(
ks)/rho_prof(k) )
229 evaporate(:,:,:) = 0.0_rp
231 if ( mp_donegative_fixer )
then 232 call mp_negative_fixer( dens(:,:,:), &
237 call thermodyn_rhoe( rhoe(:,:,:), &
242 rhoe_t(:,:,:) = 0.0_rp
243 qtrc_t(:,:,:,:) = 0.0_rp
245 call mp_kessler( rhoe_t(:,:,:), &
251 if ( mp_doprecipitation )
then 253 flx_rain(:,:,:) = 0.0_rp
254 flx_snow(:,:,:) = 0.0_rp
256 vterm(:,:,:,:) = 0.0_rp
258 do step = 1, mp_nstep_sedimentation
260 call mp_kessler_vterm( vterm(:,:,:,:), &
264 call thermodyn_temp_pres_e( temp(:,:,:), &
270 call mp_precipitation( wflux_rain(:,:,:), &
280 mp_dtsec_sedimentation )
285 flx_rain(k,i,j) = flx_rain(k,i,j) + wflux_rain(k,i,j) * mp_rnstep_sedimentation
286 flx_snow(k,i,j) = flx_snow(k,i,j) + wflux_snow(k,i,j) * mp_rnstep_sedimentation
294 vterm(:,:,:,:) = 0.0_rp
296 flx_rain(:,:,:) = 0.0_rp
297 flx_snow(:,:,:) = 0.0_rp
300 call mp_saturation_adjustment( rhoe_t(:,:,:), &
305 flag_liquid = .true. )
307 call hist_in( vterm(:,:,:,i_qr),
'Vterm_QR',
'terminal velocity of QR',
'm/s' )
311 call thermodyn_rhot( rhot(:,:,:), &
315 if ( mp_donegative_fixer )
then 316 call mp_negative_fixer( dens(:,:,:), &
321 sflx_rain(:,:) = flx_rain(
ks-1,:,:)
322 sflx_snow(:,:) = flx_snow(
ks-1,:,:)
329 subroutine mp_kessler( &
340 thermodyn_temp_pres_e => atmos_thermodyn_temp_pres_e
342 saturation_dens2qsat_liq => atmos_saturation_dens2qsat_liq
345 real(RP),
intent(inout) :: RHOE_t(
ka,
ia,
ja)
346 real(RP),
intent(inout) :: QTRC_t(
ka,
ia,
ja,
qa)
347 real(RP),
intent(inout) :: RHOE0 (
ka,
ia,
ja)
348 real(RP),
intent(inout) :: QTRC0 (
ka,
ia,
ja,
qa)
349 real(RP),
intent(in) :: DENS0 (
ka,
ia,
ja)
352 real(RP) :: QSAT (
ka,
ia,
ja)
353 real(RP) :: TEMP0(
ka,
ia,
ja)
354 real(RP) :: PRES0(
ka,
ia,
ja)
356 real(RP) :: dens (
ka)
357 real(RP) :: rhoe (
ka)
358 real(RP) :: temp (
ka)
359 real(RP) :: pres (
ka)
363 real(RP) :: qsatl(
ka)
364 real(RP) :: Sliq (
ka)
367 real(RP) :: dq_evap(
ka)
368 real(RP) :: dq_auto(
ka)
369 real(RP) :: dq_accr(
ka)
371 real(RP) :: dqv, dqc, dqr
372 real(RP) :: vent_factor
382 call thermodyn_temp_pres_e( temp0(:,:,:), &
388 call saturation_dens2qsat_liq( qsat(:,:,:), &
409 dq_auto(k) = 1.e-3_rp * max( qc(k)-1.e-3_rp, 0.0_rp )
414 dq_accr(k) = 2.2_rp * qc(k) * qr(k)**0.875_rp
419 vent_factor = 1.6_rp + 124.9_rp * ( dens(k)*qr(k) )**0.2046_rp
421 dq_evap(k) = ( 1.0_rp-min(sliq(k),1.0_rp) ) / dens(k) * vent_factor &
422 * ( dens(k)*qr(k) )**0.525_rp / ( 5.4e5_rp + 2.55e8_rp / ( pres(k)*qsatl(k) ) )
427 dqc = (-dq_auto(k)-dq_accr(k) )
429 qtrc_t(k,i,j,i_qc) = qtrc_t(k,i,j,i_qc) + max( dqc, -qc(k)*rdt )
433 dqr = ( dq_auto(k)+dq_accr(k)-dq_evap(k) )
435 qtrc_t(k,i,j,i_qr) = qtrc_t(k,i,j,i_qr) + max( dqr, -qr(k)*rdt )
439 dqv = - ( qtrc_t(k,i,j,i_qc) &
440 + qtrc_t(k,i,j,i_qr) )
442 qtrc_t(k,i,j,i_qv) = qtrc_t(k,i,j,i_qv) + max( dqv, -qv(k)*rdt )
446 rhoe_t(k,i,j) = rhoe_t(k,i,j) - dens(k) * ( lhv * qtrc_t(k,i,j,i_qv) )
455 qtrc0(
ks:
ke,i,j,i_qv) = qtrc0(
ks:
ke,i,j,i_qv) + qtrc_t(
ks:
ke,i,j,i_qv) * dt
456 qtrc0(
ks:
ke,i,j,i_qc) = qtrc0(
ks:
ke,i,j,i_qc) + qtrc_t(
ks:
ke,i,j,i_qc) * dt
457 qtrc0(
ks:
ke,i,j,i_qr) = qtrc0(
ks:
ke,i,j,i_qr) + qtrc_t(
ks:
ke,i,j,i_qr) * dt
459 rhoe0(
ks:
ke,i,j) = rhoe0(
ks:
ke,i,j) + rhoe_t(
ks:
ke,i,j) * dt
466 end subroutine mp_kessler
470 subroutine mp_kessler_vterm( &
478 real(RP),
intent(out) :: vterm(
ka,
ia,
ja,
qa)
479 real(RP),
intent(in) :: DENS0(
ka,
ia,
ja)
480 real(RP),
intent(in) :: QTRC0(
ka,
ia,
ja,
qa)
491 vterm(k,i,j,i_qv) = 0.0_rp
492 vterm(k,i,j,i_qc) = 0.0_rp
500 zerosw = 0.5_rp - sign(0.5_rp, qtrc0(k,i,j,i_qr) - 1.e-12_rp )
501 vterm(k,i,j,i_qr) = - 36.34_rp * ( dens0(k,i,j) * ( qtrc0(k,i,j,i_qr) + zerosw ) )**0.1364_rp &
502 * refstate_dens(
ks,i,j) / refstate_dens(k,i,j) * ( 1.0_rp - zerosw )
509 end subroutine mp_kessler_vterm
522 real(RP),
intent(out) :: cldfrac(
ka,
ia,
ja)
523 real(RP),
intent(in) :: QTRC (
ka,
ia,
ja,qad)
524 real(RP),
intent(in) :: mask_criterion
527 integer :: k, i, j, iq
535 qhydro = qhydro + qtrc(k,i,j,i_mp2all(iq))
537 cldfrac(k,i,j) = 0.5_rp + sign(0.5_rp,qhydro-mask_criterion)
558 real(RP),
intent(out) :: Re (
ka,
ia,
ja,mp_qad)
559 real(RP),
intent(in) :: QTRC0(
ka,
ia,
ja,qad)
560 real(RP),
intent(in) :: DENS0(
ka,
ia,
ja)
561 real(RP),
intent(in) :: TEMP0(
ka,
ia,
ja)
563 real(RP),
parameter :: um2cm = 100.0_rp
566 re(:,:,:,i_mp_qc) = 8.e-6_rp * um2cm
567 re(:,:,:,i_mp_qr) = 100.e-6_rp * um2cm
583 real(RP),
intent(out) :: Qe (
ka,
ia,
ja,mp_qad)
584 real(RP),
intent(in) :: QTRC0(
ka,
ia,
ja,qad)
587 qe(:,:,:,i_mp_qc) = qtrc0(:,:,:,i_qc)
588 qe(:,:,:,i_mp_qr) = qtrc0(:,:,:,i_qr)
integer, public is
start point of inner domain: x, local
subroutine, public atmos_phy_mp_kessler(DENS, MOMZ, MOMX, MOMY, RHOT, QTRC, CCN, EVAPORATE, SFLX_rain, SFLX_snow)
Cloud Microphysics.
integer, public je
end point of inner domain: y, local
module ATMOSPHERE / Saturation adjustment
subroutine, public prc_mpistop
Abort MPI.
subroutine, public atmos_phy_mp_precipitation(flux_rain, flux_snow, DENS, MOMZ, MOMX, MOMY, RHOE, QTRC, vterm, temp, dt)
precipitation transport
subroutine, public atmos_phy_mp_kessler_mixingratio(Qe, QTRC0)
Calculate mixing ratio of each category.
real(rp), parameter, public const_dwatr
density of water [kg/m3]
real(dp), public time_dtsec_atmos_phy_mp
time interval of physics(microphysics) [sec]
logical, public io_l
output log or not? (this process)
module ATMOSPHERE / Reference state
subroutine, public atmos_phy_mp_kessler_cloudfraction(cldfrac, QTRC, mask_criterion)
Calculate Cloud Fraction.
integer, public ke
end point of inner domain: z, local
subroutine, public atmos_phy_mp_kessler_effectiveradius(Re, QTRC0, DENS0, TEMP0)
Calculate Effective Radius.
module ATMOSPHERE / Physics Cloud Microphysics - Common
integer, public ia
of x whole cells (local, with HALO)
subroutine, public comm_horizontal_mean(varmean, var)
calculate horizontal mean (global total with communication)
module ATMOSPHERE / Physics Cloud Microphysics
integer, public ka
of z whole cells (local, with HALO)
real(rp), dimension(:,:,:), allocatable, public atmos_refstate_dens
refernce density [kg/m3]
subroutine, public atmos_phy_mp_kessler_setup(MP_TYPE)
Setup.
integer, public js
start point of inner domain: y, local
real(rp), public const_lhv
latent heat of vaporizaion for use
integer, public ks
start point of inner domain: z, local
subroutine, public atmos_phy_mp_negative_fixer(DENS, RHOT, QTRC)
Negative fixer.
subroutine, public prof_rapstart(rapname_base, level)
Start raptime.
integer, public ie
end point of inner domain: x, local
module ATMOSPHERE / Thermodynamics
logical, public io_lnml
output log or not? (for namelist, this process)
real(rp), dimension(mp_qa), target, public atmos_phy_mp_dens
real(rp), dimension(:), allocatable, public grid_cdz
z-length of control volume [m]
integer, public io_fid_conf
Config file ID.
subroutine, public atmos_phy_mp_saturation_adjustment(RHOE_t, QTRC_t, RHOE0, QTRC0, DENS0, flag_liquid)
Saturation adjustment.
integer, public io_fid_log
Log file ID.
subroutine, public prof_rapend(rapname_base, level)
Save raptime.
integer, parameter, public rp
integer, public ja
of y whole cells (local, with HALO)