FE-Project
Loading...
Searching...
No Matches
Functions/Subroutines
scale_atm_dyn_dgm_nonhydro3d_etot_hevi_common Module Reference

module FElib / Fluid dyn solver / Atmosphere / Nonhydrostatic model / HEVI / Common More...

Functions/Subroutines

subroutine, public atm_dyn_dgm_nonhydro3d_etot_hevi_common_eval_ax (dens_t, momz_t, etot_t, alph, prog_vars, dpres, prog_vars0, dpres0, ddens00, momx00, momy00, momz00, entot00, dens_hyd, pres_hyd, rtot, cptot_ov_cvtot, dz, lift, intrpmat_vpordm1, gnnm, g13, g23, gsqrtv, impl_fac, dt, lmesh, elem, nz, vmapm, vmapp, b1d_ij)
subroutine, public atm_dyn_dgm_nonhydro3d_etot_hevi_common_eval_ax_uv (momx_t, momy_t, alph, prog_vars, dpres, prog_vars0, dpres0, ddens00, momx00, momy00, momz00, entot00, dens_hyd, pres_hyd, rtot, cptot_ov_cvtot, dz, lift, intrpmat_vpordm1, gnnm, g13, g23, gsqrtv, impl_fac, dt, lmesh, elem, nz, vmapm, vmapp, b1d_ij_uv)
subroutine, public atm_dyn_dgm_nonhydro3d_etot_hevi_common_construct_matbnd (pmatbnd, kl, ku, nz_1d, prog_vars0, kinhovdens00, dens_hyd, pres_hyd, g13, g23, gsqrtv, alph, rtot, cptot_ov_cvtot, geopot, dz, lift, intrpmat_vpordm1, impl_fac, dt, lmesh, elem, nz, vmapm, vmapp, ke_x, ke_y)
subroutine, public atm_dyn_dgm_nonhydro3d_etot_hevi_common_construct_matbnd_uv (pmatbnd_uv, kl_uv, ku_uv, nz_1d_uv, prog_vars0, kinhovdens00, dens_hyd, pres_hyd, g13, g23, gsqrtv, alph, rtot, cptot_ov_cvtot, geopot, dz, lift, intrpmat_vpordm1, impl_fac, dt, lmesh, elem, nz, vmapm, vmapp, ke_x, ke_y)

Detailed Description

module FElib / Fluid dyn solver / Atmosphere / Nonhydrostatic model / HEVI / Common

Description
HEVI DGM scheme for Atmospheric dynamical process As the thermodynamics equation, a total energy equation is used.
Author
Yuta Kawai, Team SCALE

Function/Subroutine Documentation

◆ atm_dyn_dgm_nonhydro3d_etot_hevi_common_eval_ax()

subroutine, public scale_atm_dyn_dgm_nonhydro3d_etot_hevi_common::atm_dyn_dgm_nonhydro3d_etot_hevi_common_eval_ax ( real(rp), dimension(elem%np,lmesh%nea), intent(out) dens_t,
real(rp), dimension(elem%np,lmesh%nea), intent(out) momz_t,
real(rp), dimension(elem%np,lmesh%nea), intent(out) etot_t,
real(rp), dimension(elem%nfptot,lmesh%nez,lmesh%nex*lmesh%ney), intent(out) alph,
real(rp), dimension (elem%np,lmesh%nez,prgvar_num,lmesh%nex*lmesh%ney), intent(in) prog_vars,
real(rp), dimension (elem%np,lmesh%nez,lmesh%nex*lmesh%ney), intent(in) dpres,
real(rp), dimension (elem%np,lmesh%nez,prgvar_num,lmesh%nex*lmesh%ney), intent(in) prog_vars0,
real(rp), dimension (elem%np,lmesh%nez,lmesh%nex*lmesh%ney), intent(in) dpres0,
real(rp), dimension(elem%np,lmesh%nea), intent(in) ddens00,
real(rp), dimension (elem%np,lmesh%nea), intent(in) momx00,
real(rp), dimension (elem%np,lmesh%nea), intent(in) momy00,
real(rp), dimension (elem%np,lmesh%nea), intent(in) momz00,
real(rp), dimension(elem%np,lmesh%nea), intent(in) entot00,
real(rp), dimension(elem%np,lmesh%nez,lmesh%nex*lmesh%ney), intent(in) dens_hyd,
real(rp), dimension(elem%np,lmesh%nez,lmesh%nex*lmesh%ney), intent(in) pres_hyd,
real(rp), dimension(elem%np,lmesh%nez,lmesh%nex*lmesh%ney), intent(in) rtot,
real(rp), dimension(elem%np,lmesh%nez,lmesh%nex*lmesh%ney), intent(in) cptot_ov_cvtot,
class(sparsemat), intent(in) dz,
class(sparsemat), intent(in) lift,
real(rp), dimension(elem%np,elem%np), intent(in) intrpmat_vpordm1,
real(rp), dimension(elem%np,lmesh%nez,lmesh%nex*lmesh%ney), intent(in) gnnm,
real(rp), dimension (elem%np,lmesh%nez,lmesh%nex*lmesh%ney), intent(in) g13,
real(rp), dimension (elem%np,lmesh%nez,lmesh%nex*lmesh%ney), intent(in) g23,
real(rp), dimension(elem%np,lmesh%nez,lmesh%nex*lmesh%ney), intent(in) gsqrtv,
real(rp), intent(in) impl_fac,
real(rp), intent(in) dt,
class(localmesh3d), intent(in) lmesh,
class(elementbase3d), intent(in) elem,
real(rp), dimension(elem%nfptot,lmesh%nez,lmesh%nex*lmesh%ney), intent(in) nz,
integer, dimension(elem%nfptot,lmesh%nez), intent(in) vmapm,
integer, dimension(elem%nfptot,lmesh%nez), intent(in) vmapp,
real(rp), dimension(3,elem%nnode_v,lmesh%nez,elem%nnode_h1d**2,lmesh%nex*lmesh%ney), intent(out), optional b1d_ij )

Definition at line 75 of file scale_atm_dyn_dgm_nonhydro3d_etot_hevi_common.F90.

