FE-Project
Loading...
Searching...
No Matches
Functions/Subroutines | Variables
scale_atm_dyn_dgm_nonhydro3d_rhot_hevi_common_2 Module Reference

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

Functions/Subroutines

subroutine, public atm_dyn_dgm_nonhydro3d_rhot_hevi_common_init
subroutine, public atm_dyn_dgm_nonhydro3d_rhot_hevi_common_final
subroutine, public atm_dyn_dgm_nonhydro3d_rhot_hevi_common_eval_ax (dens_t, momz_t, rhot_t, alph, prog_vars, prog_vars0, ddens00, momx00, momy00, momz00, drhot00, dens_hyd, pres_hyd, rtot, cptot, cvtot, gsqrtv, impl_fac, dt, lmesh, elem, vmapm, vmapp, element3d_operation, im, jm, b, dens, w, wt, pot, dpdrhot)
subroutine, public atm_dyn_dgm_nonhydro3d_rhot_hevi_common_solve (prog_vars, b, dens, w, wt, pot, dpdrhot, alph, gsqrtv, intrpmat_vpordm1, impl_fac, dt, vmapm, vmapp, lmesh, elem, im, jm)
subroutine, public atm_dyn_dgm_nonhydro3d_rhot_hevi_common_eval_ax_uv (momx_t, momy_t, alph, prog_vars, prog_vars0, ddens00, momx00, momy00, momz00, drhot00, dens_hyd, pres_hyd, rtot, cptot, cvtot, gsqrtv, impl_fac, dt, lmesh, elem, vmapm, vmapp, element3d_operation, im, jm, b1d_ij_uv)
subroutine, public atm_dyn_dgm_nonhydro3d_rhot_hevi_common_solve_uv (prog_vars, b_uv, alph, gsqrtv, impl_fac, dt, vmapm, vmapp, lmesh, elem, im, jm)
subroutine, public atm_dyn_dgm_nonhydro3d_rhot_hevi_common_construct_matbnd (bndmatl, bndmatd, bndmatu, dens, w, wt, pot, dpdrhot, alph, gsqrtv, nz, id, fac_dx3, fac_intrpmat_vpordm1, impl_fac, dt, lmesh, elem, im, jm, ke_z)
subroutine, public atm_dyn_dgm_nonhydro3d_rhot_hevi_common_construct_matbnd_uv (bndmatl_uv, bndmatd_uv, bndmatu_uv, alph, gsqrtv, impl_fac, dt, lmesh, elem, im, jm, vmapm, vmapp, ke_z)

Variables

logical, public vi_use_lapack_flag = .true.

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 density * potential temperature equation is used.
Author
Yuta Kawai, Team SCALE
NAMELIST
  • PARAM_ATMOS_DYN_NONHYDRO3D_RHOT_HEVI_COMMON
    nametypedefault valuecomment
    VI_USE_LAPACK_FLAGlogical.true.

History Output
No history output

Function/Subroutine Documentation

◆ atm_dyn_dgm_nonhydro3d_rhot_hevi_common_init()

subroutine, public scale_atm_dyn_dgm_nonhydro3d_rhot_hevi_common_2::atm_dyn_dgm_nonhydro3d_rhot_hevi_common_init

Definition at line 82 of file scale_atm_dyn_dgm_nonhydro3d_rhot_hevi_common_2.F90.

83 implicit none
84 namelist / param_atmos_dyn_nonhydro3d_rhot_hevi_common / &
85 vi_use_lapack_flag
86
87 integer :: ierr
88 !---------------------------------------------------------
89
90 !--- read namelist
91 rewind(io_fid_conf)
92 read(io_fid_conf,nml=param_atmos_dyn_nonhydro3d_rhot_hevi_common,iostat=ierr)
93 if( ierr < 0 ) then !--- missing
94 log_info("ATMOS_DYN_nonhydro3d_rhot_hevi_common_setup",*) 'Not found namelist. Default used.'
95 elseif( ierr > 0 ) then !--- fatal error
96 log_error("ATMOS_DYN_nonhydro3d_rhot_hevi_common_setup",*) 'Not appropriate names in namelist PARAM_ATMOS_DYN_NONHYDRO3D_RHOT_HEVI_COMMON. Check!'
97 call prc_abort
98 endif
99 log_nml(param_atmos_dyn_nonhydro3d_rhot_hevi_common)
100
101 return

References vi_use_lapack_flag.

◆ atm_dyn_dgm_nonhydro3d_rhot_hevi_common_final()

subroutine, public scale_atm_dyn_dgm_nonhydro3d_rhot_hevi_common_2::atm_dyn_dgm_nonhydro3d_rhot_hevi_common_final

Definition at line 104 of file scale_atm_dyn_dgm_nonhydro3d_rhot_hevi_common_2.F90.

105 implicit none
106 !---------------------------------------------------------
107 return

◆ atm_dyn_dgm_nonhydro3d_rhot_hevi_common_eval_ax()

subroutine, public scale_atm_dyn_dgm_nonhydro3d_rhot_hevi_common_2::atm_dyn_dgm_nonhydro3d_rhot_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) rhot_t,
real(rp), dimension(elem%nfptot,lmesh%nex*lmesh%ney,lmesh%nez), intent(in) alph,
real(rp), dimension (elem%np,lmesh%nex*lmesh%ney*lmesh%nez,prgvar_num), intent(in) prog_vars,
real(rp), dimension (elem%np,lmesh%nex*lmesh%ney*lmesh%nez,prgvar_num), intent(in) prog_vars0,
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) drhot00,
real(rp), dimension(elem%np,lmesh%nea), intent(in) dens_hyd,
real(rp), dimension(elem%np,lmesh%nea), intent(in) pres_hyd,
real(rp), dimension(elem%np,lmesh%nea), intent(in) rtot,
real(rp), dimension(elem%np,lmesh%nea), intent(in) cptot,
real(rp), dimension(elem%np,lmesh%nea), intent(in) cvtot,
real(rp), dimension(elem%np,lmesh%ne), intent(in) gsqrtv,
real(rp), intent(in) impl_fac,
real(rp), intent(in) dt,
class(localmesh3d), intent(in) lmesh,
class(elementbase3d), intent(in) elem,
integer, dimension(elem%nfptot,lmesh%ne), intent(in) vmapm,
integer, dimension(elem%nfptot,lmesh%ne), intent(in) vmapp,
class(elementoperationbase3d), intent(in) element3d_operation,
integer, intent(in) im,
integer, intent(in) jm,
real(rp), dimension(im,3,elem%nnode_v,jm,lmesh%ne), intent(out), optional b,
real(rp), dimension(im,elem%nnode_v,jm,lmesh%ne), intent(out), optional dens,
real(rp), dimension(im,elem%nnode_v,jm,lmesh%ne), intent(out), optional w,
real(rp), dimension(im,elem%nnode_v,jm,lmesh%ne), intent(out), optional wt,
real(rp), dimension(im,elem%nnode_v,jm,lmesh%ne), intent(out), optional pot,
real(rp), dimension(im,elem%nnode_v,jm,lmesh%ne), intent(out), optional dpdrhot )

Definition at line 111 of file scale_atm_dyn_dgm_nonhydro3d_rhot_hevi_common_2.F90.

