SCALE-RM
Functions/Subroutines
scale_atmos_phy_mp_common Module Reference

module ATMOSPHERE / Physics Cloud Microphysics - Common More...

Functions/Subroutines

subroutine, public atmos_phy_mp_negative_fixer (DENS, RHOT, QTRC)
 Negative fixer. More...
 
subroutine, public atmos_phy_mp_saturation_adjustment (RHOE_t, QTRC_t, RHOE0, QTRC0, DENS0, flag_liquid)
 Saturation adjustment. More...
 
subroutine, public atmos_phy_mp_precipitation (flux_rain, flux_snow, DENS, MOMZ, MOMX, MOMY, RHOE, QTRC, vterm, temp, dt)
 precipitation transport More...
 

Detailed Description

module ATMOSPHERE / Physics Cloud Microphysics - Common

Description
Common module for Cloud Microphysics Sedimentation/Precipitation and Saturation adjustment
Author
Team SCALE
History
  • 2012-12-23 (H.Yashiro) [new]

Function/Subroutine Documentation

◆ atmos_phy_mp_negative_fixer()

subroutine, public scale_atmos_phy_mp_common::atmos_phy_mp_negative_fixer ( real(rp), dimension(ka,ia,ja), intent(inout)  DENS,
real(rp), dimension(ka,ia,ja), intent(inout)  RHOT,
real(rp), dimension(ka,ia,ja,qa), intent(inout)  QTRC 
)

Negative fixer.

Definition at line 64 of file scale_atmos_phy_mp_common.F90.

References scale_tracer::i_qv, scale_grid_index::ia, scale_grid_index::ja, scale_grid_index::ke, scale_grid_index::ks, scale_prof::prof_rapend(), scale_prof::prof_rapstart(), scale_tracer::qqe, and scale_tracer::qqs.

Referenced by scale_atmos_phy_mp_kessler::atmos_phy_mp_kessler(), scale_atmos_phy_mp_suzuki10::atmos_phy_mp_suzuki10(), and scale_atmos_phy_mp_tomita08::atmos_phy_mp_tomita08().

64  implicit none
65 
66  real(RP), intent(inout) :: dens(ka,ia,ja)
67  real(RP), intent(inout) :: rhot(ka,ia,ja)
68  real(RP), intent(inout) :: qtrc(ka,ia,ja,qa)
69 
70  real(RP) :: diffq
71 
72  integer :: k, i, j, iq
73  !---------------------------------------------------------------------------
74 
75  call prof_rapstart('MP_filter', 3)
76 
77  !$omp parallel do private(i,j,diffq) OMP_SCHEDULE_ collapse(2)
78  do j = 1, ja
79  do i = 1, ia
80  do k = ks, ke
81 
82  diffq = 0.0_rp
83  do iq = qqs+1, qqe
84  ! total hydrometeor (before correction)
85  diffq = diffq + qtrc(k,i,j,iq)
86  ! remove negative value of hydrometeors (mass)
87  qtrc(k,i,j,iq) = max( qtrc(k,i,j,iq), 0.0_rp )
88  enddo
89 
90  do iq = qqs+1, qqe
91  ! difference between before and after correction
92  diffq = diffq - qtrc(k,i,j,iq)
93  enddo
94 
95  ! Compensate for the lack of hydrometeors by the water vapor
96  qtrc(k,i,j,i_qv) = qtrc(k,i,j,i_qv) + diffq
97 
98  ! TODO: We have to consider energy conservation (but very small)
99 
100  ! remove negative value of water vapor (mass)
101  diffq = qtrc(k,i,j,i_qv)
102  qtrc(k,i,j,i_qv) = max( qtrc(k,i,j,i_qv), 0.0_rp )
103  diffq = diffq - qtrc(k,i,j,i_qv)
104 
105  ! Apply correction to total density
106  ! TODO: We have to consider energy conservation (but very small)
107  dens(k,i,j) = dens(k,i,j) * ( 1.0_rp - diffq ) ! diffq is negative
108  rhot(k,i,j) = rhot(k,i,j) * ( 1.0_rp - diffq )
109 
110  enddo
111  enddo
112  enddo
113 
114  call prof_rapend('MP_filter', 3)
115 
116  return
scale_tracer::qqe
integer, public qqe
Definition: scale_tracer.F90:61
scale_grid_index::ke
integer, public ke
end point of inner domain: z, local
Definition: scale_grid_index.F90:59
scale_tracer::qa
integer, public qa
Definition: scale_tracer.F90:44
scale_grid_index::ia
integer, public ia
of x whole cells (local, with HALO)
Definition: scale_grid_index.F90:55
scale_grid_index::ka
integer, public ka
of z whole cells (local, with HALO)
Definition: scale_grid_index.F90:54
scale_tracer::i_qv
integer, public i_qv
Definition: scale_tracer.F90:47
scale_grid_index::ks
integer, public ks
start point of inner domain: z, local
Definition: scale_grid_index.F90:58
scale_tracer::qqs
integer, public qqs
Definition: scale_tracer.F90:60
scale_grid_index::ja
integer, public ja
of y whole cells (local, with HALO)
Definition: scale_grid_index.F90:56
Here is the call graph for this function:
Here is the caller graph for this function:

◆ atmos_phy_mp_saturation_adjustment()

subroutine, public scale_atmos_phy_mp_common::atmos_phy_mp_saturation_adjustment ( real(rp), dimension(ka,ia,ja), intent(inout)  RHOE_t,
real(rp), dimension(ka,ia,ja,qa), intent(inout)  QTRC_t,
real(rp), dimension (ka,ia,ja), intent(inout)  RHOE0,
real(rp), dimension (ka,ia,ja,qa), intent(inout)  QTRC0,
real(rp), dimension (ka,ia,ja), intent(in)  DENS0,
logical, intent(in)  flag_liquid 
)

Saturation adjustment.

Definition at line 129 of file scale_atmos_phy_mp_common.F90.

References scale_atmos_thermodyn::aq_cv, scale_const::const_lhf, scale_const::const_lhv, scale_atmos_saturation::cvovr_ice, scale_atmos_saturation::cvovr_liq, scale_tracer::i_qc, scale_tracer::i_qi, scale_tracer::i_qv, scale_grid_index::ie, scale_grid_index::ieb, scale_grid_index::is, scale_grid_index::isb, scale_grid_index::je, scale_grid_index::jeb, scale_grid_index::js, scale_grid_index::jsb, scale_grid_index::ke, scale_grid_index::ks, scale_atmos_saturation::lovr_ice, scale_atmos_saturation::lovr_liq, scale_process::prc_mpistop(), scale_prof::prof_rapend(), scale_prof::prof_rapstart(), scale_tracer::qqe, scale_tracer::qqs, scale_precision::rp, and scale_time::time_dtsec_atmos_phy_mp.

Referenced by scale_atmos_phy_mp_kessler::atmos_phy_mp_kessler(), and scale_atmos_phy_mp_tomita08::atmos_phy_mp_tomita08().