88
89 implicit none
90
91 class(LocalMesh3D), intent(in) :: lmesh
92 class(ElementBase3D), intent(in) :: elem
93 real(RP), intent(out) :: DENS_t(elem%Np,lmesh%NeA)
94 real(RP), intent(out) :: MOMZ_t(elem%Np,lmesh%NeA)
95 real(RP), intent(out) :: ETOT_t(elem%Np,lmesh%NeA)
96 real(RP), intent(out) :: alph(elem%NfpTot,lmesh%NeZ,lmesh%NeX*lmesh%NeY)
97 real(RP), intent(in) :: PROG_VARS (elem%Np,lmesh%NeZ,PRGVAR_NUM,lmesh%NeX*lmesh%NeY)
98 real(RP), intent(in) :: DPRES (elem%Np,lmesh%NeZ,lmesh%NeX*lmesh%NeY)
99 real(RP), intent(in) :: PROG_VARS0 (elem%Np,lmesh%NeZ,PRGVAR_NUM,lmesh%NeX*lmesh%NeY)
100 real(RP), intent(in) :: DPRES0 (elem%Np,lmesh%NeZ,lmesh%NeX*lmesh%NeY)
101 real(RP), intent(in) :: DDENS00(elem%Np,lmesh%NeA)
102 real(RP), intent(in) :: MOMX00 (elem%Np,lmesh%NeA)
103 real(RP), intent(in) :: MOMY00 (elem%Np,lmesh%NeA)
104 real(RP), intent(in) :: MOMZ00 (elem%Np,lmesh%NeA)
105 real(RP), intent(in) :: EnTot00(elem%Np,lmesh%NeA)
106 real(RP), intent(in) :: DENS_hyd(elem%Np,lmesh%NeZ,lmesh%NeX*lmesh%NeY)
107 real(RP), intent(in) :: PRES_hyd(elem%Np,lmesh%NeZ,lmesh%NeX*lmesh%NeY)
108 real(RP), intent(in) :: Rtot(elem%Np,lmesh%NeZ,lmesh%NeX*lmesh%NeY)
109 real(RP), intent(in) :: CPtot_ov_CVtot(elem%Np,lmesh%NeZ,lmesh%NeX*lmesh%NeY)
110 class(SparseMat), intent(in) :: Dz, Lift
111 real(RP), intent(in) :: IntrpMat_VPOrdM1(elem%Np,elem%Np)
112 real(RP), intent(in) :: GnnM(elem%Np,lmesh%NeZ,lmesh%NeX*lmesh%NeY)
113 real(RP), intent(in) :: G13 (elem%Np,lmesh%NeZ,lmesh%NeX*lmesh%NeY)
114 real(RP), intent(in) :: G23 (elem%Np,lmesh%NeZ,lmesh%NeX*lmesh%NeY)
115 real(RP), intent(in) :: GsqrtV(elem%Np,lmesh%NeZ,lmesh%NeX*lmesh%NeY)
116 real(RP), intent(in) :: impl_fac
117 real(RP), intent(in) :: dt
118 real(RP), intent(in) :: nz(elem%NfpTot,lmesh%NeZ,lmesh%NeX*lmesh%NeY)
119 integer, intent(in) :: vmapM(elem%NfpTot,lmesh%NeZ)
120 integer, intent(in) :: vmapP(elem%NfpTot,lmesh%NeZ)
121 real(RP), intent(out), optional :: b1D_ij(3,elem%Nnode_v,lmesh%NeZ,elem%Nnode_h1D**2,lmesh%NeX*lmesh%NeY)
122
123 real(RP) :: RGsqrtV(elem%Np)
124 real(RP) :: Fscale(elem%NfpTot), Escale33(elem%Np)
125 real(RP) :: Fz(elem%Np), LiftDelFlx(elem%Np)
126 real(RP) :: del_flux(elem%NfpTot,lmesh%NeZ,lmesh%NeX*lmesh%NeY,PRGVAR_NUM)
127 real(RP) :: MOMZ(elem%Np), DDENS(elem%Np), ENTHALPY(elem%Np)
128 real(RP) :: MOMW(elem%Np)
129 integer :: ke_xy, ke_z
130 integer :: ke, ke2d
131 integer :: v
132 integer :: ij
133 integer :: ColMask(elem%Nnode_v)
134 real(RP) :: rdt
135 real(RP) :: drho(elem%Np)
136
137 integer :: kk, kkk, p, pp
138 real(RP) :: vmf_v
139 !--------------------------------------------------------
140
141 rdt = 1.0_rp / dt
142
143 call vi_cal_del_flux_dyn( del_flux, & ! (out)
144 alph, prog_vars, prog_vars0, dpres, dpres0, & ! (in)
145 dens_hyd, pres_hyd, & ! (in)
146 gnnm, g13, g23, gsqrtv, nz, vmapm, vmapp, & ! (in)
147 lmesh, elem ) ! (in)
148
149 !$omp parallel private( ke_xy, ke_z, ke, ke2d, ij, v, &
150 !$omp MOMZ, MOMW, DDENS, ENTHALPY, Fz, LiftDelFlx, &
151 !$omp RGsqrtV, ColMask, Fscale, Escale33, drho, &
152 !$omp kk, p, kkk, vmf_v, pp )
153
154 !$omp do collapse(2)
155 do ke_xy=1, lmesh%NeX*lmesh%NeY
156 do ke_z=1, lmesh%NeZ
157 ke = ke_xy + (ke_z-1)*lmesh%NeX*lmesh%NeY
158 ke2d = lmesh%EMap3Dto2D(ke)
159
160 ddens(:) = prog_vars(:,ke_z,dens_vid,ke_xy)
161 drho(:) = matmul(intrpmat_vpordm1, ddens(:))
162
163 momz(:) = prog_vars(:,ke_z,momz_vid,ke_xy)
164 enthalpy(:) = prog_vars(:,ke_z,etot_vid,ke_xy) &
165 + pres_hyd(:,ke_z,ke_xy) + dpres(:,ke_z,ke_xy)
166
167 rgsqrtv(:) = 1.0_rp / gsqrtv(:,ke_z,ke_xy)
168 fscale(:) = lmesh%Fscale(:,ke)
169 escale33(:) = lmesh%Escale(:,ke,3,3)
170
171 momw(:) = momz(:) &
172 + gsqrtv(:,ke_z,ke_xy) * g13(:,ke_z,ke_xy) * prog_vars(:,ke_z,momx_vid,ke_xy) &
173 + gsqrtv(:,ke_z,ke_xy) * g23(:,ke_z,ke_xy) * prog_vars(:,ke_z,momy_vid,ke_xy)
174
175 !- DENS
176 call sparsemat_matmul(dz, momw(:), fz)
177 call sparsemat_matmul(lift, fscale(:) * del_flux(:,ke_z,ke_xy,dens_vid), liftdelflx)
178 dens_t(:,ke) = - ( escale33(:) * fz(:) + liftdelflx(:) ) * rgsqrtv(:)
179
180 !-MOMZ
181! call sparsemat_matmul(Dz, MOMZ(:)**2 / ( DENS_hyd(:,ke_z,ke_xy) + DDENS(:) ) + DPRES(:), Fz) ! [<- MOMZ x MOMZ / DENS + DPRES ]
182 call sparsemat_matmul(dz, dpres(:,ke_z,ke_xy), fz)
183 call sparsemat_matmul(lift, fscale(:) * del_flux(:,ke_z,ke_xy,momz_vid), liftdelflx)
184 momz_t(:,ke) = - ( escale33(:) * fz(:) + liftdelflx(:) ) * rgsqrtv(:) &
185 - grav * drho(:)
186
187 !-EnTot
188 call sparsemat_matmul(dz, enthalpy(:) * momw(:) / ( dens_hyd(:,ke_z,ke_xy) + ddens(:) ), fz)
189 call sparsemat_matmul(lift, fscale(:) * del_flux(:,ke_z,ke_xy,etot_vid), liftdelflx)
190 etot_t(:,ke) = - ( escale33(:) * fz(:) + liftdelflx(:) ) * rgsqrtv(:)
191
192 end do
193 end do
194 !$omp end do
195
196 if ( present( b1d_ij ) ) then
197 !$omp do collapse(2)
198 do ke_xy=1, lmesh%NeX*lmesh%NeY
199 do ke_z=1, lmesh%NeZ
200 ke = ke_xy + (ke_z-1)*lmesh%NeX*lmesh%NeY
201
202 do ij=1, elem%Nnode_h1D**2
203 colmask(:) = elem%Colmask(:,ij)
204 b1d_ij(1,:,ke_z,ij,ke_xy) = impl_fac * dens_t(colmask(:),ke) &
205 - prog_vars(colmask(:),ke_z,dens_vid,ke_xy) &
206 + ddens00(colmask(:),ke)
207 b1d_ij(2,:,ke_z,ij,ke_xy) = impl_fac * momz_t(colmask(:),ke) &
208 - prog_vars(colmask(:),ke_z,momz_vid,ke_xy) &
209 + momz00(colmask(:),ke)
210 b1d_ij(3,:,ke_z,ij,ke_xy) = impl_fac * etot_t(colmask(:),ke) &
211 - prog_vars(colmask(:),ke_z,etot_vid,ke_xy) &
212 + entot00(colmask(:),ke)
213 end do
214 end do
215 end do
216 !$omp end do
217 end if
218 !$omp end parallel
219
220 return