125
126 implicit none
127
128 class(LocalMesh3D), intent(in) :: lmesh
129 class(ElementBase3D), intent(in) :: elem
130 integer, intent(in) :: im, jm
131 real(RP), intent(out) :: DENS_t(elem%Np,lmesh%NeA)
132 real(RP), intent(out) :: MOMZ_t(elem%Np,lmesh%NeA)
133 real(RP), intent(out) :: RHOT_t(elem%Np,lmesh%NeA)
134 real(RP), intent(in) :: alph(elem%NfpTot,lmesh%NeX*lmesh%NeY,lmesh%NeZ)
135 real(RP), intent(in) :: PROG_VARS (elem%Np,lmesh%NeX*lmesh%NeY*lmesh%NeZ,PRGVAR_NUM)
136 real(RP), intent(in) :: PROG_VARS0 (elem%Np,lmesh%NeX*lmesh%NeY*lmesh%NeZ,PRGVAR_NUM)
137 real(RP), intent(in) :: DDENS00(elem%Np,lmesh%NeA)
138 real(RP), intent(in) :: MOMX00 (elem%Np,lmesh%NeA)
139 real(RP), intent(in) :: MOMY00 (elem%Np,lmesh%NeA)
140 real(RP), intent(in) :: MOMZ00 (elem%Np,lmesh%NeA)
141 real(RP), intent(in) :: DRHOT00(elem%Np,lmesh%NeA)
142 real(RP), intent(in) :: DENS_hyd(elem%Np,lmesh%NeA)
143 real(RP), intent(in) :: PRES_hyd(elem%Np,lmesh%NeA)
144 real(RP), intent(in) :: Rtot(elem%Np,lmesh%NeA)
145 real(RP), intent(in) :: CPtot(elem%Np,lmesh%NeA)
146 real(RP), intent(in) :: CVtot(elem%Np,lmesh%NeA)
147 real(RP), intent(in) :: GsqrtV(elem%Np,lmesh%Ne)
148 real(RP), intent(in) :: impl_fac
149 real(RP), intent(in) :: dt
150 integer, intent(in) :: vmapM(elem%NfpTot,lmesh%Ne)
151 integer, intent(in) :: vmapP(elem%NfpTot,lmesh%Ne)
152 class(ElementOperationBase3D), intent(in) :: element3D_operation
153 real(RP), intent(out), optional :: b(im,3,elem%Nnode_v,jm,lmesh%Ne)
154 real(RP), intent(out), optional :: DENS(im,elem%Nnode_v,jm,lmesh%Ne)
155 real(RP), intent(out), optional :: W(im,elem%Nnode_v,jm,lmesh%Ne)
156 real(RP), intent(out), optional :: WT(im,elem%Nnode_v,jm,lmesh%Ne)
157 real(RP), intent(out), optional :: POT(im,elem%Nnode_v,jm,lmesh%Ne)
158 real(RP), intent(out), optional :: DPDRHOT(im,elem%Nnode_v,jm,lmesh%Ne)
159
160 real(RP) :: Flux(elem%Np,3), DFlux(elem%Np,2,3)
161 real(RP) :: del_flux(elem%NfpTot,PRGVAR_NUM,lmesh%Ne)
162 real(RP) :: DPRES(elem%Np), RHOT(elem%Np)
163
164 real(RP) :: rdens_, u_, v_, w_, pt_
165 real(RP) :: RGsqrtV(elem%Np), RGsqrt(elem%Np)
166 real(RP) :: Gsqrt_, GsqrtDPRES_, E33
167
168 integer :: ke_xy, ke_z
169 integer :: ke, ke2d
170 real(RP) :: rdt
171 real(RP) :: drho(elem%Np)
172
173 real(RP) :: gamm, rgamm
174 real(RP) :: rP0
175 real(RP) :: RovP0, P0ovR
176
177 integer :: i, j, p, pp, pv
178
179 real(RP) :: CPtot_ov_CVtot
180
181 logical :: flag_cal_b
182 !--------------------------------------------------------
183
184 gamm = cpdry / cvdry
185 rgamm = cvdry / cpdry
186 rp0 = 1.0_rp / pres00
187 rovp0 = rdry * rp0
188 p0ovr = pres00 / rdry
189
190 rdt = 1.0_rp / dt
191
192 if ( present(b) ) then
193 flag_cal_b = .true.
194 else
195 flag_cal_b = .false.
196 end if
197
198 call vi_cal_del_flux_dyn( del_flux, & ! (out)
199 alph, prog_vars, prog_vars0, & ! (in)
200 dens_hyd, pres_hyd, rtot, cptot, cvtot, & ! (in)
201 lmesh%Gsqrt, lmesh%GsqrtH, lmesh%gam, gsqrtv, lmesh%GI3(:,:,1), lmesh%GI3(:,:,2), & ! (in)
202 lmesh%normal_fn(:,:,3), vmapm, vmapp, elem%IndexH2Dto3D_bnd, & ! (in)
203 lmesh, elem, lmesh%lcmesh2D, lmesh%lcmesh2D%refElem2D ) ! (in)
204
205 !$omp parallel private( ke_xy, ke_z, ke, ke2d, p, i,j,pv, &
206 !$omp DPRES, RHOT, drho, pt_, Flux, DFlux, &
207 !$omp E33, RGsqrtV, CPtot_ov_CVtot )
208
209 !$omp do collapse(2)
210 do ke_z=1, lmesh%NeZ
211 do ke_xy=1, lmesh%NeX*lmesh%NeY
212 ke = ke_xy + (ke_z-1)*lmesh%NeX*lmesh%NeY
213 ke2d = lmesh%EMap3Dto2D(ke)
214
215 do p=1, elem%Np
216 rgsqrtv(p) = 1.0_rp / gsqrtv(p,ke)
217 end do
218
219 !-
220 do p=1, elem%Np
221 flux(p,dens_vid) = prog_vars(p,ke,momz_vid) &
222 + gsqrtv(p,ke) * lmesh%GI3(p,ke,1) * prog_vars(p,ke,momx_vid) &
223 + gsqrtv(p,ke) * lmesh%GI3(p,ke,2) * prog_vars(p,ke,momy_vid)
224 end do
225
226 rhot(:) = p0ovr * (pres_hyd(:,ke)/pres00)**rgamm &
227 + prog_vars(:,ke,rhot_vid)
228 do p=1, elem%Np
229 pt_ = rhot(p) / ( prog_vars(p,ke,dens_vid) + dens_hyd(p,ke) )
230 flux(p,rhot_vid) = pt_ * flux(p,dens_vid)
231 end do
232
233 do p=1, elem%Np
234 flux(p,momz_vid) = pres00 * ( rtot(p,ke) * rp0 * rhot(p) )**(cptot(p,ke) / cvtot(p,ke)) &
235 - pres_hyd(p,ke)
236 end do
237
238 !-
239 call element3d_operation%Dz( flux(:,dens_vid), dflux(:,1,dens_vid) )
240 call element3d_operation%Lift( del_flux(:,dens_vid,ke), dflux(:,2,dens_vid) )
241
242 call element3d_operation%Dz( flux(:,rhot_vid), dflux(:,1,rhot_vid) )
243 call element3d_operation%Lift( del_flux(:,rhot_vid,ke), dflux(:,2,rhot_vid) )
244
245 call element3d_operation%Dz( flux(:,momz_vid), dflux(:,1,momz_vid) )
246 call element3d_operation%Lift( del_flux(:,momz_vid,ke), dflux(:,2,momz_vid) )
247
248 !-
249 do p=1, elem%Np
250 e33 = lmesh%Escale(p,ke,3,3)
251
252 dens_t(p,ke) = - ( &
253 e33 * dflux(p,1,dens_vid) &
254 + dflux(p,2,dens_vid) ) * rgsqrtv(p)
255
256 rhot_t(p,ke) = - ( &
257 e33 * dflux(p,1,rhot_vid) &
258 + dflux(p,2,rhot_vid) ) * rgsqrtv(p)
259 end do
260
261 call element3d_operation%VFilterPM1( prog_vars(:,ke,dens_vid), &
262 drho )
263 do p=1, elem%Np
264 e33 = lmesh%Escale(p,ke,3,3)
265
266 momz_t(p,ke) = - ( &
267 e33 * dflux(p,1,momz_vid) &
268 + dflux(p,2,momz_vid) ) * rgsqrtv(p) &
269 - grav * drho(p)
270 end do
271
272 if ( flag_cal_b ) then
273 do j=1, jm
274 do pv=1, elem%Nnode_v
275 do i=1, im
276 p = i + (j-1)*im + (pv-1)*im*jm
277 dens(i,pv,j,ke) = dens_hyd(p,ke) + prog_vars(p,ke,dens_vid)
278 pot(i,pv,j,ke) = rhot(p) / dens(i,pv,j,ke)
279 w(i,pv,j,ke) = prog_vars(p,ke,momz_vid) / dens(i,pv,j,ke)
280 wt(i,pv,j,ke) = flux(p,dens_vid) / dens(i,pv,j,ke)
281 end do
282 end do
283 end do
284 do j=1, jm
285 do pv=1, elem%Nnode_v
286 do i=1, im
287 p = i + (j-1)*im + (pv-1)*im*jm
288 cptot_ov_cvtot = cptot(p,ke) / cvtot(p,ke)
289 dpdrhot(i,pv,j,ke) = cptot_ov_cvtot &
290 * pres00 * ( rtot(p,ke) / pres00 * rhot(p) )**cptot_ov_cvtot &
291 / rhot(p)
292 end do
293 end do
294 end do
295 end if
296
297 end do
298 end do
299 !$omp end do
300
301 if ( flag_cal_b ) then
302 !$omp do collapse(2)
303 do ke=1, lmesh%Ne
304 do pv=1, elem%Nnode_v
305 do j=1, jm
306 do i=1, im
307 p = i + (j-1)*im + (pv-1)*im*jm
308 b(i,1,pv,j,ke) = impl_fac * dens_t(p,ke) &
309 - prog_vars(p,ke,dens_vid) &
310 + ddens00(p,ke)
311 b(i,2,pv,j,ke) = impl_fac * momz_t(p,ke) &
312 - prog_vars(p,ke,momz_vid) &
313 + momz00(p,ke)
314 b(i,3,pv,j,ke) = impl_fac * rhot_t(p,ke) &
315 - prog_vars(p,ke,rhot_vid) &
316 + drhot00(p,ke)
317 end do
318 end do
319 end do
320 end do
321 !$omp end do
322 end if
323 !$omp end parallel
324
325 return