129  use scale_const, only: &
130  lhv => const_lhv, &
131  lhf => const_lhf
132  use scale_time, only: &
133  dt => time_dtsec_atmos_phy_mp
134  use scale_atmos_thermodyn, only: &
135  thermodyn_qd => atmos_thermodyn_qd, &
136  thermodyn_cv => atmos_thermodyn_cv, &
137  thermodyn_temp_pres_e => atmos_thermodyn_temp_pres_e
138  use scale_atmos_saturation, only: &
139  saturation_dens2qsat_liq => atmos_saturation_dens2qsat_liq, &
140  saturation_dens2qsat_all => atmos_saturation_dens2qsat_all
141  implicit none
142 
143  real(RP), intent(inout) :: rhoe_t(ka,ia,ja) ! tendency rhoe [J/m3/s]
144  real(RP), intent(inout) :: qtrc_t(ka,ia,ja,qa) ! tendency tracer [kg/kg/s]
145  real(RP), intent(inout) :: rhoe0 (ka,ia,ja) ! density * internal energy [J/m3]
146  real(RP), intent(inout) :: qtrc0 (ka,ia,ja,qa) ! mass concentration [kg/kg]
147  real(RP), intent(in) :: dens0 (ka,ia,ja) ! density [kg/m3]
148  logical, intent(in) :: flag_liquid ! use scheme only for the liquid water?
149 
150  ! working
151  real(RP) :: temp0 (ka,ia,ja)
152  real(RP) :: pres0 (ka,ia,ja)
153  real(RP) :: qdry0 (ka,ia,ja)
154  real(RP) :: cvtot (ka,ia,ja)
155 
156  real(RP) :: emoist(ka,ia,ja) ! moist internal energy
157  real(RP) :: qsum1 (ka,ia,ja) ! QV+QC+QI
158  real(RP) :: temp1 (ka,ia,ja)
159 
160  real(RP) :: rhoe1 (ka,ia,ja)
161  real(RP) :: qtrc1 (ka,ia,ja,qa)
162  real(RP) :: rdt
163 
164  integer :: k, i, j, iq
165  !---------------------------------------------------------------------------
166 
167 #ifndef DRY
168 
169  call prof_rapstart('MP_Saturation_adjustment', 2)
170 
171  rdt = 1.0_rp / dt
172 
173  !$omp parallel do private(i,j,k,iq) OMP_SCHEDULE_ collapse(4)
174  do iq = qqs, qqe
175  do j = jsb, jeb
176  do i = isb, ieb
177  do k = ks, ke
178  qtrc1(k,i,j,iq) = qtrc0(k,i,j,iq)
179  enddo
180  enddo
181  enddo
182  enddo
183 
184  call thermodyn_temp_pres_e( temp0(:,:,:), & ! [OUT]
185  pres0(:,:,:), & ! [OUT]
186  dens0(:,:,:), & ! [IN]
187  rhoe0(:,:,:), & ! [IN]
188  qtrc0(:,:,:,:) ) ! [IN]
189 
190  ! qdry dont change through the process
191  call thermodyn_qd( qdry0(:,:,:), & ! [OUT]
192  qtrc0(:,:,:,:) ) ! [IN]
193 
194  call thermodyn_cv( cvtot(:,:,:), & ! [OUT]
195  qtrc0(:,:,:,:), & ! [IN]
196  qdry0(:,:,:) ) ! [IN]
197 
198  if ( i_qi <= 0 .OR. flag_liquid ) then ! warm rain
199 
200  ! Turn QC into QV with consistency of moist internal energy
201  !$omp parallel do private(i,j,k) OMP_SCHEDULE_ collapse(2)
202  do j = jsb, jeb
203  do i = isb, ieb
204  do k = ks, ke
205  emoist(k,i,j) = temp0(k,i,j) * cvtot(k,i,j) &
206  + qtrc1(k,i,j,i_qv) * lhv
207 
208  qsum1(k,i,j) = qtrc1(k,i,j,i_qv) &
209  + qtrc1(k,i,j,i_qc)
210 
211  qtrc1(k,i,j,i_qv) = qsum1(k,i,j)
212  qtrc1(k,i,j,i_qc) = 0.0_rp
213  enddo
214  enddo
215  enddo
216 
217  call thermodyn_cv( cvtot(:,:,:), & ! [OUT]
218  qtrc1(:,:,:,:), & ! [IN]
219  qdry0(:,:,:) ) ! [IN]
220 
221  ! new temperature (after QC evaporation)
222  !$omp parallel do private(i,j,k) OMP_SCHEDULE_ collapse(2)
223  do j = jsb, jeb
224  do i = isb, ieb
225  do k = ks, ke
226  temp1(k,i,j) = ( emoist(k,i,j) - qtrc1(k,i,j,i_qv) * lhv ) / cvtot(k,i,j)
227  enddo
228  enddo
229  enddo
230 
231  call moist_conversion_liq( temp1(:,:,:), & ! [INOUT]
232  qtrc1(:,:,:,:), & ! [INOUT]
233  dens0(:,:,:), & ! [IN]
234  qsum1(:,:,:), & ! [IN]
235  qdry0(:,:,:), & ! [IN]
236  emoist(:,:,:) ) ! [IN]
237 
238  else ! cold rain
239 
240  ! Turn QC & QI into QV with consistency of moist internal energy
241  !$omp parallel do private(i,j,k) OMP_SCHEDULE_ collapse(2)
242  do j = jsb, jeb
243  do i = isb, ieb
244  do k = ks, ke
245  emoist(k,i,j) = temp0(k,i,j) * cvtot(k,i,j) &
246  + qtrc1(k,i,j,i_qv) * lhv &
247  - qtrc1(k,i,j,i_qi) * lhf
248 
249  qsum1(k,i,j) = qtrc1(k,i,j,i_qv) &
250  + qtrc1(k,i,j,i_qc) &
251  + qtrc1(k,i,j,i_qi)
252 
253  qtrc1(k,i,j,i_qv) = qsum1(k,i,j)
254  qtrc1(k,i,j,i_qc) = 0.0_rp
255  qtrc1(k,i,j,i_qi) = 0.0_rp
256  enddo
257  enddo
258  enddo
259 
260  call thermodyn_cv( cvtot(:,:,:), & ! [OUT]
261  qtrc1(:,:,:,:), & ! [IN]
262  qdry0(:,:,:) ) ! [IN]
263 
264  ! new temperature (after QC & QI evaporation)
265  !$omp parallel do private(i,j,k) OMP_SCHEDULE_ collapse(2)
266  do j = jsb, jeb
267  do i = isb, ieb
268  do k = ks, ke
269  temp1(k,i,j) = ( emoist(k,i,j) - qtrc1(k,i,j,i_qv) * lhv ) / cvtot(k,i,j)
270  enddo
271  enddo
272  enddo
273 
274  call moist_conversion_all( temp1(:,:,:), & ! [INOUT]
275  qtrc1(:,:,:,:), & ! [INOUT]
276  dens0(:,:,:), & ! [IN]
277  qsum1(:,:,:), & ! [IN]
278  qdry0(:,:,:), & ! [IN]
279  emoist(:,:,:) ) ! [IN]
280 
281  endif
282 
283  call thermodyn_cv( cvtot(:,:,:), & ! [OUT]
284  qtrc1(:,:,:,:), & ! [IN]
285  qdry0(:,:,:) ) ! [IN]
286 
287  ! mass & energy update
288  !$omp parallel do private(i,j,k,iq) OMP_SCHEDULE_ collapse(4)
289  do iq = qqs, qqe
290  do j = js, je
291  do i = is, ie
292  do k = ks, ke
293  qtrc_t(k,i,j,iq) = qtrc_t(k,i,j,iq) + ( qtrc1(k,i,j,iq) - qtrc0(k,i,j,iq) ) * rdt
294 
295  qtrc0(k,i,j,iq) = qtrc1(k,i,j,iq)
296  enddo
297  enddo
298  enddo
299  enddo
300 
301  !$omp parallel do private(i,j,k) OMP_SCHEDULE_ collapse(2)
302  do j = js, je
303  do i = is, ie
304  do k = ks, ke
305  rhoe1(k,i,j) = dens0(k,i,j) * temp1(k,i,j) * cvtot(k,i,j)
306 
307  rhoe_t(k,i,j) = rhoe_t(k,i,j) + ( rhoe1(k,i,j) - rhoe0(k,i,j) ) * rdt
308 
309  rhoe0(k,i,j) = rhoe1(k,i,j)
310  enddo
311  enddo
312  enddo
313 
314  call prof_rapend ('MP_Saturation_adjustment', 2)
315 
316 #else
317  rhoe_t = undef
318  qtrc_t = undef
319  rhoe0 = undef
320  qtrc0 = undef
321 #endif
322  return
scale_grid_index::is
integer, public is
start point of inner domain: x, local
Definition: scale_grid_index.F90:60
scale_grid_index::je
integer, public je
end point of inner domain: y, local
Definition: scale_grid_index.F90:63
scale_atmos_saturation
module ATMOSPHERE / Saturation adjustment
Definition: scale_atmos_sub_saturation.F90:16
scale_grid_index::jeb
integer, public jeb
Definition: scale_grid_index.F90:74
scale_time::time_dtsec_atmos_phy_mp
real(dp), public time_dtsec_atmos_phy_mp
time interval of physics(microphysics) [sec]
Definition: scale_time.F90:41
scale_tracer::qqe
integer, public qqe
Definition: scale_tracer.F90:61
scale_grid_index::ke
integer, public ke
end point of inner domain: z, local
Definition: scale_grid_index.F90:59
scale_tracer::qa
integer, public qa
Definition: scale_tracer.F90:44
scale_grid_index::ieb
integer, public ieb
Definition: scale_grid_index.F90:72
scale_grid_index::ia
integer, public ia
of x whole cells (local, with HALO)
Definition: scale_grid_index.F90:55
scale_grid_index::ka
integer, public ka
of z whole cells (local, with HALO)
Definition: scale_grid_index.F90:54
scale_tracer::i_qv
integer, public i_qv
Definition: scale_tracer.F90:47
scale_grid_index::js
integer, public js
start point of inner domain: y, local
Definition: scale_grid_index.F90:62
scale_time
module TIME
Definition: scale_time.F90:15
scale_const::const_lhv
real(rp), public const_lhv
latent heat of vaporizaion for use
Definition: scale_const.F90:77
scale_const
module CONSTANT
Definition: scale_const.F90:14
scale_grid_index::ks
integer, public ks
start point of inner domain: z, local
Definition: scale_grid_index.F90:58
scale_const::const_lhf
real(rp), public const_lhf
latent heat of fusion for use
Definition: scale_const.F90:79
scale_tracer::i_qi
integer, public i_qi
Definition: scale_tracer.F90:50
scale_grid_index::ie
integer, public ie
end point of inner domain: x, local
Definition: scale_grid_index.F90:61
scale_atmos_thermodyn
module ATMOSPHERE / Thermodynamics
Definition: scale_atmos_sub_thermodyn.F90:19
scale_tracer::qqs
integer, public qqs
Definition: scale_tracer.F90:60
scale_grid_index::isb
integer, public isb
Definition: scale_grid_index.F90:71
scale_grid_index::jsb
integer, public jsb
Definition: scale_grid_index.F90:73
scale_tracer::i_qc
integer, public i_qc
Definition: scale_tracer.F90:48
scale_grid_index::ja
integer, public ja
of y whole cells (local, with HALO)
Definition: scale_grid_index.F90:56
Here is the call graph for this function:
Here is the caller graph for this function:

◆ atmos_phy_mp_precipitation()

subroutine, public scale_atmos_phy_mp_common::atmos_phy_mp_precipitation ( real(rp), dimension(ka,ia,ja), intent(out)  flux_rain,
real(rp), dimension(ka,ia,ja), intent(out)  flux_snow,
real(rp), dimension (ka,ia,ja), intent(inout)  DENS,
real(rp), dimension (ka,ia,ja), intent(inout)  MOMZ,
real(rp), dimension (ka,ia,ja), intent(inout)  MOMX,
real(rp), dimension (ka,ia,ja), intent(inout)  MOMY,
real(rp), dimension (ka,ia,ja), intent(inout)  RHOE,
real(rp), dimension (ka,ia,ja,qa), intent(inout)  QTRC,
real(rp), dimension (ka,ia,ja,qa), intent(inout)  vterm,
real(rp), dimension (ka,ia,ja), intent(in)  temp,
real(dp), intent(in)  dt 
)

precipitation transport

Definition at line 657 of file scale_atmos_phy_mp_common.F90.

References scale_atmos_thermodyn::aq_cv, scale_const::const_grav, scale_gridtrans::gtrans_j33g, scale_tracer::i_qc, scale_tracer::i_qv, scale_grid_index::ie, scale_grid_index::is, scale_grid_index::je, scale_grid_index::js, scale_grid_index::ke, scale_grid_index::ks, scale_prof::prof_rapend(), scale_prof::prof_rapstart(), scale_tracer::qa, scale_tracer::qie, scale_tracer::qis, scale_tracer::qqe, scale_tracer::qwe, scale_tracer::qws, scale_grid_real::real_cz, scale_grid_real::real_fz, and scale_tracer::tracer_type.