References scale_atm_dyn_dgm_nonhydro3d_common::intrpmat_vpordm1.

Referenced by scale_atm_dyn_dgm_globalnonhydro3d_etot_hevi::atm_dyn_dgm_globalnonhydro3d_etot_hevi_cal_vi(), and scale_atm_dyn_dgm_nonhydro3d_etot_hevi::atm_dyn_dgm_nonhydro3d_etot_hevi_cal_vi().

◆ atm_dyn_dgm_nonhydro3d_etot_hevi_common_eval_ax_uv()

subroutine, public scale_atm_dyn_dgm_nonhydro3d_etot_hevi_common::atm_dyn_dgm_nonhydro3d_etot_hevi_common_eval_ax_uv ( real(rp), dimension(elem%np,lmesh%nea), intent(out) momx_t,
real(rp), dimension(elem%np,lmesh%nea), intent(out) momy_t,
real(rp), dimension(elem%nfptot,lmesh%nez,lmesh%nex*lmesh%ney), intent(out) alph,
real(rp), dimension (elem%np,lmesh%nez,prgvar_num,lmesh%nex*lmesh%ney), intent(in) prog_vars,
real(rp), dimension (elem%np,lmesh%nez,lmesh%nex*lmesh%ney), intent(in) dpres,
real(rp), dimension (elem%np,lmesh%nez,prgvar_num,lmesh%nex*lmesh%ney), intent(in) prog_vars0,
real(rp), dimension (elem%np,lmesh%nez,lmesh%nex*lmesh%ney), intent(in) dpres0,
real(rp), dimension(elem%np,lmesh%nea), intent(in) ddens00,
real(rp), dimension (elem%np,lmesh%nea), intent(in) momx00,
real(rp), dimension (elem%np,lmesh%nea), intent(in) momy00,
real(rp), dimension (elem%np,lmesh%nea), intent(in) momz00,
real(rp), dimension(elem%np,lmesh%nea), intent(in) entot00,
real(rp), dimension(elem%np,lmesh%nez,lmesh%nex*lmesh%ney), intent(in) dens_hyd,
real(rp), dimension(elem%np,lmesh%nez,lmesh%nex*lmesh%ney), intent(in) pres_hyd,
real(rp), dimension(elem%np,lmesh%nez,lmesh%nex*lmesh%ney), intent(in) rtot,
real(rp), dimension(elem%np,lmesh%nez,lmesh%nex*lmesh%ney), intent(in) cptot_ov_cvtot,
class(sparsemat), intent(in) dz,
class(sparsemat), intent(in) lift,
real(rp), dimension(elem%np,elem%np), intent(in) intrpmat_vpordm1,
real(rp), dimension(elem%np,lmesh%nez,lmesh%nex*lmesh%ney), intent(in) gnnm,
real(rp), dimension (elem%np,lmesh%nez,lmesh%nex*lmesh%ney), intent(in) g13,
real(rp), dimension (elem%np,lmesh%nez,lmesh%nex*lmesh%ney), intent(in) g23,
real(rp), dimension(elem%np,lmesh%nez,lmesh%nex*lmesh%ney), intent(in) gsqrtv,
real(rp), intent(in) impl_fac,
real(rp), intent(in) dt,
class(localmesh3d), intent(in) lmesh,
class(elementbase3d), intent(in) elem,
real(rp), dimension(elem%nfptot,lmesh%nez,lmesh%nex*lmesh%ney), intent(in) nz,
integer, dimension(elem%nfptot,lmesh%nez), intent(in) vmapm,
integer, dimension(elem%nfptot,lmesh%nez), intent(in) vmapp,
real(rp), dimension(elem%nnode_v,lmesh%nez,2,elem%nnode_h1d**2,lmesh%nex*lmesh%ney), intent(out), optional b1d_ij_uv )

Definition at line 224 of file scale_atm_dyn_dgm_nonhydro3d_etot_hevi_common.F90.