Referenced by scale_atm_dyn_dgm_globalnonhydro3d_rhot_hevi::atm_dyn_dgm_globalnonhydro3d_rhot_hevi_cal_vi(), and scale_atm_dyn_dgm_nonhydro3d_rhot_hevi::atm_dyn_dgm_nonhydro3d_rhot_hevi_cal_vi().

◆ atm_dyn_dgm_nonhydro3d_rhot_hevi_common_solve()

subroutine, public scale_atm_dyn_dgm_nonhydro3d_rhot_hevi_common_2::atm_dyn_dgm_nonhydro3d_rhot_hevi_common_solve ( real(rp), dimension (elem%nnode_h1d**2,elem%nnode_v,lmesh%nex*lmesh%ney,lmesh%nez,prgvar_num), intent(inout) prog_vars,
real(rp), dimension(im,3*elem%nnode_v,jm,lmesh%ne2d,lmesh%nez), intent(inout) b,
real(rp), dimension(im,elem%nnode_v,jm,lmesh%ne2d,lmesh%nez), intent(in) dens,
real(rp), dimension(im,elem%nnode_v,jm,lmesh%ne2d,lmesh%nez), intent(in) w,
real(rp), dimension(im,elem%nnode_v,jm,lmesh%ne2d,lmesh%nez), intent(in) wt,
real(rp), dimension(im,elem%nnode_v,jm,lmesh%ne2d,lmesh%nez), intent(in) pot,
real(rp), dimension(im,elem%nnode_v,jm,lmesh%ne2d,lmesh%nez), intent(in) dpdrhot,
real(rp), dimension(elem%nfptot,lmesh%ne), intent(in) alph,
real(rp), dimension(elem%np,lmesh%ne), intent(in) gsqrtv,
real(rp), dimension(elem%np,elem%np), intent(in) intrpmat_vpordm1,
real(rp), intent(in) impl_fac,
real(rp), intent(in) dt,
integer, dimension(elem%nfptot,lmesh%ne), intent(in) vmapm,
integer, dimension(elem%nfptot,lmesh%ne), intent(in) vmapp,
class(localmesh3d), intent(in) lmesh,
class(elementbase3d), intent(in) elem,
integer, intent(in) im,
integer, intent(in) jm )

Definition at line 329 of file scale_atm_dyn_dgm_nonhydro3d_rhot_hevi_common_2.F90.

334 use scale_atm_dyn_dgm_hevi_common_linalgebra, only: &
335 linkernel_solve_var3 => atm_dyn_dgm_hevi_common_linalgebra_solve_var3
336
337 implicit none
338 class(LocalMesh3D), intent(in) :: lmesh
339 class(ElementBase3D), intent(in) :: elem
340 integer, intent(in) :: im
341 integer, intent(in) :: jm
342 real(RP), intent(inout) :: PROG_VARS (elem%Nnode_h1D**2,elem%Nnode_v,lmesh%NeX*lmesh%NeY,lmesh%NeZ,PRGVAR_NUM)
343 real(RP), intent(inout) :: b(im,3*elem%Nnode_v,jm,lmesh%Ne2D,lmesh%NeZ)
344 real(RP), intent(in) :: DENS(im,elem%Nnode_v,jm,lmesh%Ne2D,lmesh%NeZ)
345 real(RP), intent(in) :: W(im,elem%Nnode_v,jm,lmesh%Ne2D,lmesh%NeZ)
346 real(RP), intent(in) :: WT(im,elem%Nnode_v,jm,lmesh%Ne2D,lmesh%NeZ)
347 real(RP), intent(in) :: POT(im,elem%Nnode_v,jm,lmesh%Ne2D,lmesh%NeZ)
348 real(RP), intent(in) :: DPDRHOT(im,elem%Nnode_v,jm,lmesh%Ne2D,lmesh%NeZ)
349 real(RP), intent(in) :: alph(elem%NfpTot,lmesh%Ne)
350 real(RP), intent(in) :: GsqrtV(elem%Np,lmesh%Ne)
351 real(RP), intent(in) :: IntrpMat_VPOrdM1(elem%Np,elem%Np)
352 real(RP), intent(in) :: impl_fac
353 real(RP), intent(in) :: dt
354 integer, intent(in) :: vmapM(elem%NfpTot,lmesh%Ne)
355 integer, intent(in) :: vmapP(elem%NfpTot,lmesh%Ne)
356
357 real(RP) :: tmp_v3(3)
358 real(RP) :: BndMatD(im,3*elem%Nnode_v,3*elem%Nnode_v,jm,lmesh%Ne2D)
359 real(RP) :: BndMatL(im,3*elem%Nnode_v,3,jm,lmesh%Ne2D)
360 real(RP) :: G(im,3*elem%Nnode_v,3,jm,lmesh%Ne2D,lmesh%NeZ)
361 integer :: ipiv(im,3*elem%Nnode_v)
362
363 integer :: Colmask(elem%Nnode_v)
364 real(RP) :: IntrpMat_VPOrdM1_(elem%Nnode_v,elem%Nnode_v)
365 real(RP) :: Dx3(elem%Nnode_v,elem%Nnode_v)
366 real(RP) :: Id(elem%Nnode_v,elem%Nnode_v)
367
368 integer :: ke_xy, ke_z
369 integer :: i, j, ij, pv, pv2
370 integer :: v
371 integer :: pp
372 integer :: p, p1, p2, p3
373 !-----------------------------------------------------------------
374
375 ij = 1
376 colmask(:) = elem%Colmask(:,ij)
377 do pv2=1, elem%Nnode_v
378 do pv=1, elem%Nnode_v
379 p = ij + (pv-1)*elem%Nnode_h1D**2
380 dx3(pv,pv2) = impl_fac * elem%Dx3(p,colmask(pv2))
381 intrpmat_vpordm1_(pv,pv2) = impl_fac * grav * intrpmat_vpordm1(p,colmask(pv2))
382 end do
383 end do
384
385 id(:,:) = 0.0_rp
386 do pv=1, elem%Nnode_v
387 id(pv,pv) = 1.0_rp
388 end do
389
390 do ke_z=1,lmesh%NeZ
391 call atm_dyn_dgm_nonhydro3d_rhot_hevi_common_construct_matbnd( &
392 bndmatl, bndmatd, g(:,:,:,:,:,ke_z), & ! (out)
393 dens, w, wt, pot, dpdrhot, alph, &
394 gsqrtv, lmesh%normal_fn(:,:,3), id, dx3, intrpmat_vpordm1_, &
395 impl_fac, dt, lmesh, elem, im, jm, ke_z )
396
397 call prof_rapstart( 'hevi_cal_vi_lin', 3)
398! call PROF_rapstart( 'hevi_cal_vi_lin_pre', 3)
399 if ( ke_z > 1 ) then
400 !$omp parallel do private( ke_xy,j,pv,i,v, p1,p2,p3,tmp_v3 ) collapse(2)
401 do ke_xy=1, lmesh%NeX * lmesh%NeY
402 do j=1, jm
403 do pv=1, 3*elem%Nnode_v
404 do i=1, im
405 p1 = 1 + (elem%Nnode_v-1)*3
406 p2 = p1 + 1
407 p3 = p1 + 2
408
409 tmp_v3(:) = bndmatl(i,pv,:,j,ke_xy)
410 bndmatd(i,pv,1,j,ke_xy) = bndmatd(i,pv,1,j,ke_xy) &
411 - tmp_v3(1) * g(i,p1,1,j,ke_xy,ke_z-1) &
412 - tmp_v3(2) * g(i,p2,1,j,ke_xy,ke_z-1) &
413 - tmp_v3(3) * g(i,p3,1,j,ke_xy,ke_z-1)
414 bndmatd(i,pv,2,j,ke_xy) = bndmatd(i,pv,2,j,ke_xy) &
415 - tmp_v3(1) * g(i,p1,2,j,ke_xy,ke_z-1) &
416 - tmp_v3(2) * g(i,p2,2,j,ke_xy,ke_z-1) &
417 - tmp_v3(3) * g(i,p3,2,j,ke_xy,ke_z-1)
418 bndmatd(i,pv,3,j,ke_xy) = bndmatd(i,pv,3,j,ke_xy) &
419 - tmp_v3(1) * g(i,p1,3,j,ke_xy,ke_z-1) &
420 - tmp_v3(2) * g(i,p2,3,j,ke_xy,ke_z-1) &
421 - tmp_v3(3) * g(i,p3,3,j,ke_xy,ke_z-1)
422 b(i,pv,j,ke_xy,ke_z) = b(i,pv,j,ke_xy,ke_z) &
423 - tmp_v3(1) * b(i,p1,j,ke_xy,ke_z-1) &
424 - tmp_v3(2) * b(i,p2,j,ke_xy,ke_z-1) &
425 - tmp_v3(3) * b(i,p3,j,ke_xy,ke_z-1)
426 end do
427 end do
428 end do
429 end do
430 end if
431! call PROF_rapend( 'hevi_cal_vi_lin_pre', 3)
432
433 call prof_rapstart( 'hevi_cal_vi_lin_core', 3)
434 call linkernel_solve_var3( bndmatd, b(:,:,:,:,ke_z), g(:,:,:,:,:,ke_z), &
435 elem%Nnode_v, im, jm, lmesh%Ne2D, ke_z == lmesh%NeZ )
436
437 call prof_rapend( 'hevi_cal_vi_lin_core', 3)
438 call prof_rapend( 'hevi_cal_vi_lin', 3)
439 end do
440
441 call prof_rapstart( 'hevi_cal_vi_lin', 3)
442! call PROF_rapstart( 'hevi_cal_vi_lin_post', 3)
443 do ke_z=lmesh%NeZ-1, 1, -1
444 !$omp parallel do private( ke_xy,j,pv,i, tmp_v3 ) collapse(2)
445 do ke_xy=1, lmesh%NeX * lmesh%NeY
446 do j=1, jm
447 do pv=1, 3*elem%Nnode_v
448 do i=1, im
449 tmp_v3(:) = g(i,pv,:,j,ke_xy,ke_z)
450 b(i,pv,j,ke_xy,ke_z) = b(i,pv,j,ke_xy,ke_z) &
451 - tmp_v3(1) * b(i,1,j,ke_xy,ke_z+1) &
452 - tmp_v3(2) * b(i,2,j,ke_xy,ke_z+1) &
453 - tmp_v3(3) * b(i,3,j,ke_xy,ke_z+1)
454 end do
455 end do
456 end do
457 end do
458 end do
459 !$omp parallel do collapse(3) private(pv,i,j,p1,pp)
460 do ke_z=1, lmesh%NeZ
461 do ke_xy=1, lmesh%NeX * lmesh%NeY
462 do j=1, jm
463 do pv=1, elem%Nnode_v
464 do i=1, im
465 p1 = 1 + (pv-1)*3
466 pp = i + (j-1)*im
467 prog_vars(pp,pv,ke_xy,ke_z,dens_vid) = prog_vars(pp,pv,ke_xy,ke_z,dens_vid) + b(i,p1 ,j,ke_xy,ke_z)
468 prog_vars(pp,pv,ke_xy,ke_z,momz_vid) = prog_vars(pp,pv,ke_xy,ke_z,momz_vid) + b(i,p1+1,j,ke_xy,ke_z)
469 prog_vars(pp,pv,ke_xy,ke_z,rhot_vid) = prog_vars(pp,pv,ke_xy,ke_z,rhot_vid) + b(i,p1+2,j,ke_xy,ke_z)
470 end do
471 end do
472 end do
473 end do
474 end do
475! call PROF_rapend( 'hevi_cal_vi_lin_post', 3)
476 call prof_rapend( 'hevi_cal_vi_lin', 3)
477
478 return
scale_atm_dyn_dgm_hevi_common_linalgebra
module FElib / Fluid dyn solver / Atmosphere / HEVI / Common
Definition scale_atm_dyn_dgm_hevi_common_linalgebra.F90:17
scale_atm_dyn_dgm_hevi_common_linalgebra::atm_dyn_dgm_hevi_common_linalgebra_solve_var3
subroutine, public atm_dyn_dgm_hevi_common_linalgebra_solve_var3(d, b, g, nnode_v, im, jm, ne2d, is_top)
Definition scale_atm_dyn_dgm_hevi_common_linalgebra.F90:203