Referenced by scale_atmos_phy_mp_kessler::atmos_phy_mp_kessler(), scale_atmos_phy_mp_sn14::atmos_phy_mp_sn14(), scale_atmos_phy_mp_suzuki10::atmos_phy_mp_suzuki10(), and scale_atmos_phy_mp_tomita08::atmos_phy_mp_tomita08().

657  use scale_const, only: &
658  grav => const_grav
659  use scale_grid_real, only: &
660  real_cz, &
661  real_fz
662  use scale_gridtrans, only: &
663  j33g => gtrans_j33g
664  use scale_comm, only: &
665  comm_vars8, &
666  comm_wait
667  use scale_atmos_thermodyn, only: &
668  cvw => aq_cv
669  implicit none
670 
671  real(RP), intent(out) :: flux_rain(ka,ia,ja)
672  real(RP), intent(out) :: flux_snow(ka,ia,ja)
673  real(RP), intent(inout) :: dens (ka,ia,ja)
674  real(RP), intent(inout) :: momz (ka,ia,ja)
675  real(RP), intent(inout) :: momx (ka,ia,ja)
676  real(RP), intent(inout) :: momy (ka,ia,ja)
677  real(RP), intent(inout) :: rhoe (ka,ia,ja)
678  real(RP), intent(inout) :: qtrc (ka,ia,ja,qa)
679  real(RP), intent(inout) :: vterm (ka,ia,ja,qa) ! terminal velocity of cloud mass
680  real(RP), intent(in) :: temp (ka,ia,ja)
681  real(DP), intent(in) :: dt
682 
683  real(RP) :: rhoq(ka,ia,ja,qa) ! rho * q before precipitation
684  real(RP) :: qflx(ka,ia,ja,qa)
685  real(RP) :: eflx(ka,ia,ja)
686 
687  real(RP) :: rcdz (ka,ia,ja)
688  real(RP) :: rcdz_u(ka,ia,ja)
689  real(RP) :: rcdz_v(ka,ia,ja)
690  real(RP) :: rfdz (ka,ia,ja)
691 
692  integer :: k, i, j, iq
693  !---------------------------------------------------------------------------
694 
695  call prof_rapstart('MP_Precipitation', 2)
696 
697  if ( tracer_type /= 'SUZUKI10' ) then
698  do iq = i_qc, qqe
699  call comm_vars8( vterm(:,:,:,iq), iq )
700  enddo
701  endif
702  do iq = i_qc, qqe
703  call comm_vars8( qtrc(:,:,:,iq), qqe+iq )
704  enddo
705 
706 !OCL XFILL
707  flux_rain(:,:,:) = 0.0_rp
708 !OCL XFILL
709  flux_snow(:,:,:) = 0.0_rp
710 
711  ! tracer/energy transport by falldown
712  ! 1st order upwind, forward euler, velocity is always negative
713 
714  !$omp parallel do private(i,j,k) OMP_SCHEDULE_ collapse(2)
715  do j = js, je
716  do i = is, ie
717  rfdz(ks-1,i,j) = 1.0_rp / ( real_cz(ks,i,j) - real_fz(ks-1,i,j) )
718  do k = ks, ke
719  rcdz(k,i,j) = 1.0_rp / ( real_fz(k,i,j) - real_fz(k-1,i,j) )
720  rcdz_u(k,i,j) = 2.0_rp / ( ( real_fz(k,i+1,j) - real_fz(k-1,i+1,j) ) &
721  + ( real_fz(k,i ,j) - real_fz(k-1,i ,j) ) )
722  rcdz_v(k,i,j) = 2.0_rp / ( ( real_fz(k,i,j+1) - real_fz(k-1,i,j+1) ) &
723  + ( real_fz(k,i,j ) - real_fz(k-1,i,j ) ) )
724  rfdz(k,i,j) = 1.0_rp / ( real_cz(k+1,i,j) - real_cz(k,i,j) )
725  enddo
726  enddo
727  enddo
728 
729  do iq = i_qc, qqe
730 
731  if ( tracer_type /= 'SUZUKI10' ) then
732  call comm_wait( vterm(:,:,:,iq), iq )
733  endif
734  call comm_wait( qtrc(:,:,:,iq), qqe+iq )
735 
736  do j = js, je
737  do i = is, ie
738  !--- mass flux for each mass tracer, upwind with vel < 0
739  do k = ks-1, ke-1
740  qflx(k,i,j,iq) = vterm(k+1,i,j,iq) * dens(k+1,i,j) * qtrc(k+1,i,j,iq) * j33g
741  enddo
742  qflx(ke,i,j,iq) = 0.0_rp
743 
744  !--- internal energy
745  eflx(ks-1,i,j) = qflx(ks-1,i,j,iq) * temp(ks,i,j) * cvw(iq)
746  do k = ks, ke-1
747  eflx(k,i,j) = qflx(k,i,j,iq) * temp(k+1,i,j) * cvw(iq)
748  rhoe(k,i,j) = rhoe(k,i,j) - dt * ( eflx(k,i,j) - eflx(k-1,i,j) ) * rcdz(k,i,j)
749  enddo
750  eflx(ke,i,j) = 0.0_rp
751  rhoe(ke,i,j) = rhoe(ke,i,j) - dt * ( - eflx(ke-1,i,j) ) * rcdz(ke,i,j)
752 
753  !--- potential energy
754  eflx(ks-1,i,j) = qflx(ks-1,i,j,iq) * grav / rfdz(ks-1,i,j)
755  do k = ks, ke-1
756  eflx(k,i,j) = qflx(k,i,j,iq) * grav / rfdz(k,i,j)
757  rhoe(k,i,j) = rhoe(k,i,j) - dt * ( eflx(k,i,j) - eflx(k-1,i,j) ) * rcdz(k,i,j)
758  enddo
759  rhoe(ke,i,j) = rhoe(ke,i,j) - dt * ( - eflx(ke-1,i,j) ) * rcdz(ke,i,j)
760 
761  !--- momentum z (half level)
762  do k = ks-1, ke-1
763  eflx(k,i,j) = 0.25_rp * ( vterm(k+1,i,j,iq) + vterm(k,i,j,iq) ) &
764  * ( qtrc(k+1,i,j,iq) + qtrc(k,i,j,iq) ) &
765  * momz(k,i,j)
766  enddo
767  do k = ks, ke-1
768  momz(k,i,j) = momz(k,i,j) - dt * ( eflx(k+1,i,j) - eflx(k,i,j) ) * rfdz(k,i,j)
769  enddo
770 
771  !--- momentum x
772  eflx(ks-1,i,j) = 0.25_rp * ( vterm(ks,i,j,iq) + vterm(ks,i+1,j,iq) ) &
773  * ( qtrc(ks,i,j,iq) + qtrc(ks,i+1,j,iq) ) &
774  * momx(ks,i,j)
775  do k = ks, ke-1
776  eflx(k,i,j) = 0.25_rp * ( vterm(k+1,i,j,iq) + vterm(k+1,i+1,j,iq) ) &
777  * ( qtrc(k+1,i,j,iq) + qtrc(k+1,i+1,j,iq) ) &
778  * momx(k+1,i,j)
779  momx(k,i,j) = momx(k,i,j) - dt * ( eflx(k,i,j) - eflx(k-1,i,j) ) * rcdz_u(k,i,j)
780  enddo
781  momx(ke,i,j) = momx(ke,i,j) - dt * ( - eflx(ke-1,i,j) ) * rcdz_u(ke,i,j)
782 
783  !--- momentum y
784  eflx(ks-1,i,j) = 0.25_rp * ( vterm(ks,i,j,iq) + vterm(ks,i,j+1,iq) ) &
785  * ( qtrc(ks,i,j,iq) + qtrc(ks,i,j+1,iq) ) &
786  * momy(ks,i,j)
787  do k = ks, ke-1
788  eflx(k,i,j) = 0.25_rp * ( vterm(k+1,i,j,iq) + vterm(k+1,i,j+1,iq) ) &
789  * ( qtrc(k+1,i,j,iq) + qtrc(k+1,i,j+1,iq) ) &
790  * momy(k+1,i,j)
791  momy(k,i,j) = momy(k,i,j) - dt * ( eflx(k,i,j) - eflx(k-1,i,j) ) * rcdz_v(k,i,j)
792  enddo
793  momy(ke,i,j) = momy(ke,i,j) - dt * ( - eflx(ke-1,i,j) ) * rcdz_v(ke,i,j)
794  enddo
795  enddo
796 
797  enddo ! mass tracer loop
798 
799  ! save previous value
800  do iq = 1, qa
801  do j = js, je
802  do i = is, ie
803  rhoq(ks-1,i,j,iq) = dens(ks,i,j) * qtrc(ks,i,j,iq)
804  do k = ks, ke
805  rhoq(k,i,j,iq) = dens(k,i,j) * qtrc(k,i,j,iq)
806  enddo
807  enddo
808  enddo
809  enddo
810 
811  !--- mass flux for each tracer, upwind with vel < 0
812  do iq = i_qc, qa
813 
814  do j = js, je
815  do i = is, ie
816  do k = ks-1, ke-1
817  qflx(k,i,j,iq) = vterm(k+1,i,j,iq) * rhoq(k+1,i,j,iq)
818  enddo
819  qflx(ke,i,j,iq) = 0.0_rp
820  enddo
821  enddo
822  enddo
823 
824  !--- update total density
825  do iq = i_qc, qqe
826  do j = js, je
827  do i = is, ie
828  do k = ks, ke
829  dens(k,i,j) = dens(k,i,j) - dt * ( qflx(k,i,j,iq) - qflx(k-1,i,j,iq) ) * rcdz(k,i,j)
830  enddo
831  enddo
832  enddo
833  enddo ! mass tracer loop
834 
835  !--- update falling tracer (use updated total density)
836  do iq = i_qc, qa
837  do j = js, je
838  do i = is, ie
839  do k = ks, ke
840  qtrc(k,i,j,iq) = ( rhoq(k,i,j,iq) - dt * ( qflx(k,i,j,iq) - qflx(k-1,i,j,iq) ) * rcdz(k,i,j) ) / dens(k,i,j)
841  enddo
842  enddo
843  enddo
844  enddo
845 
846  !--- update no-falling tracer (use updated total density)
847  do j = js, je
848  do i = is, ie
849  do k = ks, ke
850  qtrc(k,i,j,i_qv) = rhoq(k,i,j,i_qv) / dens(k,i,j)
851  enddo
852  enddo
853  enddo
854 
855  !--- lowermost flux is saved for land process
856  if ( qws > 0 ) then
857  do j = js, je
858  do i = is, ie
859  do k = ks-1, ke
860  do iq = qws, qwe
861  flux_rain(k,i,j) = flux_rain(k,i,j) - qflx(k,i,j,iq)
862  enddo
863  enddo
864  enddo
865  enddo
866  endif
867  if ( qis > 0 ) then
868  do j = js, je
869  do i = is, ie
870  do k = ks-1, ke
871  do iq = qis, qie
872  flux_snow(k,i,j) = flux_snow(k,i,j) - qflx(k,i,j,iq)
873  enddo
874  enddo
875  enddo
876  enddo
877  endif
878 
879 
880  call prof_rapend ('MP_Precipitation', 2)
881 
882  return
scale_tracer::qie
integer, public qie
Definition: scale_tracer.F90:66
scale_grid_index::is
integer, public is
start point of inner domain: x, local
Definition: scale_grid_index.F90:60
scale_grid_index::je
integer, public je
end point of inner domain: y, local
Definition: scale_grid_index.F90:63
scale_tracer::qqe
integer, public qqe
Definition: scale_tracer.F90:61
scale_tracer::qwe
integer, public qwe
Definition: scale_tracer.F90:64
scale_grid_index::ke
integer, public ke
end point of inner domain: z, local
Definition: scale_grid_index.F90:59
scale_gridtrans::gtrans_j33g
real(rp), public gtrans_j33g
(3,3) element of Jacobian matrix * {G}^1/2
Definition: scale_gridtrans.F90:43
scale_tracer::qa
integer, public qa
Definition: scale_tracer.F90:44
scale_grid_real::real_fz
real(rp), dimension(:,:,:), allocatable, public real_fz
geopotential height [m] (cell face )
Definition: scale_grid_real.F90:41
scale_tracer::qws
integer, public qws
Definition: scale_tracer.F90:63
scale_grid_real::real_cz
real(rp), dimension(:,:,:), allocatable, public real_cz
geopotential height [m] (cell center)
Definition: scale_grid_real.F90:40
scale_tracer::qis
integer, public qis
Definition: scale_tracer.F90:65
scale_tracer::tracer_type
character(len=h_short), public tracer_type
Definition: scale_tracer.F90:109
scale_grid_index::ia
integer, public ia
of x whole cells (local, with HALO)
Definition: scale_grid_index.F90:55
scale_gridtrans
module GRIDTRANS
Definition: scale_gridtrans.F90:15
scale_grid_real
module GRID (real space)
Definition: scale_grid_real.F90:14
scale_grid_index::ka
integer, public ka
of z whole cells (local, with HALO)
Definition: scale_grid_index.F90:54
scale_tracer::i_qv
integer, public i_qv
Definition: scale_tracer.F90:47
scale_comm
module COMMUNICATION
Definition: scale_comm.F90:23
scale_const::const_grav
real(rp), public const_grav
standard acceleration of gravity [m/s2]
Definition: scale_const.F90:48
scale_grid_index::js
integer, public js
start point of inner domain: y, local
Definition: scale_grid_index.F90:62
scale_const
module CONSTANT
Definition: scale_const.F90:14
scale_atmos_thermodyn::aq_cv
real(rp), dimension(:), allocatable, public aq_cv
CV for each hydrometeors [J/kg/K].
Definition: scale_atmos_sub_thermodyn.F90:143
scale_grid_index::ks
integer, public ks
start point of inner domain: z, local
Definition: scale_grid_index.F90:58
scale_grid_index::ie
integer, public ie
end point of inner domain: x, local
Definition: scale_grid_index.F90:61
scale_atmos_thermodyn
module ATMOSPHERE / Thermodynamics
Definition: scale_atmos_sub_thermodyn.F90:19
scale_tracer::i_qc
integer, public i_qc
Definition: scale_tracer.F90:48
scale_grid_index::ja
integer, public ja
of y whole cells (local, with HALO)
Definition: scale_grid_index.F90:56
Here is the call graph for this function:
Here is the caller graph for this function:
Generated by   doxygen 1.8.13