237
238 implicit none
239
240 class(LocalMesh3D), intent(in) :: lmesh
241 class(ElementBase3D), intent(in) :: elem
242 real(RP), intent(out) :: MOMX_t(elem%Np,lmesh%NeA)
243 real(RP), intent(out) :: MOMY_t(elem%Np,lmesh%NeA)
244 real(RP), intent(out) :: alph(elem%NfpTot,lmesh%NeZ,lmesh%NeX*lmesh%NeY)
245 real(RP), intent(in) :: PROG_VARS (elem%Np,lmesh%NeZ,PRGVAR_NUM,lmesh%NeX*lmesh%NeY)
246 real(RP), intent(in) :: DPRES (elem%Np,lmesh%NeZ,lmesh%NeX*lmesh%NeY)
247 real(RP), intent(in) :: PROG_VARS0 (elem%Np,lmesh%NeZ,PRGVAR_NUM,lmesh%NeX*lmesh%NeY)
248 real(RP), intent(in) :: DPRES0 (elem%Np,lmesh%NeZ,lmesh%NeX*lmesh%NeY)
249 real(RP), intent(in) :: DDENS00(elem%Np,lmesh%NeA)
250 real(RP), intent(in) :: MOMX00 (elem%Np,lmesh%NeA)
251 real(RP), intent(in) :: MOMY00 (elem%Np,lmesh%NeA)
252 real(RP), intent(in) :: MOMZ00 (elem%Np,lmesh%NeA)
253 real(RP), intent(in) :: EnTot00(elem%Np,lmesh%NeA)
254 real(RP), intent(in) :: DENS_hyd(elem%Np,lmesh%NeZ,lmesh%NeX*lmesh%NeY)
255 real(RP), intent(in) :: PRES_hyd(elem%Np,lmesh%NeZ,lmesh%NeX*lmesh%NeY)
256 real(RP), intent(in) :: Rtot(elem%Np,lmesh%NeZ,lmesh%NeX*lmesh%NeY)
257 real(RP), intent(in) :: CPtot_ov_CVtot(elem%Np,lmesh%NeZ,lmesh%NeX*lmesh%NeY)
258 class(SparseMat), intent(in) :: Dz, Lift
259 real(RP), intent(in) :: IntrpMat_VPOrdM1(elem%Np,elem%Np)
260 real(RP), intent(in) :: GnnM(elem%Np,lmesh%NeZ,lmesh%NeX*lmesh%NeY)
261 real(RP), intent(in) :: G13 (elem%Np,lmesh%NeZ,lmesh%NeX*lmesh%NeY)
262 real(RP), intent(in) :: G23 (elem%Np,lmesh%NeZ,lmesh%NeX*lmesh%NeY)
263 real(RP), intent(in) :: GsqrtV(elem%Np,lmesh%NeZ,lmesh%NeX*lmesh%NeY)
264 real(RP), intent(in) :: impl_fac
265 real(RP), intent(in) :: dt
266 real(RP), intent(in) :: nz(elem%NfpTot,lmesh%NeZ,lmesh%NeX*lmesh%NeY)
267 integer, intent(in) :: vmapM(elem%NfpTot,lmesh%NeZ)
268 integer, intent(in) :: vmapP(elem%NfpTot,lmesh%NeZ)
269 real(RP), intent(out), optional :: b1D_ij_uv(elem%Nnode_v,lmesh%NeZ,2,elem%Nnode_h1D**2,lmesh%NeX*lmesh%NeY)
270
271 real(RP) :: RGsqrtV(elem%Np)
272 real(RP) :: Fscale(elem%NfpTot)
273 real(RP) :: Fz(elem%Np), LiftDelFlx(elem%Np)
274 real(RP) :: del_flux(elem%NfpTot,lmesh%NeZ,lmesh%NeX*lmesh%NeY,PRGVAR_NUM)
275 integer :: ke_xy, ke_z
276 integer :: ke, ke2d
277 integer :: v
278 integer :: ij
279 integer :: ColMask(elem%Nnode_v)
280 real(RP) :: rdt
281
282 integer :: kk, kkk, p, pp
283 real(RP) :: vmf_v
284 !--------------------------------------------------------
285
286 rdt = 1.0_rp / dt
287
288 call vi_cal_del_flux_dyn_uv( del_flux, alph, & ! (out)
289 prog_vars, prog_vars0, dpres, dpres0, & ! (in)
290 dens_hyd, pres_hyd, & ! (in)
291 gnnm, g13, g23, gsqrtv, nz, vmapm, vmapp, & ! (in)
292 lmesh, elem ) ! (in)
293
294 !$omp parallel private( ke_xy, ke_z, ke, ke2d, ij, v, &
295 !$omp Fz, LiftDelFlx, &
296 !$omp RGsqrtV, ColMask, Fscale, &
297 !$omp kk, p, kkk, vmf_v, pp )
298
299 !$omp do collapse(2)
300 do ke_xy=1, lmesh%NeX*lmesh%NeY
301 do ke_z=1, lmesh%NeZ
302 ke = ke_xy + (ke_z-1)*lmesh%NeX*lmesh%NeY
303 ke2d = lmesh%EMap3Dto2D(ke)
304
305 rgsqrtv(:) = 1.0_rp / gsqrtv(:,ke_z,ke_xy)
306 fscale(:) = lmesh%Fscale(:,ke)
307
308 !- MOMX
309 call sparsemat_matmul(lift, fscale(:) * del_flux(:,ke_z,ke_xy,momx_vid), liftdelflx)
310 momx_t(:,ke) = - liftdelflx(:) * rgsqrtv(:)
311
312 !-MOMY
313 call sparsemat_matmul(lift, fscale(:) * del_flux(:,ke_z,ke_xy,momy_vid), liftdelflx)
314 momy_t(:,ke) = - liftdelflx(:) * rgsqrtv(:)
315
316 end do
317 end do
318 !$omp end do
319
320 if ( present( b1d_ij_uv ) ) then
321 !$omp do collapse(2)
322 do ke_xy=1, lmesh%NeX*lmesh%NeY
323 do ke_z=1, lmesh%NeZ
324 ke = ke_xy + (ke_z-1)*lmesh%NeX*lmesh%NeY
325
326 do ij=1, elem%Nnode_h1D**2
327 colmask(:) = elem%Colmask(:,ij)
328 b1d_ij_uv(:,ke_z,1,ij,ke_xy) = impl_fac * momx_t(colmask(:),ke) &
329 - prog_vars(colmask(:),ke_z,momx_vid,ke_xy) &
330 + momx00(colmask(:),ke)
331 b1d_ij_uv(:,ke_z,2,ij,ke_xy) = impl_fac * momy_t(colmask(:),ke) &
332 - prog_vars(colmask(:),ke_z,momy_vid,ke_xy) &
333 + momy00(colmask(:),ke)
334 end do
335 end do
336 end do
337 !$omp end do
338 end if
339 !$omp end parallel
340
341 return

References scale_atm_dyn_dgm_nonhydro3d_common::intrpmat_vpordm1.

Referenced by scale_atm_dyn_dgm_globalnonhydro3d_etot_hevi::atm_dyn_dgm_globalnonhydro3d_etot_hevi_cal_vi(), and scale_atm_dyn_dgm_nonhydro3d_etot_hevi::atm_dyn_dgm_nonhydro3d_etot_hevi_cal_vi().

◆ atm_dyn_dgm_nonhydro3d_etot_hevi_common_construct_matbnd()

subroutine, public scale_atm_dyn_dgm_nonhydro3d_etot_hevi_common::atm_dyn_dgm_nonhydro3d_etot_hevi_common_construct_matbnd ( real(rp), dimension(2*kl+ku+1,3,elem%nnode_v,lmesh%nez,elem%nnode_h1d**2), intent(out) pmatbnd,
integer, intent(in) kl,
integer, intent(in) ku,
integer, intent(in) nz_1d,
real(rp), dimension(elem%np,lmesh%nez,prgvar_num), intent(in) prog_vars0,
real(rp), dimension(elem%np,lmesh%nez), intent(in) kinhovdens00,
real(rp), dimension(elem%np,lmesh%nez), intent(in) dens_hyd,
real(rp), dimension(elem%np,lmesh%nez), intent(in) pres_hyd,
real(rp), dimension(elem%np,lmesh%nez), intent(in) g13,
real(rp), dimension(elem%np,lmesh%nez), intent(in) g23,
real(rp), dimension(elem%np,lmesh%nez), intent(in) gsqrtv,
real(rp), dimension(elem%nfptot,lmesh%nez), intent(in) alph,
real(rp), dimension(elem%np,lmesh%nez), intent(in) rtot,
real(rp), dimension(elem%np,lmesh%nez), intent(in) cptot_ov_cvtot,
real(rp), dimension(elem%np,lmesh%nez), intent(in) geopot,
class(sparsemat), intent(in) dz,
class(sparsemat), intent(in) lift,
real(rp), dimension(elem%np,elem%np), intent(in) intrpmat_vpordm1,
real(rp), intent(in) impl_fac,
real(rp), intent(in) dt,
class(localmesh3d), intent(in) lmesh,
class(elementbase3d), intent(in) elem,
real(rp), dimension(elem%nfptot,lmesh%nez), intent(in) nz,
integer, dimension(elem%nfptot,lmesh%nez), intent(in) vmapm,
integer, dimension(elem%nfptot,lmesh%nez), intent(in) vmapp,
integer, intent(in) ke_x,
integer, intent(in) ke_y )

Definition at line 345 of file scale_atm_dyn_dgm_nonhydro3d_etot_hevi_common.F90.