References scale_atm_dyn_dgm_hevi_common_linalgebra::atm_dyn_dgm_hevi_common_linalgebra_solve_var3(), atm_dyn_dgm_nonhydro3d_rhot_hevi_common_construct_matbnd(), and scale_atm_dyn_dgm_nonhydro3d_common::intrpmat_vpordm1.

Referenced by scale_atm_dyn_dgm_globalnonhydro3d_rhot_hevi::atm_dyn_dgm_globalnonhydro3d_rhot_hevi_cal_vi(), and scale_atm_dyn_dgm_nonhydro3d_rhot_hevi::atm_dyn_dgm_nonhydro3d_rhot_hevi_cal_vi().

◆ atm_dyn_dgm_nonhydro3d_rhot_hevi_common_eval_ax_uv()

subroutine, public scale_atm_dyn_dgm_nonhydro3d_rhot_hevi_common_2::atm_dyn_dgm_nonhydro3d_rhot_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%ne), intent(out) alph,
real(rp), dimension (elem%np,lmesh%ne,prgvar_num), intent(in) prog_vars,
real(rp), dimension (elem%np,lmesh%ne,prgvar_num), intent(in) prog_vars0,
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) drhot00,
real(rp), dimension(elem%np,lmesh%nea), intent(in) dens_hyd,
real(rp), dimension(elem%np,lmesh%nea), intent(in) pres_hyd,
real(rp), dimension(elem%np,lmesh%nea), intent(in) rtot,
real(rp), dimension(elem%np,lmesh%nea), intent(in) cptot,
real(rp), dimension(elem%np,lmesh%nea), intent(in) cvtot,
real(rp), dimension(elem%np,lmesh%ne), intent(in) gsqrtv,
real(rp), intent(in) impl_fac,
real(rp), intent(in) dt,
class(localmesh3d), intent(in) lmesh,
class(elementbase3d), intent(in) elem,
integer, dimension(elem%nfptot,lmesh%ne), intent(in) vmapm,
integer, dimension(elem%nfptot,lmesh%ne), intent(in) vmapp,
class(elementoperationbase3d), intent(in) element3d_operation,
integer, intent(in) im,
integer, intent(in) jm,
real(rp), dimension(im*elem%nnode_v,2,jm,lmesh%ne), intent(out), optional b1d_ij_uv )

Definition at line 482 of file scale_atm_dyn_dgm_nonhydro3d_rhot_hevi_common_2.F90.

495
496 implicit none
497
498 class(LocalMesh3D), intent(in) :: lmesh
499 class(ElementBase3D), intent(in) :: elem
500 real(RP), intent(out) :: MOMX_t(elem%Np,lmesh%NeA)
501 real(RP), intent(out) :: MOMY_t(elem%Np,lmesh%NeA)
502 real(RP), intent(out) :: alph(elem%NfpTot,lmesh%Ne)
503 real(RP), intent(in) :: PROG_VARS (elem%Np,lmesh%Ne,PRGVAR_NUM)
504 real(RP), intent(in) :: PROG_VARS0 (elem%Np,lmesh%Ne,PRGVAR_NUM)
505 real(RP), intent(in) :: DDENS00(elem%Np,lmesh%NeA)
506 real(RP), intent(in) :: MOMX00 (elem%Np,lmesh%NeA)
507 real(RP), intent(in) :: MOMY00 (elem%Np,lmesh%NeA)
508 real(RP), intent(in) :: MOMZ00 (elem%Np,lmesh%NeA)
509 real(RP), intent(in) :: DRHOT00(elem%Np,lmesh%NeA)
510 real(RP), intent(in) :: DENS_hyd(elem%Np,lmesh%NeA)
511 real(RP), intent(in) :: PRES_hyd(elem%Np,lmesh%NeA)
512 real(RP), intent(in) :: Rtot(elem%Np,lmesh%NeA)
513 real(RP), intent(in) :: CPtot(elem%Np,lmesh%NeA)
514 real(RP), intent(in) :: CVtot(elem%Np,lmesh%NeA)
515 real(RP), intent(in) :: GsqrtV(elem%Np,lmesh%Ne)
516 real(RP), intent(in) :: impl_fac
517 real(RP), intent(in) :: dt
518 integer, intent(in) :: vmapM(elem%NfpTot,lmesh%Ne)
519 integer, intent(in) :: vmapP(elem%NfpTot,lmesh%Ne)
520 class(ElementOperationBase3D), intent(in) :: element3D_operation
521 integer, intent(in) :: im, jm
522 real(RP), intent(out), optional :: b1D_ij_uv(im*elem%Nnode_v,2,jm,lmesh%Ne)
523
524 real(RP) :: RGsqrtV
525 real(RP) :: LiftDelFlx(elem%Np,2)
526 real(RP) :: del_flux(elem%NfpTot,2,lmesh%Ne)
527 integer :: ke_xy, ke_z
528 integer :: ke, ke2D
529 integer :: fp
530
531 integer :: i, j, p, pp, pv
532 !--------------------------------------------------------
533
534 call vi_cal_del_flux_dyn_uv( del_flux, alph, & ! (out)
535 prog_vars, prog_vars0, & ! (in)
536 dens_hyd, pres_hyd, rtot, cptot, cvtot, & ! (in)
537 lmesh%Gsqrt, lmesh%GIJ(:,:,1,1), lmesh%GIJ(:,:,1,2), lmesh%GIJ(:,:,2,2), & ! (in)
538 lmesh%GsqrtH, lmesh%gam, gsqrtv, lmesh%GI3(:,:,1), lmesh%GI3(:,:,2), & ! (in)
539 lmesh%normal_fn(:,:,3), vmapm, vmapp, elem%IndexH2Dto3D_bnd, & ! (in)
540 lmesh, elem, lmesh%lcmesh2D, lmesh%lcmesh2D%refElem2D ) ! (in)
541
542 !$omp parallel private( ke_xy, ke_z, ke, ke2D, fp, pv, i, j, p, pp, &
543 !$omp LiftDelFlx, RGsqrtV )
544
545 !$omp do collapse(2)
546 do ke_z=1, lmesh%NeZ
547 do ke_xy=1, lmesh%NeX*lmesh%NeY
548 ke = ke_xy + (ke_z-1)*lmesh%NeX*lmesh%NeY
549 ke2d = lmesh%EMap3Dto2D(ke)
550
551 call element3d_operation%Lift( del_flux(:,1,ke), liftdelflx(:,1) )
552 call element3d_operation%Lift( del_flux(:,2,ke), liftdelflx(:,2) )
553
554 do fp=1, elem%Np
555 rgsqrtv = 1.0_rp / gsqrtv(fp,ke)
556 momx_t(fp,ke) = - liftdelflx(fp,1) * rgsqrtv
557 momy_t(fp,ke) = - liftdelflx(fp,2) * rgsqrtv
558 end do
559 end do
560 end do
561 !$omp end do
562
563 if ( present( b1d_ij_uv ) ) then
564 !$omp do collapse(2)
565 do ke=1, lmesh%Ne
566 do pv=1, elem%Nnode_v
567 do j=1, jm
568 do i=1, im
569 pp = i + (pv-1)*im
570 p = i + (j-1)*im + (pv-1)*im*jm
571 b1d_ij_uv(pp,1,j,ke) = impl_fac * momx_t(p,ke) &
572 - prog_vars(p,ke,momx_vid) &
573 + momx00(p,ke)
574 b1d_ij_uv(pp,2,j,ke) = impl_fac * momy_t(p,ke) &
575 - prog_vars(p,ke,momy_vid) &
576 + momy00(p,ke)
577 end do
578 end do
579 end do
580 end do
581 !$omp end do
582 end if
583 !$omp end parallel
584
585 return

