← Back to Documentation Home
CCPP SciDoc v8.0.0  v8.0.0
Common Community Physics Package Developed at DTC
 
Loading...
Searching...
No Matches
mp_tempo_condensation.F90
1
3
4
7module mp_tempo_condensation
8
9 use mpi_f08
10 use machine, only : kind_phys, kind_dyn, kind_dbl_prec
11
12 use module_mp_tempo_params, only : roverrv, rv, rdry, eps, r1, t0, cp, initialize_parameters
13 use module_mp_tempo_cfgs, only : ty_tempo_cfgs
14 use module_mp_tempo_main, only : cloud_check_and_update
15 use module_mp_tempo_utils, only : calc_rslf, get_constant_cloud_number
16
17 implicit none
18
19 public :: mp_tempo_condensation_init, mp_tempo_condensation_run, mp_tempo_condensation_final
20
21 private
22
23 contains
24
25!! \section arg_table_mp_tempo_condensation_init Argument Table
26!! \htmlinclude mp_tempo_condensation_init.html
27!!
28 subroutine mp_tempo_condensation_init(errmsg, errflg)
29
30 character(len=*), intent( out) :: errmsg
31 integer, intent( out) :: errflg
32
33 errmsg = ''
34 errflg = 0
35 end subroutine mp_tempo_condensation_init
36
37
41 subroutine mp_tempo_condensation_run(mpicomm, mpirank, mpiroot, &
42 tgrs, prsl, spechum, qc, mdt, errmsg, errflg, &
43 is, ie, js, je, isc1, iec1, jsc1, jec1, &
44 isc2, iec2, jsc2, jec2, isd, ied, jsd, jed, km)
45
46 integer, intent(in ) :: isc1, iec1, jsc1, jec1
47 integer, intent(in ) :: isd, ied, jsd, jed, is, ie, js, je, km, isc2, iec2, jsc2, jec2
48 type(MPI_Comm), intent(in ) :: mpicomm
49 integer, intent(in ) :: mpirank
50 integer, intent(in ) :: mpiroot
51 real(kind_dyn), intent(in ) :: mdt
52 real(kind_dyn), intent(inout) :: spechum(isd:ied, jsd:jed, 1:km)
53 real(kind_dyn), intent(inout) :: qc(isd:ied, jsd:jed, 1:km)
54 real(kind_dyn), intent(inout) :: tgrs(isd:ied, jsd:jed, 1:km)
55 real(kind_dyn), intent(in ) :: prsl(is:ie, 1:km+1, js:je)
56
57 real(kind_phys) :: qv(is:ie, js:je, 1:km)
58 real(kind_phys) :: qc_mixing_ratio(is:ie, js:je, 1:km)
59 real(kind_phys) :: nc3d(is:ie, js:je, 1:km)
60 real(kind_phys) :: qvs(is:ie, js:je, 1:km)
61 real(kind_phys) :: rho(is:ie, js:je, 1:km)
62 real(kind_phys) :: temp(is:ie, js:je, 1:km)
63 real(kind_phys) :: satw(1:km)
64 real(kind_phys) :: ssatw(1:km)
65 real(kind_phys) :: lvap(1:km)
66 real(kind_phys) :: tcond(1:km)
67 real(kind_phys) :: diffu(1:km)
68 real(kind_phys) :: ocp(1:km)
69 real(kind_phys) :: lvt2(1:km)
70 real(kind_phys) :: rc(1:km)
71 real(kind_phys) :: nc(1:km)
72 real(kind_dbl_prec) :: ilamc(1:km)
73 real(kind_phys) :: mvd_c(1:km)
74 real(kind_phys) :: qcten(1:km)
75 real(kind_phys) :: ncten(1:km)
76 logical :: l_qc(1:km)
77 real(kind_phys) :: condensation(is:ie, js:je, 1:km)
78 real(kind_phys) :: orho, clap, fcd, dfcd, xrc, odt
79
80 ! CCPP error handling
81 character(len=*), intent( out) :: errmsg
82 integer, intent( out) :: errflg
83 integer :: i, j, k, n
84 logical, save :: need_tempo_params = .true.
85
86 ! Initialize the CCPP error handling variables
87 errmsg = ''
88 errflg = 0
89 odt = 1._kind_phys/real(mdt,kind=kind_phys)
90
91 if (need_tempo_params) then
92 call initialize_parameters()
93 need_tempo_params = .false.
94 endif
95
96 if (mpirank == mpiroot) write(*,*) 'tempo condensation on re-mapping timestep'
97 do k = 1, km
98 do j = js, je
99 do i = is, ie
100 spechum(i,j,k) = max(1.e-10, spechum(i,j,k))
101 qv(i,j,k) = spechum(i,j,k)/(1.0_kind_phys-spechum(i,j,k))
102 qc_mixing_ratio(i,j,k) = real(qc(i,j,k),kind=kind_phys) / (1._kind_phys-real(spechum(i,j,k),kind=kind_phys)) ! convert from moist to dry rho
103 temp(i,j,k) = tgrs(i,j,k) / ((0.608 * spechum(i,j,k)) + 1.) ! tgrs is virtual temperature
104 rho(i,j,k) = roverrv * exp(prsl(i,k,j)) / (rdry*temp(i,j,k) * (qv(i,j,k)+roverrv))
105 qvs(i,j,k) = calc_rslf(real(exp(prsl(i,k,j)),kind=kind_phys), real(temp(i,j,k),kind=kind_phys)) ! prsl is log pressure
106 enddo
107 enddo
108 enddo
109
110 condensation = 0.
111 do j = js, je
112 do i = is, ie
113 l_qc = .false.
114 rc = 0.
115 nc = 0.
116 qcten = 0.
117 ncten = 0.
118
119 call get_constant_cloud_number(nc=nc3d(i,j,:))
120
121 ! returns cloud mass concentration
122 call cloud_check_and_update(dt=real(mdt,kind=kind_phys), odt=odt, rho=rho(i,j,:), l_qc=l_qc, &
123 qc1d=qc_mixing_ratio(i,j,:), nc1d=nc3d(i,j,:), rc=rc, nc=nc, qcten=qcten, ncten=ncten, ilamc=ilamc, mvd_c=mvd_c)
124
125 do k = 1, km
126 satw(k) = qv(i,j,k)/qvs(i,j,k)
127 ssatw(k) = satw(k) - 1.
128 if (abs(ssatw(k)) < eps) ssatw(k) = 0.
129 lvap(k) = 2.5e6 + (2106.0 - 4218.0)*(temp(i,j,k)-t0)
130 tcond(k) = (5.69 + 0.0168*(temp(i,j,k)-t0))*1.0e-5 * 418.936
131 diffu(k) = 2.11e-5*(temp(i,j,k)/t0)**1.94 * (101325./exp(prsl(i,k,j)))
132 ocp(k) = 1./(cp*(1.+0.887*qv(i,j,k)))
133 lvt2(k) = lvap(k)*lvap(k)*ocp(k)*(1./rv)*(1./temp(i,j,k))*(1./temp(i,j,k))
134
135 if (abs(ssatw(k)) >= eps) then
136 orho = 1./rho(i,j,k)
137 clap = (qv(i,j,k)-qvs(i,j,k))/(1. + lvt2(k)*qvs(i,j,k))
138 do n = 1, 3
139 fcd = qvs(i,j,k)*exp(lvt2(k)*clap) - qv(i,j,k) + clap
140 dfcd = qvs(i,j,k)*lvt2(k)*exp(lvt2(k)*clap) + 1.
141 clap = clap - fcd/dfcd
142 enddo
143 xrc = rc(k) + clap*rho(i,j,k)
144
145 if (xrc > r1) then
146 condensation(i,j,k) = clap / mdt
147
148 if (l_qc(k) .and. ssatw(k) < -1.e-6 .and. clap < -eps) then ! evaporation
149 condensation(i,j,k) = max(-rc(k)*0.99*orho/mdt, condensation(i,j,k))
150 endif
151 else
152 condensation(i,j,k) = -rc(k)*orho/mdt
153 endif
154 endif
155
156 qv(i,j,k) = qv(i,j,k) - condensation(i,j,k)*mdt
157 qc_mixing_ratio(i,j,k) = qc_mixing_ratio(i,j,k) + condensation(i,j,k)*mdt
158 temp(i,j,k) = temp(i,j,k) + lvap(k)*ocp(k)*condensation(i,j,k)*mdt
159 enddo
160
161 call cloud_check_and_update(dt=real(mdt,kind=kind_phys), odt=odt, rho=rho(i,j,:), l_qc=l_qc, &
162 qc1d=qc_mixing_ratio(i,j,:), nc1d=nc3d(i,j,:), rc=rc, nc=nc, qcten=qcten, ncten=ncten, ilamc=ilamc, mvd_c=mvd_c)
163 enddo
164 enddo
165
166 do k = 1, km
167 do j = js, je
168 do i = is, ie
169 spechum(i,j,k) = max(1.e-10, real(qv(i,j,k),kind=kind_dyn)/(1. + real(qv(i,j,k), kind=kind_dyn)))
170 qc(i,j,k) = real(qc_mixing_ratio(i,j,k), kind=kind_dyn)/(1. + real(qv(i,j,k), kind=kind_dyn))
171 tgrs(i,j,k) = temp(i,j,k)*((0.608*spechum(i,j,k)) + 1.)
172 enddo
173 enddo
174 enddo
175
176 end subroutine mp_tempo_condensation_run
177
181 subroutine mp_tempo_condensation_final(errmsg, errflg)
182
183 character(len=*), intent( out) :: errmsg
184 integer, intent( out) :: errflg
185
186 errmsg = ''
187 errflg = 0
188 end subroutine mp_tempo_condensation_final
189
190end module mp_tempo_condensation
module_mp_tempo_cfgs::ty_tempo_cfgs
Definition module_mp_tempo_cfgs.F90:14