355
356 implicit none
357
358 class(LocalMesh3D), intent(in) :: lmesh
359 class(ElementBase3D), intent(in) :: elem
360 integer, intent(in) :: kl, ku, nz_1D
361 real(RP), intent(out) :: PmatBnd(2*kl+ku+1,3,elem%Nnode_v,lmesh%NeZ,elem%Nnode_h1D**2)
362 real(RP), intent(in) :: PROG_VARS0(elem%Np,lmesh%NeZ,PRGVAR_NUM)
363 real(RP), intent(in) :: KinHovDENS00(elem%Np,lmesh%NeZ)
364 real(RP), intent(in) :: DENS_hyd(elem%Np,lmesh%NeZ)
365 real(RP), intent(in) :: PRES_hyd(elem%Np,lmesh%NeZ)
366 real(RP), intent(in) :: G13(elem%Np,lmesh%NeZ)
367 real(RP), intent(in) :: G23(elem%Np,lmesh%NeZ)
368 real(RP), intent(in) :: GsqrtV(elem%Np,lmesh%NeZ)
369 real(RP), intent(in) :: alph(elem%NfpTot,lmesh%NeZ)
370 real(RP), intent(in) :: Rtot(elem%Np,lmesh%NeZ)
371 real(RP), intent(in) :: CPtot_ov_CVtot(elem%Np,lmesh%NeZ)
372 real(RP), intent(in) :: GeoPot(elem%Np,lmesh%NeZ)
373 class(SparseMat), intent(in) :: Dz, Lift
374 real(RP), intent(in) :: IntrpMat_VPOrdM1(elem%Np,elem%Np)
375 real(RP), intent(in) :: impl_fac
376 real(RP), intent(in) :: dt
377 real(RP), intent(in) :: nz(elem%NfpTot,lmesh%NeZ)
378 integer, intent(in) :: vmapM(elem%NfpTot,lmesh%NeZ)
379 integer, intent(in) :: vmapP(elem%NfpTot,lmesh%NeZ)
380 integer, intent(in) :: ke_x, ke_y
381
382 real(RP) :: Gamm_minus_One(elem%Nnode_v)
383 real(RP) :: EnthalpyOvDens0(elem%Nnode_v,lmesh%NeZ,elem%Nnode_h1D**2)
384 real(RP) :: DPresDEtot0(elem%Nnode_v,lmesh%NeZ,elem%Nnode_h1D**2)
385 real(RP) :: DpresDDENS0(elem%Nnode_v,lmesh%NeZ,elem%Nnode_h1D**2)
386 real(RP) :: DpresDMOMZ0(elem%Nnode_v,lmesh%NeZ,elem%Nnode_h1D**2)
387 real(RP) :: W0(elem%Nnode_v,lmesh%NeZ,elem%Nnode_h1D**2)
388 real(RP) :: WT0(elem%Nnode_v,lmesh%NeZ,elem%Nnode_h1D**2)
389 real(RP) :: DENS0(elem%Nnode_v,lmesh%NeZ,elem%Nnode_h1D**2)
390
391 real(RP) :: GeoPot0(elem%Nnode_v,lmesh%NeZ,elem%Nnode_h1D**2)
392
393 integer :: ke_z, ke_z2
394 integer :: v, ke, p, f1, f2, fp, fp2, FmV
395 real(RP) :: gamm, rgamm
396 real(RP) :: fac_dz_p(elem%Nnode_v)
397 real(RP) :: PmatD(elem%Nnode_v,elem%Nnode_v,3,3)
398 real(RP) :: PmatL(elem%Nnode_v,elem%Nnode_v,3,3)
399 real(RP) :: PmatU(elem%Nnode_v,elem%Nnode_v,3,3)
400
401 integer :: Colmask(elem%Nnode_v)
402 real(RP) :: Id(elem%Nnode_v,elem%Nnode_v)
403 real(RP) :: Dd(elem%Nnode_v)
404 real(RP) :: tmp1
405 real(RP) :: fac
406 integer :: ij, v1, v2, pv1, pv2, g_kj, g_kjp1, g_kjm1, pb1
407 logical :: bc_flag
408 logical :: eval_flag(3,3)
409
410 integer, parameter :: DENS_VID_LC = 1
411 integer, parameter :: MOMZ_VID_LC = 2
412 integer, parameter :: EnTot_VID_LC = 3
413
414 !--------------------------------------------------------
415
416 gamm = cpdry/cvdry
417 rgamm = cvdry/cpdry
418
419 eval_flag(:,:) = .false.
420 do v=1, 3
421 eval_flag(v,v) = .true.
422 end do
423 eval_flag(dens_vid_lc,momz_vid_lc) = .true.
424 eval_flag(momz_vid_lc,dens_vid_lc) = .true.
425 eval_flag(momz_vid_lc,entot_vid_lc) = .true.
426 eval_flag(entot_vid_lc,momz_vid_lc) = .true.
427 eval_flag(entot_vid_lc,dens_vid_lc) = .true.
428
429 id(:,:) = 0.0_rp
430 do p=1, elem%Nnode_v
431 id(p,p) = 1.0_rp
432 end do
433
434 !$omp parallel private(Gamm_minus_One, Colmask)
435 !$omp workshare
436 pmatd(:,:,:,:) = 0.0_rp
437 pmatl(:,:,:,:) = 0.0_rp
438 pmatu(:,:,:,:) = 0.0_rp
439 !$omp end workshare
440 !$omp do
441 do ij=1, elem%Nnode_h1D**2
442 pmatbnd(:,:,:,:,ij) = 0.0_rp
443 end do
444 !$omp do collapse(2)
445 do ij=1, elem%Nnode_h1D**2
446 do ke_z=1, lmesh%NeZ
447 colmask(:) = elem%Colmask(:,ij)
448
449 gamm_minus_one(:) = cptot_ov_cvtot(colmask(:),ke_z) - 1.0_rp
450
451 dens0(:,ke_z,ij) = dens_hyd(colmask(:),ke_z) + prog_vars0(colmask(:),ke_z,dens_vid)
452 w0(:,ke_z,ij) = prog_vars0(colmask(:),ke_z,momz_vid) / dens0(:,ke_z,ij)
453
454 wt0(:,ke_z,ij) = w0(:,ke_z,ij) + gsqrtv(colmask(:),ke_z) * ( &
455 g13(colmask(:),ke_z) * prog_vars0(colmask(:),ke_z,momx_vid) &
456 + g23(colmask(:),ke_z) * prog_vars0(colmask(:),ke_z,momy_vid) ) / dens0(:,ke_z,ij)
457
458 enthalpyovdens0(:,ke_z,ij) =&
459 prog_vars0(colmask(:),ke_z,etot_vid) / dens0(:,ke_z,ij) &
460 + gamm_minus_one(:) * ( prog_vars0(colmask(:),ke_z,etot_vid) / dens0(:,ke_z,ij) &
461 - ( kinhovdens00(colmask(:),ke_z) + 0.5_rp * w0(:,ke_z,ij)**2 ) &
462 - geopot(colmask(:),ke_z) )
463
464 dpresdetot0(:,ke_z,ij) = gamm_minus_one(:)
465 dpresddens0(:,ke_z,ij) = gamm_minus_one(:) * ( ( kinhovdens00(colmask(:),ke_z) + 0.5_rp * w0(:,ke_z,ij)**2 ) - geopot(colmask(:),ke_z) )
466 dpresdmomz0(:,ke_z,ij) = gamm_minus_one(:) * ( - w0(:,ke_z,ij) )
467 end do
468 end do
469 !$omp end parallel
470
471 !$omp parallel private( ke_z, ke, ColMask, p, fp, fp2, v, f1, f2, ke_z2, fac_dz_p, &
472 !$omp fac, tmp1, FmV, &
473 !$omp ij, v1, v2, pv1, pv2, pb1, g_kj, g_kjp1, g_kjm1, bc_flag, &
474 !$omp Dd ) &
475 !$omp firstprivate( PmatD, PmatL, PmatU )
476
477 !$omp do collapse(2)
478 do ij=1, elem%Nnode_h1D**2
479 do ke_z=1, lmesh%NeZ
480 ke = ke_x + (ke_y-1)*lmesh%NeX + (ke_z-1)*lmesh%NeX*lmesh%NeY
481 colmask(:) = elem%Colmask(:,ij)
482
483 !-----
484 do p=1, elem%Nnode_v
485 fac_dz_p(:) = impl_fac * lmesh%Escale(colmask(:),ke,3,3) / gsqrtv(colmask(:),ke_z) &
486 * elem%Dx3(colmask(:),colmask(p))
487
488 dd(:) = id(:,p)
489
490 ! DDENS
491 pmatd(:,p,dens_vid_lc,dens_vid_lc) = dd(:)
492 pmatd(:,p,dens_vid_lc,momz_vid_lc) = fac_dz_p(:)
493
494 ! MOMZ
495 pmatd(:,p,momz_vid_lc,momz_vid_lc) = dd(:) &
496 + fac_dz_p(:) * dpresdmomz0(p,ke_z,ij)
497 pmatd(:,p,momz_vid_lc,dens_vid_lc) = impl_fac * grav * intrpmat_vpordm1(colmask(:),colmask(p)) &
498 + fac_dz_p(:) * dpresddens0(p,ke_z,ij)
499 pmatd(:,p,momz_vid_lc,entot_vid_lc) = fac_dz_p(:) * dpresdetot0(p,ke_z,ij)
500
501 ! EnTot
502 pmatd(:,p,entot_vid_lc,dens_vid_lc) = fac_dz_p(:) * ( dpresddens0(p,ke_z,ij) - enthalpyovdens0(p,ke_z,ij) ) * w0(p,ke_z,ij) ! [ <- d_DENS ( ( EnTot + p ) * MOMZ / DENS ) ]
503 pmatd(:,p,entot_vid_lc,momz_vid_lc) = fac_dz_p(:) * ( enthalpyovdens0(p,ke_z,ij) + dpresdmomz0(p,ke_z,ij) * w0(p,ke_z,ij) ) ! [ <- d_MOMZ ( ( EnTot + p ) * MOMZ / DENS ) ]
504 pmatd(:,p,entot_vid_lc,entot_vid_lc) = dd(:) + fac_dz_p(:) * ( 1.0_rp + dpresdetot0(p,ke_z,ij) ) * w0(p,ke_z,ij) ! [ <- d_MOMZ ( ( EnTot + p ) * MOMZ / DENS ) ]
505 end do
506
507 do f1=1, 2
508 if (f1==1) then
509 ke_z2 = max(ke_z-1,1)
510 pv1 = 1; pv2 = elem%Nnode_v
511 f2 = 2
512 else
513 ke_z2 = min(ke_z+1,lmesh%NeZ)
514 pv1 = elem%Nnode_v; pv2 = 1
515 f2 = 1
516 end if
517 fac = 0.5_rp * impl_fac / gsqrtv(colmask(pv1),ke_z)
518 if ( (ke_z == 1 .and. f1==1) .or. (ke_z == lmesh%NeZ .and. f1==elem%Nfaces_v) ) then
519 bc_flag = .true.
520 pv2 = pv1; f2 = f1
521 else
522 bc_flag = .false.
523 end if
524
525 fmv = elem%Fmask_v(ij,f1)
526 fp = elem%Nfp_h * elem%Nfaces_h + (f1-1)*elem%Nfp_v + ij
527 fp2 = elem%Nfp_h * elem%Nfaces_h + (f2-1)*elem%Nfp_v + ij
528
529 !--
530 tmp1 = fac * elem%Lift(fmv,fp) * lmesh%Fscale(fp,ke) &
531 * max( alph(fp,ke_z), alph(fp2,ke_z2) )
532 if (bc_flag) then
533 pmatd(pv1,pv1,momz_vid_lc,momz_vid_lc) = pmatd(pv1,pv1,momz_vid_lc,momz_vid_lc) + 2.0_rp * tmp1
534 else
535 do v=1, 3
536 pmatd(pv1,pv1,v,v) = pmatd(pv1,pv1,v,v) + tmp1
537 if (f1 == 1) then
538 pmatl(pv1,pv2,v,v) = - tmp1
539 else
540 pmatu(pv1,pv2,v,v) = - tmp1
541 end if
542 end do
543 end if
544
545 !--
546 tmp1 = fac * elem%Lift(fmv,fp) * lmesh%Fscale(fp,ke) * nz(fp,ke_z)
547
548 if (bc_flag) then
549 pmatd(pv1,pv1,dens_vid_lc,momz_vid_lc ) = pmatd(pv1,pv1,dens_vid_lc,momz_vid_lc ) - 2.0_rp * tmp1
550 pmatd(pv1,pv1,entot_vid_lc,momz_vid_lc ) = pmatd(pv1,pv1,entot_vid_lc,momz_vid_lc ) - 2.0_rp * tmp1 * ( enthalpyovdens0(pv1,ke_z,ij) + dpresdmomz0(pv1,ke_z,ij) * wt0(pv1,ke_z,ij) )
551 pmatd(pv1,pv1,entot_vid_lc,dens_vid_lc ) = pmatd(pv1,pv1,entot_vid_lc,dens_vid_lc ) - 2.0_rp * tmp1 * ( dpresddens0(pv1,ke_z,ij) - enthalpyovdens0(pv1,ke_z,ij) ) * wt0(pv1,ke_z,ij)
552 pmatd(pv1,pv1,entot_vid_lc,entot_vid_lc) = pmatd(pv1,pv1,entot_vid_lc,entot_vid_lc) - 2.0_rp * tmp1 * ( 1.0_rp + dpresdetot0(pv1,ke_z,ij) ) * wt0(pv1,ke_z,ij)
553 else
554 pmatd(pv1,pv1,dens_vid_lc,momz_vid_lc) = pmatd(pv1,pv1,dens_vid_lc,momz_vid_lc) - tmp1
555
556 pmatd(pv1,pv1,momz_vid_lc,dens_vid_lc ) = pmatd(pv1,pv1,momz_vid_lc,dens_vid_lc ) - tmp1 * dpresddens0(pv1,ke_z,ij)
557 pmatd(pv1,pv1,momz_vid_lc,momz_vid_lc ) = pmatd(pv1,pv1,momz_vid_lc,momz_vid_lc ) - tmp1 * dpresdmomz0(pv1,ke_z,ij)
558 pmatd(pv1,pv1,momz_vid_lc,entot_vid_lc) = pmatd(pv1,pv1,momz_vid_lc,entot_vid_lc) - tmp1 * dpresdetot0(pv1,ke_z,ij)
559
560 pmatd(pv1,pv1,entot_vid_lc,momz_vid_lc ) = pmatd(pv1,pv1,entot_vid_lc,momz_vid_lc ) - tmp1 * ( enthalpyovdens0(pv1,ke_z,ij) + dpresdmomz0(pv1,ke_z,ij) * wt0(pv1,ke_z,ij) )
561 pmatd(pv1,pv1,entot_vid_lc,dens_vid_lc ) = pmatd(pv1,pv1,entot_vid_lc,dens_vid_lc ) - tmp1 * ( dpresddens0(pv1,ke_z,ij) - enthalpyovdens0(pv1,ke_z,ij) ) * wt0(pv1,ke_z,ij)
562 pmatd(pv1,pv1,entot_vid_lc,entot_vid_lc) = pmatd(pv1,pv1,entot_vid_lc,entot_vid_lc) - tmp1 * ( 1.0_rp + dpresdetot0(pv1,ke_z,ij) ) * wt0(pv1,ke_z,ij)
563
564 if (f1 == 1) then
565 pmatl(pv1,pv2,dens_vid_lc,momz_vid_lc) = + tmp1
566
567 pmatl(pv1,pv2,momz_vid_lc,dens_vid_lc ) = + tmp1 * dpresddens0(pv2,ke_z2,ij)
568 pmatl(pv1,pv2,momz_vid_lc,momz_vid_lc ) = pmatl(pv1,pv2,momz_vid_lc,momz_vid_lc ) &
569 + tmp1 * dpresdmomz0(pv2,ke_z2,ij)
570 pmatl(pv1,pv2,momz_vid_lc,entot_vid_lc) = + tmp1 * dpresdetot0(pv2,ke_z2,ij)
571
572 pmatl(pv1,pv2,entot_vid_lc,momz_vid_lc) = tmp1 * ( enthalpyovdens0(pv2,ke_z2,ij) + dpresdmomz0(pv2,ke_z2,ij) * wt0(pv2,ke_z2,ij) )
573 pmatl(pv1,pv2,entot_vid_lc,dens_vid_lc) = tmp1 * ( dpresddens0(pv2,ke_z2,ij) - enthalpyovdens0(pv2,ke_z2,ij) ) * wt0(pv2,ke_z2,ij)
574 pmatl(pv1,pv2,entot_vid_lc,entot_vid_lc) = pmatl(pv1,pv2,entot_vid_lc,entot_vid_lc) &
575 + tmp1 * ( 1.0_rp + dpresdetot0(pv2,ke_z2,ij) ) * wt0(pv2,ke_z2,ij)
576 else
577 pmatu(pv1,pv2,dens_vid_lc,momz_vid_lc) = + tmp1
578
579 pmatu(pv1,pv2,momz_vid_lc,dens_vid_lc ) = tmp1 * dpresddens0(pv2,ke_z2,ij)
580 pmatu(pv1,pv2,momz_vid_lc,momz_vid_lc ) = pmatu(pv1,pv2,momz_vid_lc,momz_vid_lc ) &
581 + tmp1 * dpresdmomz0(pv2,ke_z2,ij)
582 pmatu(pv1,pv2,momz_vid_lc,entot_vid_lc) = + tmp1 * dpresdetot0(pv2,ke_z2,ij)
583
584 pmatu(pv1,pv2,entot_vid_lc,momz_vid_lc ) = tmp1 * ( enthalpyovdens0(pv2,ke_z2,ij) + dpresdmomz0(pv2,ke_z2,ij) * wt0(pv2,ke_z2,ij) )
585 pmatu(pv1,pv2,entot_vid_lc,dens_vid_lc ) = tmp1 * ( dpresddens0(pv2,ke_z2,ij) - enthalpyovdens0(pv2,ke_z2,ij) ) * wt0(pv2,ke_z2,ij)
586 pmatu(pv1,pv2,entot_vid_lc,entot_vid_lc) = pmatu(pv1,pv2,entot_vid_lc,entot_vid_lc) &
587 + tmp1 * ( 1.0_rp + dpresdetot0(pv2,ke_z2,ij) ) * wt0(pv2,ke_z2,ij)
588 end if
589 end if
590 end do
591
592 do v2=1, 3
593 do v1=1, 3
594 if ( eval_flag(v1,v2) ) then
595 do pv2=1, elem%Nnode_v
596 g_kj = v2 + (pv2-1)*3 + (ke_z-1)*elem%Nnode_v*3
597 g_kjm1 = v2 + (pv2-1)*3 + (ke_z-2)*elem%Nnode_v*3
598 g_kjp1 = v2 + (pv2-1)*3 + (ke_z )*elem%Nnode_v*3
599
600 do pv1=1, elem%Nnode_v
601 pb1 = v1 + (pv1-1)*3 + (ke_z-1)*elem%Nnode_v*3
602
603 if (ke_z > 1 .and. pv2 == elem%Nnode_v ) then
604 pmatbnd(kl+ku+1+pb1-g_kjm1, v2,pv2,ke_z-1, ij) = pmatl(pv1,pv2,v1,v2)
605 end if
606 pmatbnd(kl+ku+1+pb1-g_kj, v2,pv2,ke_z, ij) = pmatd(pv1,pv2,v1,v2)
607 if (ke_z < lmesh%NeZ .and. pv2 == 1 ) then
608 pmatbnd(kl+ku+1+pb1-g_kjp1, v2,pv2,ke_z+1, ij) = pmatu(pv1,pv2,v1,v2)
609 end if
610 end do
611 end do
612 end if
613 end do
614 end do
615
616 end do
617 end do
618 !$omp end do
619 !$omp end parallel
620
621 return