Referenced by scale_atm_dyn_dgm_globalnonhydro3d_rhot_hevi::atm_dyn_dgm_globalnonhydro3d_rhot_hevi_cal_vi(), and scale_atm_dyn_dgm_nonhydro3d_rhot_hevi::atm_dyn_dgm_nonhydro3d_rhot_hevi_cal_vi().

◆ atm_dyn_dgm_nonhydro3d_rhot_hevi_common_solve_uv()

subroutine, public scale_atm_dyn_dgm_nonhydro3d_rhot_hevi_common_2::atm_dyn_dgm_nonhydro3d_rhot_hevi_common_solve_uv ( real(rp), dimension(elem%nnode_h1d**2,elem%nnode_v,lmesh%nex*lmesh%ney,lmesh%nez,prgvar_num), intent(inout) prog_vars,
real(rp), dimension(im*elem%nnode_v,2,jm,lmesh%ne2d,lmesh%nez), intent(inout) b_uv,
real(rp), dimension(elem%nfptot,lmesh%ne), intent(in) alph,
real(rp), dimension(elem%np,lmesh%ne), intent(in) gsqrtv,
real(rp), intent(in) impl_fac,
real(rp), intent(in) dt,
integer, dimension(elem%nfptot,lmesh%ne), intent(in) vmapm,
integer, dimension(elem%nfptot,lmesh%ne), intent(in) vmapp,
class(localmesh3d), intent(in) lmesh,
class(elementbase3d), intent(in) elem,
integer, intent(in) im,
integer, intent(in) jm )

Definition at line 589 of file scale_atm_dyn_dgm_nonhydro3d_rhot_hevi_common_2.F90.

594 use scale_atm_dyn_dgm_hevi_common_linalgebra, only: &
595 linkernel_solve_uv => atm_dyn_dgm_hevi_common_linalgebra_solve_uv
596 implicit none
597 class(LocalMesh3D), intent(in) :: lmesh
598 class(ElementBase3D), intent(in) :: elem
599 integer, intent(in) :: im
600 integer, intent(in) :: jm
601 real(RP), intent(inout) :: PROG_VARS(elem%Nnode_h1D**2,elem%Nnode_v,lmesh%NeX*lmesh%NeY,lmesh%NeZ,PRGVAR_NUM)
602 real(RP), intent(inout) :: b_uv(im*elem%Nnode_v,2,jm,lmesh%Ne2D,lmesh%NeZ)
603 real(RP), intent(in) :: alph(elem%NfpTot,lmesh%Ne)
604 real(RP), intent(in) :: GsqrtV(elem%Np,lmesh%Ne)
605 real(RP), intent(in) :: impl_fac
606 real(RP), intent(in) :: dt
607 integer, intent(in) :: vmapM(elem%NfpTot,lmesh%Ne)
608 integer, intent(in) :: vmapP(elem%NfpTot,lmesh%Ne)
609
610 real(RP) :: tmp
611 real(RP) :: BndMatD_uv(im*elem%Nnode_v,elem%Nnode_v,jm,lmesh%Ne2D)
612 real(RP) :: BndMatL_uv(im*elem%Nnode_v,jm,lmesh%Ne2D)
613 real(RP) :: G_uv(im*elem%Nnode_v,jm,lmesh%Ne2D,lmesh%NeZ)
614 integer :: ipiv_uv(im*elem%Nnode_v)
615
616 integer :: ke_xy, ke_z
617 integer :: i, pv, j
618 integer :: v
619 integer :: p, pp
620 integer :: p1, p2, p3
621 !-----------------------------------------------------------------
622
623 do ke_z=1, lmesh%NeZ
624 call atm_dyn_dgm_nonhydro3d_rhot_hevi_common_construct_matbnd_uv( &
625 bndmatl_uv, bndmatd_uv, g_uv(:,:,:,ke_z), & ! (out)
626 alph, gsqrtv, impl_fac, dt, lmesh, elem, im, jm, vmapm, vmapp, & ! (in)
627 ke_z ) ! (in)
628
629 call prof_rapstart( 'hevi_cal_vi_lin_uv', 3)
630 if ( ke_z > 1 ) then
631 !$omp parallel do private( ke_xy,j,pv,i, pp,p2,tmp ) collapse(2)
632 do ke_xy=1, lmesh%NeX * lmesh%NeY
633 do j=1, jm
634 do pv=1, elem%Nnode_v
635 do i=1, im
636 pp = i + (pv-1)*im
637 p2 = i + (elem%Nnode_v-1)*im
638 tmp = bndmatl_uv(pp,j,ke_xy)
639 bndmatd_uv(pp,1,j,ke_xy) = bndmatd_uv(pp,1,j,ke_xy) - tmp * g_uv(p2,j,ke_xy,ke_z-1)
640 b_uv(pp,1,j,ke_xy,ke_z) = b_uv(pp,1,j,ke_xy,ke_z) - tmp * b_uv(p2,1,j,ke_xy,ke_z-1)
641 b_uv(pp,2,j,ke_xy,ke_z) = b_uv(pp,2,j,ke_xy,ke_z) - tmp * b_uv(p2,2,j,ke_xy,ke_z-1)
642 end do
643 end do
644 end do
645 end do
646 end if
647
648 call linkernel_solve_uv( bndmatd_uv, b_uv(:,:,:,:,ke_z), g_uv(:,:,:,ke_z), &
649 elem%Nnode_v, im, jm, lmesh%Ne2D, ke_z==lmesh%NeZ )
650
651 call prof_rapend( 'hevi_cal_vi_lin_uv', 3)
652 end do
653 call prof_rapstart( 'hevi_cal_vi_lin_uv', 3)
654 do ke_z=lmesh%NeZ-1, 1, -1
655 !$omp parallel do private( ke_xy,j,pv,i, pp,p2,tmp ) collapse(2)
656 do ke_xy=1, lmesh%NeX * lmesh%NeY
657 do j=1, jm
658 do pv=1, elem%Nnode_v
659 do i=1, im
660 pp = i + (pv-1)*im
661 p2 = i ! + (1-1)*im
662 tmp = g_uv(pp,j,ke_xy,ke_z)
663 b_uv(pp,1,j,ke_xy,ke_z) = b_uv(pp,1,j,ke_xy,ke_z) - tmp * b_uv(p2,1,j,ke_xy,ke_z+1)
664 b_uv(pp,2,j,ke_xy,ke_z) = b_uv(pp,2,j,ke_xy,ke_z) - tmp * b_uv(p2,2,j,ke_xy,ke_z+1)
665 end do
666 end do
667 end do
668 end do
669 end do
670 !$omp parallel do private(ke_z,ke_xy,j,pv,i,pp,p) collapse(2)
671 do ke_z=1, lmesh%NeZ
672 do ke_xy=1, lmesh%NeX * lmesh%NeY
673 do j=1, jm
674 do pv=1, elem%Nnode_v
675 do i=1, im
676 p = i + (pv-1)*im
677 pp = i + (j-1)*im
678 prog_vars(pp,pv,ke_xy,ke_z,momx_vid) = prog_vars(pp,pv,ke_xy,ke_z,momx_vid) + b_uv(p,1,j,ke_xy,ke_z)
679 prog_vars(pp,pv,ke_xy,ke_z,momy_vid) = prog_vars(pp,pv,ke_xy,ke_z,momy_vid) + b_uv(p,2,j,ke_xy,ke_z)
680 end do
681 end do
682 end do
683 end do
684 end do
685
686 call prof_rapend( 'hevi_cal_vi_lin_uv', 3)
687
688 return
scale_atm_dyn_dgm_hevi_common_linalgebra::atm_dyn_dgm_hevi_common_linalgebra_solve_uv
subroutine, public atm_dyn_dgm_hevi_common_linalgebra_solve_uv(d, b, g, nnode_v, im, jm, ne2d, is_top)
Definition scale_atm_dyn_dgm_hevi_common_linalgebra.F90:94

References scale_atm_dyn_dgm_hevi_common_linalgebra::atm_dyn_dgm_hevi_common_linalgebra_solve_uv(), and atm_dyn_dgm_nonhydro3d_rhot_hevi_common_construct_matbnd_uv().

Referenced by scale_atm_dyn_dgm_globalnonhydro3d_rhot_hevi::atm_dyn_dgm_globalnonhydro3d_rhot_hevi_cal_vi(), and scale_atm_dyn_dgm_nonhydro3d_rhot_hevi::atm_dyn_dgm_nonhydro3d_rhot_hevi_cal_vi().

◆ atm_dyn_dgm_nonhydro3d_rhot_hevi_common_construct_matbnd()

subroutine, public scale_atm_dyn_dgm_nonhydro3d_rhot_hevi_common_2::atm_dyn_dgm_nonhydro3d_rhot_hevi_common_construct_matbnd ( real(rp), dimension(im,3,elem%nnode_v,3,jm,lmesh%ne2d), intent(out) bndmatl,
real(rp), dimension(im,3,elem%nnode_v,3,elem%nnode_v,jm,lmesh%ne2d), intent(out) bndmatd,
real(rp), dimension(im,3,elem%nnode_v,3,jm,lmesh%ne2d), intent(out) bndmatu,
real(rp), dimension(im,elem%nnode_v,jm,lmesh%ne2d,lmesh%nez), intent(in) dens,
real(rp), dimension(im,elem%nnode_v,jm,lmesh%ne2d,lmesh%nez), intent(in) w,
real(rp), dimension(im,elem%nnode_v,jm,lmesh%ne2d,lmesh%nez), intent(in) wt,
real(rp), dimension(im,elem%nnode_v,jm,lmesh%ne2d,lmesh%nez), intent(in) pot,
real(rp), dimension(im,elem%nnode_v,jm,lmesh%ne2d,lmesh%nez), intent(in) dpdrhot,
real(rp), dimension(elem%nfptot,lmesh%ne), intent(in) alph,
real(rp), dimension(elem%np,lmesh%ne), intent(in) gsqrtv,
real(rp), dimension(elem%nfptot,lmesh%ne), intent(in) nz,
real(rp), dimension(elem%nnode_v,elem%nnode_v), intent(in) id,
real(rp), dimension(elem%nnode_v,elem%nnode_v), intent(in) fac_dx3,
real(rp), dimension(elem%nnode_v,elem%nnode_v), intent(in) fac_intrpmat_vpordm1,
real(rp), intent(in) impl_fac,
real(rp), intent(in) dt,
class(localmesh3d), intent(in) lmesh,
class(elementbase3d), intent(in) elem,
integer, intent(in) im,
integer, intent(in) jm,
integer, intent(in) ke_z )

Definition at line 693 of file scale_atm_dyn_dgm_nonhydro3d_rhot_hevi_common_2.F90.