References scale_atm_dyn_dgm_nonhydro3d_common::intrpmat_vpordm1.

Referenced by scale_atm_dyn_dgm_globalnonhydro3d_etot_hevi::atm_dyn_dgm_globalnonhydro3d_etot_hevi_cal_vi(), and scale_atm_dyn_dgm_nonhydro3d_etot_hevi::atm_dyn_dgm_nonhydro3d_etot_hevi_cal_vi().

◆ atm_dyn_dgm_nonhydro3d_etot_hevi_common_construct_matbnd_uv()

subroutine, public scale_atm_dyn_dgm_nonhydro3d_etot_hevi_common::atm_dyn_dgm_nonhydro3d_etot_hevi_common_construct_matbnd_uv ( real(rp), dimension(2*kl_uv+ku_uv+1,elem%nnode_v,1,lmesh%nez,elem%nnode_h1d**2), intent(out) pmatbnd_uv,
integer, intent(in) kl_uv,
integer, intent(in) ku_uv,
integer, intent(in) nz_1d_uv,
real(rp), dimension(elem%np,lmesh%nez,prgvar_num), intent(in) prog_vars0,
real(rp), dimension(elem%np,lmesh%nez), intent(in) kinhovdens00,
real(rp), dimension(elem%np,lmesh%nez), intent(in) dens_hyd,
real(rp), dimension(elem%np,lmesh%nez), intent(in) pres_hyd,
real(rp), dimension(elem%np,lmesh%nez), intent(in) g13,
real(rp), dimension(elem%np,lmesh%nez), intent(in) g23,
real(rp), dimension(elem%np,lmesh%nez), intent(in) gsqrtv,
real(rp), dimension(elem%nfptot,lmesh%nez), intent(in) alph,
real(rp), dimension(elem%np,lmesh%nez), intent(in) rtot,
real(rp), dimension(elem%np,lmesh%nez), intent(in) cptot_ov_cvtot,
real(rp), dimension(elem%np,lmesh%nez), intent(in) geopot,
class(sparsemat), intent(in) dz,
class(sparsemat), intent(in) lift,
real(rp), dimension(elem%np,elem%np), intent(in) intrpmat_vpordm1,
real(rp), intent(in) impl_fac,
real(rp), intent(in) dt,
class(localmesh3d), intent(in) lmesh,
class(elementbase3d), intent(in) elem,
real(rp), dimension(elem%nfptot,lmesh%nez), intent(in) nz,
integer, dimension(elem%nfptot,lmesh%nez), intent(in) vmapm,
integer, dimension(elem%nfptot,lmesh%nez), intent(in) vmapp,
integer, intent(in) ke_x,
integer, intent(in) ke_y )