701
702 class(LocalMesh3D), intent(in) :: lmesh
703 class(ElementBase3D), intent(in) :: elem
704 integer, intent(in) :: im, jm
705 real(RP), intent(out) :: BndMatL(im,3,elem%Nnode_v,3,jm,lmesh%Ne2D)
706 real(RP), intent(out) :: BndMatD(im,3,elem%Nnode_v,3,elem%Nnode_v,jm,lmesh%Ne2D)
707 real(RP), intent(out) :: BndMatU(im,3,elem%Nnode_v,3,jm,lmesh%Ne2D)
708 real(RP), intent(in) :: DENS(im,elem%Nnode_v,jm,lmesh%Ne2D,lmesh%NeZ)
709 real(RP), intent(in) :: W(im,elem%Nnode_v,jm,lmesh%Ne2D,lmesh%NeZ)
710 real(RP), intent(in) :: WT(im,elem%Nnode_v,jm,lmesh%Ne2D,lmesh%NeZ)
711 real(RP), intent(in) :: POT(im,elem%Nnode_v,jm,lmesh%Ne2D,lmesh%NeZ)
712 real(RP), intent(in) :: DPDRHOT(im,elem%Nnode_v,jm,lmesh%Ne2D,lmesh%NeZ)
713 real(RP), intent(in) :: alph(elem%NfpTot,lmesh%Ne)
714 real(RP), intent(in) :: GsqrtV(elem%Np,lmesh%Ne)
715 real(RP), intent(in) :: nz(elem%NfpTot,lmesh%Ne)
716 real(RP), intent(in) :: Id(elem%Nnode_v,elem%Nnode_v)
717 real(RP), intent(in) :: fac_Dx3(elem%Nnode_v,elem%Nnode_v)
718 real(RP), intent(in) :: fac_IntrpMat_VPOrdM1(elem%Nnode_v,elem%Nnode_v)
719 real(RP), intent(in) :: impl_fac
720 real(RP), intent(in) :: dt
721 integer, intent(in) :: ke_z
722
723 real(RP) :: fac_dz(im,elem%Nnode_v,elem%Nnode_v)
724 real(RP) :: tmp1(im,elem%Nnode_v)
725 real(RP) :: tmp2(im,elem%Nnode_v)
726
727 integer :: p, p2, pv, pv1, pv2
728 integer :: fp,fp2
729 integer :: ke, ke2D
730 integer :: ke_z2, ke_2
731 integer :: ij, i, j
732 integer :: f1, f2
733 integer :: v
734
735 real(RP) :: fac
736 logical :: bc_flag
737
738 integer, parameter :: DENS_VID_LC = 1
739 integer, parameter :: MOMZ_VID_LC = 2
740 integer, parameter :: RHOT_VID_LC = 3
741
742 !---------------------------------------------------------------------------
743
744 call prof_rapstart( 'hevi_cal_vi_matbnd', 3)
745
746 !$omp parallel private(ke2D,j,ke, pv,pv1,pv2, p,p2, fp,fp2, ke_z2,ke_2, i,ij, f1,f2, v, fac, bc_flag, &
747 !$omp fac_dz, tmp1, tmp2 )
748 !$omp do collapse(2)
749 do ke2d=1, lmesh%Ne2D
750 do j=1, jm
751 ke = ke2d + (ke_z-1)*lmesh%Ne2D
752
753 do pv2=1, elem%Nnode_v
754 do pv=1, elem%Nnode_v
755 do i=1, im
756 ij = i + (j-1)*im
757 p = ij + (pv-1)*im*jm
758 fac_dz(i,pv,pv2) = lmesh%Escale(p,ke,3,3) / gsqrtv(p,ke) * fac_dx3(pv,pv2)
759 end do
760 end do
761 end do
762
763 do pv2=1, elem%Nnode_v
764 do pv=1, elem%Nnode_v
765 do i=1, im
766 ! DDENS
767 bndmatd(i,dens_vid_lc,pv,dens_vid_lc,pv2,j,ke2d) = id(pv,pv2)
768 bndmatd(i,dens_vid_lc,pv,momz_vid_lc,pv2,j,ke2d) = fac_dz(i,pv,pv2)
769 bndmatd(i,dens_vid_lc,pv,rhot_vid_lc,pv2,j,ke2d) = 0.0_rp
770
771 ! MOMZ
772 bndmatd(i,momz_vid_lc,pv,momz_vid_lc,pv2,j,ke2d) = id(pv,pv2) ! &
773 !+ fac_dz_p(i,pv,pv2,j) * 2.0_RP * W0(i,pv2,j) [ <- d_MOMZ ( MOMZ x MOMZ / DENS ) ]
774 bndmatd(i,momz_vid_lc,pv,dens_vid_lc,pv2,j,ke2d) = fac_intrpmat_vpordm1(pv,pv2) ! &
775 !- fac_dz_p(i,pv,pv2,j) * W0(i,pv2,j)**2 [ <- d_DENS ( MOMZ x MOMZ / DENS ) ]
776 bndmatd(i,momz_vid_lc,pv,rhot_vid_lc,pv2,j,ke2d) = fac_dz(i,pv,pv2) * dpdrhot(i,pv2,j,ke2d,ke_z)
777
778 ! DRHOT
779 bndmatd(i,rhot_vid_lc,pv,dens_vid_lc,pv2,j,ke2d) = - fac_dz(i,pv,pv2) * pot(i,pv2,j,ke2d,ke_z) * wt(i,pv2,j,ke2d,ke_z)
780 bndmatd(i,rhot_vid_lc,pv,momz_vid_lc,pv2,j,ke2d) = fac_dz(i,pv,pv2) * pot(i,pv2,j,ke2d,ke_z)
781 bndmatd(i,rhot_vid_lc,pv,rhot_vid_lc,pv2,j,ke2d) = id(pv,pv2) + fac_dz(i,pv,pv2) * wt(i,pv2,j,ke2d,ke_z)
782 end do
783 end do
784 end do
785
786 do f1=1, 2
787 if (f1==1) then
788 ke_z2 = max(ke_z-1,1)
789 pv1 = 1; pv2 = elem%Nnode_v; f2 = 2
790 else
791 ke_z2 = min(ke_z+1,lmesh%NeZ)
792 pv1 = elem%Nnode_v; pv2 = 1; f2 = 1
793 end if
794 ke_2 = ke2d + (ke_z2-1)*lmesh%Ne2D
795
796 if ( (ke_z == 1 .and. f1==1) .or. (ke_z == lmesh%NeZ .and. f1==elem%Nfaces_v) ) then
797 bc_flag = .true.
798 pv2 = pv1; f2 = f1
799 else
800 bc_flag = .false.
801 end if
802
803 do pv=1, elem%Nnode_v
804 do i=1, im
805 ij = i + (j-1)*im
806 fp = elem%Nfp_h * elem%Nfaces_h + (f1-1)*elem%Nfp_v + ij
807 fp2 = elem%Nfp_h * elem%Nfaces_h + (f2-1)*elem%Nfp_v + ij
808 p = ij + (pv-1)*im*jm
809
810 !--
811 fac = 0.5_rp * impl_fac / gsqrtv(p,ke) * elem%Lift(p,fp) * lmesh%Fscale(fp,ke)
812 tmp1(i,pv) = fac * max( alph(fp,ke), alph(fp2,ke_2) )
813 tmp2(i,pv) = fac * nz(fp,ke)
814 end do
815 end do
816
817 !--
818
819 if ( bc_flag ) then
820 do pv=1, elem%Nnode_v
821 do i=1, im
822 ! d ( Eqs. ) / d DENS
823 bndmatd(i,rhot_vid_lc,pv,dens_vid_lc,pv1,j,ke2d) = bndmatd(i,rhot_vid_lc,pv,dens_vid_lc,pv1,j,ke2d) + 2.0_rp * tmp2(i,pv) * pot(i,pv1,j,ke2d,ke_z) * wt(i,pv1,j,ke2d,ke_z)
824
825 ! d ( Eqs. ) / d MOMZ
826 bndmatd(i,dens_vid_lc,pv,momz_vid_lc,pv1,j,ke2d) = bndmatd(i,dens_vid_lc,pv,momz_vid_lc,pv1,j,ke2d) - 2.0_rp * tmp2(i,pv)
827 bndmatd(i,momz_vid_lc,pv,momz_vid_lc,pv1,j,ke2d) = bndmatd(i,momz_vid_lc,pv,momz_vid_lc,pv1,j,ke2d) + 2.0_rp * tmp1(i,pv)
828 bndmatd(i,rhot_vid_lc,pv,momz_vid_lc,pv1,j,ke2d) = bndmatd(i,rhot_vid_lc,pv,momz_vid_lc,pv1,j,ke2d) - 2.0_rp * tmp2(i,pv) * pot(i,pv1,j,ke2d,ke_z)
829
830 ! d ( Eqs. ) / d RHOT
831 bndmatd(i,rhot_vid_lc,pv,rhot_vid_lc,pv1,j,ke2d) = bndmatd(i,rhot_vid_lc,pv,rhot_vid_lc,pv1,j,ke2d) - 2.0_rp * tmp2(i,pv) * wt(i,pv1,j,ke2d,ke_z)
832
833 end do
834 end do
835 else
836 do pv=1, elem%Nnode_v
837 do i=1, im
838 ! d ( Eqs. ) / d DENS
839 bndmatd(i,dens_vid_lc,pv,dens_vid_lc,pv1,j,ke2d) = bndmatd(i,dens_vid_lc,pv,dens_vid_lc,pv1,j,ke2d) + tmp1(i,pv)
840 bndmatd(i,rhot_vid_lc,pv,dens_vid_lc,pv1,j,ke2d) = bndmatd(i,rhot_vid_lc,pv,dens_vid_lc,pv1,j,ke2d) + tmp2(i,pv) * pot(i,pv1,j,ke2d,ke_z) * wt(i,pv1,j,ke2d,ke_z)
841
842 ! d ( Eqs. ) / d MOMZ
843 bndmatd(i,dens_vid_lc,pv,momz_vid_lc,pv1,j,ke2d) = bndmatd(i,dens_vid_lc,pv,momz_vid_lc,pv1,j,ke2d) - tmp2(i,pv)
844 bndmatd(i,momz_vid_lc,pv,momz_vid_lc,pv1,j,ke2d) = bndmatd(i,momz_vid_lc,pv,momz_vid_lc,pv1,j,ke2d) + tmp1(i,pv)
845 bndmatd(i,rhot_vid_lc,pv,momz_vid_lc,pv1,j,ke2d) = bndmatd(i,rhot_vid_lc,pv,momz_vid_lc,pv1,j,ke2d) - tmp2(i,pv) * pot(i,pv1,j,ke2d,ke_z)
846
847 ! d ( Eqs. ) / d RHOT
848 bndmatd(i,momz_vid_lc,pv,rhot_vid_lc,pv1,j,ke2d) = bndmatd(i,momz_vid_lc,pv,rhot_vid_lc,pv1,j,ke2d) - tmp2(i,pv) * dpdrhot(i,pv1,j,ke2d,ke_z)
849 bndmatd(i,rhot_vid_lc,pv,rhot_vid_lc,pv1,j,ke2d) = bndmatd(i,rhot_vid_lc,pv,rhot_vid_lc,pv1,j,ke2d) + tmp1(i,pv) &
850 - tmp2(i,pv) * wt(i,pv1,j,ke2d,ke_z)
851 end do
852 end do
853 if ( f1 == 1 ) then
854 do pv=1, elem%Nnode_v
855 do i=1, im
856 ! d ( Eqs. ) / d DENS
857 bndmatl(i,dens_vid_lc,pv,dens_vid_lc,j,ke2d) = - tmp1(i,pv)
858 bndmatl(i,momz_vid_lc,pv,dens_vid_lc,j,ke2d) = 0.0_rp
859 bndmatl(i,rhot_vid_lc,pv,dens_vid_lc,j,ke2d) = - tmp2(i,pv) * pot(i,pv2,j,ke2d,ke_z2) * wt(i,pv2,j,ke2d,ke_z2)
860 ! d ( Eqs. ) / d MOMZ
861 bndmatl(i,dens_vid_lc,pv,momz_vid_lc,j,ke2d) = + tmp2(i,pv)
862 bndmatl(i,momz_vid_lc,pv,momz_vid_lc,j,ke2d) = - tmp1(i,pv)
863 bndmatl(i,rhot_vid_lc,pv,momz_vid_lc,j,ke2d) = + tmp2(i,pv) * pot(i,pv2,j,ke2d,ke_z2)
864 ! d ( Eqs. ) / d RHOT
865 bndmatl(i,dens_vid_lc,pv,rhot_vid_lc,j,ke2d) = 0.0_rp
866 bndmatl(i,momz_vid_lc,pv,rhot_vid_lc,j,ke2d) = + tmp2(i,pv) * dpdrhot(i,pv2,j,ke2d,ke_z2)
867 bndmatl(i,rhot_vid_lc,pv,rhot_vid_lc,j,ke2d) = - tmp1(i,pv) &
868 + tmp2(i,pv) * wt(i,pv2,j,ke2d,ke_z2)
869 end do
870 end do
871 else
872 do pv=1, elem%Nnode_v
873 do i=1, im
874 ! d ( Eqs. ) / d DENS
875 bndmatu(i,dens_vid_lc,pv,dens_vid_lc,j,ke2d) = - tmp1(i,pv)
876 bndmatu(i,momz_vid_lc,pv,dens_vid_lc,j,ke2d) = 0.0_rp
877 bndmatu(i,rhot_vid_lc,pv,dens_vid_lc,j,ke2d) = - tmp2(i,pv) * pot(i,pv2,j,ke2d,ke_z2) * wt(i,pv2,j,ke2d,ke_z2)
878 ! d ( Eqs. ) / d MOMZ
879 bndmatu(i,dens_vid_lc,pv,momz_vid_lc,j,ke2d) = + tmp2(i,pv)
880 bndmatu(i,momz_vid_lc,pv,momz_vid_lc,j,ke2d) = - tmp1(i,pv)
881 bndmatu(i,rhot_vid_lc,pv,momz_vid_lc,j,ke2d) = + tmp2(i,pv) * pot(i,pv2,j,ke2d,ke_z2)
882 ! d ( Eqs. ) / d RHOT
883 bndmatu(i,dens_vid_lc,pv,rhot_vid_lc,j,ke2d) = 0.0_rp
884 bndmatu(i,momz_vid_lc,pv,rhot_vid_lc,j,ke2d) = + tmp2(i,pv) * dpdrhot(i,pv2,j,ke2d,ke_z2)
885 bndmatu(i,rhot_vid_lc,pv,rhot_vid_lc,j,ke2d) = - tmp1(i,pv) &
886 + tmp2(i,pv) * wt(i,pv2,j,ke2d,ke_z2)
887 end do
888 end do
889 end if
890 end if
891
892 end do ! end do for f
893 end do ! end for j
894 end do ! end do for ke2D
895 !$omp end do
896 !$omp end parallel
897
898 call prof_rapend( 'hevi_cal_vi_matbnd', 3)
899
900 return