Definition at line 625 of file scale_atm_dyn_dgm_nonhydro3d_etot_hevi_common.F90.

635
636 implicit none
637
638 class(LocalMesh3D), intent(in) :: lmesh
639 class(ElementBase3D), intent(in) :: elem
640 integer, intent(in) :: kl_uv, ku_uv, nz_1D_uv
641 real(RP), intent(out) :: PmatBnd_uv(2*kl_uv+ku_uv+1,elem%Nnode_v,1,lmesh%NeZ,elem%Nnode_h1D**2)
642 real(RP), intent(in) :: PROG_VARS0(elem%Np,lmesh%NeZ,PRGVAR_NUM)
643 real(RP), intent(in) :: KinHovDENS00(elem%Np,lmesh%NeZ)
644 real(RP), intent(in) :: DENS_hyd(elem%Np,lmesh%NeZ)
645 real(RP), intent(in) :: PRES_hyd(elem%Np,lmesh%NeZ)
646 real(RP), intent(in) :: G13(elem%Np,lmesh%NeZ)
647 real(RP), intent(in) :: G23(elem%Np,lmesh%NeZ)
648 real(RP), intent(in) :: GsqrtV(elem%Np,lmesh%NeZ)
649 real(RP), intent(in) :: alph(elem%NfpTot,lmesh%NeZ)
650 real(RP), intent(in) :: Rtot(elem%Np,lmesh%NeZ)
651 real(RP), intent(in) :: CPtot_ov_CVtot(elem%Np,lmesh%NeZ)
652 real(RP), intent(in) :: GeoPot(elem%Np,lmesh%NeZ)
653 class(SparseMat), intent(in) :: Dz, Lift
654 real(RP), intent(in) :: IntrpMat_VPOrdM1(elem%Np,elem%Np)
655 real(RP), intent(in) :: impl_fac
656 real(RP), intent(in) :: dt
657 real(RP), intent(in) :: nz(elem%NfpTot,lmesh%NeZ)
658 integer, intent(in) :: vmapM(elem%NfpTot,lmesh%NeZ)
659 integer, intent(in) :: vmapP(elem%NfpTot,lmesh%NeZ)
660 integer, intent(in) :: ke_x, ke_y
661
662 real(RP) :: Gamm_minus_One(elem%Nnode_v)
663 real(RP) :: EnthalpyOvDens0(elem%Nnode_v,lmesh%NeZ,elem%Nnode_h1D**2)
664 real(RP) :: DPresDEtot0(elem%Nnode_v,lmesh%NeZ,elem%Nnode_h1D**2)
665 real(RP) :: DpresDDENS0(elem%Nnode_v,lmesh%NeZ,elem%Nnode_h1D**2)
666 real(RP) :: DpresDMOMZ0(elem%Nnode_v,lmesh%NeZ,elem%Nnode_h1D**2)
667 real(RP) :: W0(elem%Nnode_v,lmesh%NeZ,elem%Nnode_h1D**2)
668 real(RP) :: DENS0(elem%Nnode_v,lmesh%NeZ,elem%Nnode_h1D**2)
669
670 real(RP) :: GeoPot0(elem%Nnode_v,lmesh%NeZ,elem%Nnode_h1D**2)
671
672 integer :: ke_z, ke_z2
673 integer :: v, ke, p, f1, f2, fp, fp2, FmV
674
675 real(RP) :: PmatD_uv(elem%Nnode_v,elem%Nnode_v)
676 real(RP) :: PmatL_uv(elem%Nnode_v,elem%Nnode_v)
677 real(RP) :: PmatU_uv(elem%Nnode_v,elem%Nnode_v)
678
679 integer :: Colmask(elem%Nnode_v)
680 real(RP) :: Id(elem%Nnode_v,elem%Nnode_v)
681 real(RP) :: Dd(elem%Nnode_v)
682 real(RP) :: tmp1
683 real(RP) :: fac
684 integer :: ij, v1, v2, pv1, pv2, g_kj, g_kjp1, g_kjm1, pb1
685 logical :: bc_flag
686 !--------------------------------------------------------
687
688 id(:,:) = 0.0_rp
689 do p=1, elem%Nnode_v
690 id(p,p) = 1.0_rp
691 end do
692
693 !$omp parallel private(Gamm_minus_One, Colmask)
694 !$omp workshare
695 pmatd_uv(:,:) = 0.0_rp
696 pmatl_uv(:,:) = 0.0_rp
697 pmatu_uv(:,:) = 0.0_rp
698 !$omp end workshare
699 !$omp do
700 do ij=1, elem%Nnode_h1D**2
701 pmatbnd_uv(:,:,:,:,ij) = 0.0_rp
702 end do
703 !$omp end parallel
704
705 !$omp parallel private( ke_z, ke, ColMask, p, fp, fp2, v, f1, f2, ke_z2, &
706 !$omp fac, tmp1, FmV, &
707 !$omp ij, v1, v2, pv1, pv2, pb1, g_kj, g_kjp1, g_kjm1, bc_flag, &
708 !$omp Dd ) &
709 !$omp firstprivate( PmatD_uv, PmatL_uv, PmatU_uv )
710
711 !$omp do collapse(2)
712 do ij=1, elem%Nnode_h1D**2
713 do ke_z=1, lmesh%NeZ
714 ke = ke_x + (ke_y-1)*lmesh%NeX + (ke_z-1)*lmesh%NeX*lmesh%NeY
715 colmask(:) = elem%Colmask(:,ij)
716
717 !-----
718 do p=1, elem%Nnode_v
719 dd(:) = id(:,p)
720
721 ! MOMX, MOMY
722 pmatd_uv(:,p) = dd(:)
723 end do
724
725 do f1=1, 2
726 if (f1==1) then
727 ke_z2 = max(ke_z-1,1)
728 pv1 = 1; pv2 = elem%Nnode_v
729 f2 = 2
730 else
731 ke_z2 = min(ke_z+1,lmesh%NeZ)
732 pv1 = elem%Nnode_v; pv2 = 1
733 f2 = 1
734 end if
735 fac = 0.5_rp * impl_fac / gsqrtv(colmask(pv1),ke_z)
736 if ( (ke_z == 1 .and. f1==1) .or. (ke_z == lmesh%NeZ .and. f1==elem%Nfaces_v) ) then
737 bc_flag = .true.
738 pv2 = pv1; f2 = f1
739 else
740 bc_flag = .false.
741 end if
742
743 fmv = elem%Fmask_v(ij,f1)
744 fp = elem%Nfp_h * elem%Nfaces_h + (f1-1)*elem%Nfp_v + ij
745 fp2 = elem%Nfp_h * elem%Nfaces_h + (f2-1)*elem%Nfp_v + ij
746
747 !--
748 tmp1 = fac * elem%Lift(fmv,fp) * lmesh%Fscale(fp,ke) &
749 * max( alph(fp,ke_z), alph(fp2,ke_z2) )
750 if (bc_flag) then
751 else
752 pmatd_uv(pv1,pv1) = pmatd_uv(pv1,pv1) + tmp1
753 if (f1 == 1) then
754 pmatl_uv(pv1,pv2) = - tmp1
755 else
756 pmatu_uv(pv1,pv2) = - tmp1
757 end if
758 end if
759 end do
760
761 ! uv
762 do pv2=1, elem%Nnode_v
763 g_kj = pv2 + (ke_z-1)*elem%Nnode_v
764 g_kjm1 = pv2 + (ke_z-2)*elem%Nnode_v
765 g_kjp1 = pv2 + (ke_z )*elem%Nnode_v
766
767 do pv1=1, elem%Nnode_v
768 pb1 = pv1 + (ke_z-1)*elem%Nnode_v
769 if (ke_z > 1 .and. pv2 == elem%Nnode_v ) then
770 pmatbnd_uv(kl_uv+ku_uv+1+pb1-g_kjm1, pv2,1,ke_z-1, ij) = pmatl_uv(pv1,pv2)
771 end if
772 pmatbnd_uv(kl_uv+ku_uv+1+pb1-g_kj, pv2,1,ke_z, ij) = pmatd_uv(pv1,pv2)
773 if (ke_z < lmesh%NeZ .and. pv2 == 1) then
774 pmatbnd_uv(kl_uv+ku_uv+1+pb1-g_kjp1, pv2,1,ke_z+1, ij) = pmatu_uv(pv1,pv2)
775 end if
776 end do
777 end do
778
779 end do
780 end do
781 !$omp end do
782 !$omp end parallel
783
784 return

References scale_atm_dyn_dgm_nonhydro3d_common::intrpmat_vpordm1.

Referenced by scale_atm_dyn_dgm_globalnonhydro3d_etot_hevi::atm_dyn_dgm_globalnonhydro3d_etot_hevi_cal_vi(), and scale_atm_dyn_dgm_nonhydro3d_etot_hevi::atm_dyn_dgm_nonhydro3d_etot_hevi_cal_vi().

Generated by doxygen 1.14.0