Referenced by atm_dyn_dgm_nonhydro3d_rhot_hevi_common_solve().

◆ atm_dyn_dgm_nonhydro3d_rhot_hevi_common_construct_matbnd_uv()

subroutine, public scale_atm_dyn_dgm_nonhydro3d_rhot_hevi_common_2::atm_dyn_dgm_nonhydro3d_rhot_hevi_common_construct_matbnd_uv ( real(rp), dimension(im,elem%nnode_v,jm,lmesh%ne2d), intent(out) bndmatl_uv,
real(rp), dimension(im,elem%nnode_v,elem%nnode_v,jm,lmesh%ne2d), intent(out) bndmatd_uv,
real(rp), dimension(im,elem%nnode_v,jm,lmesh%ne2d), intent(out) bndmatu_uv,
real(rp), dimension(elem%nfptot,lmesh%ne), intent(in) alph,
real(rp), dimension(elem%np,lmesh%ne), intent(in) gsqrtv,
real(rp), intent(in) impl_fac,
real(rp), intent(in) dt,
class(localmesh3d), intent(in) lmesh,
class(elementbase3d), intent(in) elem,
integer, intent(in) im,
integer, intent(in) jm,
integer, dimension(elem%nfptot,lmesh%ne), intent(in) vmapm,
integer, dimension(elem%nfptot,lmesh%ne), intent(in) vmapp,
integer, intent(in) ke_z )

Definition at line 904 of file scale_atm_dyn_dgm_nonhydro3d_rhot_hevi_common_2.F90.

910
911 class(LocalMesh3D), intent(in) :: lmesh
912 class(ElementBase3D), intent(in) :: elem
913 integer, intent(in) :: im, jm
914 real(RP), intent(out) :: BndMatL_uv(im,elem%Nnode_v,jm,lmesh%Ne2D)
915 real(RP), intent(out) :: BndMatD_uv(im,elem%Nnode_v,elem%Nnode_v,jm,lmesh%Ne2D)
916 real(RP), intent(out) :: BndMatU_uv(im,elem%Nnode_v,jm,lmesh%Ne2D)
917 real(RP), intent(in) :: alph(elem%NfpTot,lmesh%Ne)
918 real(RP), intent(in) :: GsqrtV(elem%Np,lmesh%Ne)
919 real(RP), intent(in) :: impl_fac
920 real(RP), intent(in) :: dt
921 integer, intent(in) :: vmapM(elem%NfpTot,lmesh%Ne)
922 integer, intent(in) :: vmapP(elem%NfpTot,lmesh%Ne)
923 integer, intent(in) :: ke_z
924
925 integer :: Colmask(elem%Nnode_v)
926 real(RP) :: Id(elem%Nnode_v,elem%Nnode_v)
927 real(RP) :: Dd(elem%Nnode_v)
928 real(RP) :: tmp1(im,elem%Nnode_v)
929
930 integer :: p, pv, pv1, pv2
931 integer :: fp,fp2
932 integer :: ke, ke2D
933 integer :: ke_z2, ke_2
934 integer :: ij, i, j
935 integer :: f1, f2
936
937 real(RP) :: fac
938 logical :: bc_flag
939 !---------------------------------------------------------------------------
940
941 call prof_rapstart( 'hevi_cal_vi_matbnd_uv', 3)
942
943 id(:,:) = 0.0_rp
944 do p=1, elem%Nnode_v
945 id(p,p) = 1.0_rp
946 end do
947
948 !$omp parallel private(ke2D,j,ke, pv2,pv,i, f1, ke_z2, pv1,f2, bc_flag, ij,fp,fp2,p, fac,tmp1)
949 !$omp do collapse(2)
950 do ke2d=1, lmesh%Ne2D
951 do j=1, jm
952 ke = ke2d + (ke_z-1)*lmesh%Ne2D
953
954 do pv2=1, elem%Nnode_v
955 do pv=1, elem%Nnode_v
956 do i=1, im
957 bndmatd_uv(i,pv,pv2,j,ke2d) = id(pv,pv2)
958 end do
959 end do
960 end do
961
962 do f1=1, 2
963 if (f1==1) then
964 ke_z2 = max(ke_z-1,1)
965 pv1 = 1; f2 = 2
966 else
967 ke_z2 = min(ke_z+1,lmesh%NeZ)
968 pv1 = elem%Nnode_v; f2 = 1
969 end if
970 ke_2 = ke2d + (ke_z2-1)*lmesh%Ne2D
971
972 if ( (ke_z == 1 .and. f1==1) .or. (ke_z == lmesh%NeZ .and. f1==elem%Nfaces_v) ) then
973 bc_flag = .true.
974 f2 = f1
975 else
976 bc_flag = .false.
977 end if
978
979 do pv=1, elem%Nnode_v
980 do i=1, im
981 ij = i + (j-1)*im
982 fp = elem%Nfp_h * elem%Nfaces_h + (f1-1)*elem%Nfp_v + ij
983 fp2 = elem%Nfp_h * elem%Nfaces_h + (f2-1)*elem%Nfp_v + ij
984 p = ij + (pv-1)*im*jm
985
986 !--
987 fac = 0.5_rp * impl_fac / gsqrtv(p,ke)
988 tmp1(i,pv) = fac * elem%Lift(p,fp) * lmesh%Fscale(fp,ke) &
989 * max( alph(fp,ke), alph(fp2,ke_2) )
990 end do
991 end do
992
993 if (bc_flag) then
994 else
995 bndmatd_uv(:,:,pv1,j,ke2d) = bndmatd_uv(:,:,pv1,j,ke2d) + tmp1(:,:)
996 if (f1 == 1) then
997 bndmatl_uv(:,:,j,ke2d) = - tmp1(:,:)
998 else
999 bndmatu_uv(:,:,j,ke2d) = - tmp1(:,:)
1000 end if
1001 end if
1002 end do ! end do for f
1003
1004 end do ! end do for j
1005 end do ! end do for ke2D
1006 !$omp end do
1007 !$omp end parallel
1008 call prof_rapend( 'hevi_cal_vi_matbnd_uv', 3)
1009
1010 return

Referenced by atm_dyn_dgm_nonhydro3d_rhot_hevi_common_solve_uv().

Variable Documentation

◆ vi_use_lapack_flag

logical, public scale_atm_dyn_dgm_nonhydro3d_rhot_hevi_common_2::vi_use_lapack_flag = .true.

Definition at line 69 of file scale_atm_dyn_dgm_nonhydro3d_rhot_hevi_common_2.F90.

69 logical, public :: VI_use_lapack_flag = .true.

Referenced by atm_dyn_dgm_nonhydro3d_rhot_hevi_common_init().

Generated by doxygen 1.14.0