FE-Project
Loading...
Searching...
No Matches
Functions/Subroutines | Variables
scale_atm_dyn_dgm_nonhydro3d_rhot_hevi_common 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_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_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_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_rhot_hevi_common_construct_matbnd (pmatbnd, kl, ku, nz_1d, prog_vars0, dens_hyd, pres_hyd, g13, g23, gsqrtv, alph, rtot, cptot_ov_cvtot, dz, lift, intrpmat_vpordm1, impl_fac, dt, lmesh, elem, nz, vmapm, vmapp, ke_x, ke_y)
subroutine, public atm_dyn_dgm_nonhydro3d_rhot_hevi_common_construct_matbnd_uv (pmatbnd_uv, kl_uv, ku_uv, nz_1d_uv, prog_vars0, dens_hyd, pres_hyd, g13, g23, gsqrtv, alph, rtot, cptot_ov_cvtot, dz, lift, intrpmat_vpordm1, impl_fac, dt, lmesh, elem, nz, vmapm, vmapp, ke_x, ke_y)

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::atm_dyn_dgm_nonhydro3d_rhot_hevi_common_init

Definition at line 77 of file scale_atm_dyn_dgm_nonhydro3d_rhot_hevi_common.F90.

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

References vi_use_lapack_flag.

Referenced by scale_atm_dyn_dgm_globalnonhydro3d_rhot_hevi::atm_dyn_dgm_globalnonhydro3d_rhot_hevi_init(), scale_atm_dyn_dgm_nonhydro3d_rhot_hevi::atm_dyn_dgm_nonhydro3d_rhot_hevi_init(), and scale_atm_dyn_dgm_nonhydro3d_rhot_hevi_splitform::atm_dyn_dgm_nonhydro3d_rhot_hevi_splitform_init().

◆ atm_dyn_dgm_nonhydro3d_rhot_hevi_common_final()

subroutine, public scale_atm_dyn_dgm_nonhydro3d_rhot_hevi_common::atm_dyn_dgm_nonhydro3d_rhot_hevi_common_final

Definition at line 99 of file scale_atm_dyn_dgm_nonhydro3d_rhot_hevi_common.F90.

100 implicit none
101 !---------------------------------------------------------
102 return

Referenced by scale_atm_dyn_dgm_globalnonhydro3d_rhot_hevi::atm_dyn_dgm_globalnonhydro3d_rhot_hevi_final(), scale_atm_dyn_dgm_nonhydro3d_rhot_hevi::atm_dyn_dgm_nonhydro3d_rhot_hevi_final(), and scale_atm_dyn_dgm_nonhydro3d_rhot_hevi_splitform::atm_dyn_dgm_nonhydro3d_rhot_hevi_splitform_final().

◆ atm_dyn_dgm_nonhydro3d_rhot_hevi_common_eval_ax()

subroutine, public scale_atm_dyn_dgm_nonhydro3d_rhot_hevi_common::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%nez,lmesh%nex*lmesh%ney), intent(in) 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,prgvar_num,lmesh%nex*lmesh%ney), 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%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 106 of file scale_atm_dyn_dgm_nonhydro3d_rhot_hevi_common.F90.

119
120 implicit none
121
122 class(LocalMesh3D), intent(in) :: lmesh
123 class(ElementBase3D), intent(in) :: elem
124 real(RP), intent(out) :: DENS_t(elem%Np,lmesh%NeA)
125 real(RP), intent(out) :: MOMZ_t(elem%Np,lmesh%NeA)
126 real(RP), intent(out) :: RHOT_t(elem%Np,lmesh%NeA)
127 real(RP), intent(in) :: alph(elem%NfpTot,lmesh%NeZ,lmesh%NeX*lmesh%NeY)
128 real(RP), intent(in) :: PROG_VARS (elem%Np,lmesh%NeZ,PRGVAR_NUM,lmesh%NeX*lmesh%NeY)
129 real(RP), intent(in) :: PROG_VARS0 (elem%Np,lmesh%NeZ,PRGVAR_NUM,lmesh%NeX*lmesh%NeY)
130 real(RP), intent(in) :: DDENS00(elem%Np,lmesh%NeA)
131 real(RP), intent(in) :: MOMX00 (elem%Np,lmesh%NeA)
132 real(RP), intent(in) :: MOMY00 (elem%Np,lmesh%NeA)
133 real(RP), intent(in) :: MOMZ00 (elem%Np,lmesh%NeA)
134 real(RP), intent(in) :: DRHOT00(elem%Np,lmesh%NeA)
135 real(RP), intent(in) :: DENS_hyd(elem%Np,lmesh%NeZ,lmesh%NeX*lmesh%NeY)
136 real(RP), intent(in) :: PRES_hyd(elem%Np,lmesh%NeZ,lmesh%NeX*lmesh%NeY)
137 real(RP), intent(in) :: Rtot(elem%Np,lmesh%NeZ,lmesh%NeX*lmesh%NeY)
138 real(RP), intent(in) :: CPtot_ov_CVtot(elem%Np,lmesh%NeZ,lmesh%NeX*lmesh%NeY)
139 class(SparseMat), intent(in) :: Dz, Lift
140 real(RP), intent(in) :: IntrpMat_VPOrdM1(elem%Np,elem%Np)
141 real(RP), intent(in) :: GnnM(elem%Np,lmesh%NeZ,lmesh%NeX*lmesh%NeY)
142 real(RP), intent(in) :: G13 (elem%Np,lmesh%NeZ,lmesh%NeX*lmesh%NeY)
143 real(RP), intent(in) :: G23 (elem%Np,lmesh%NeZ,lmesh%NeX*lmesh%NeY)
144 real(RP), intent(in) :: GsqrtV(elem%Np,lmesh%NeZ,lmesh%NeX*lmesh%NeY)
145 real(RP), intent(in) :: impl_fac
146 real(RP), intent(in) :: dt
147 real(RP), intent(in) :: nz(elem%NfpTot,lmesh%NeZ,lmesh%NeX*lmesh%NeY)
148 integer, intent(in) :: vmapM(elem%NfpTot,lmesh%NeZ)
149 integer, intent(in) :: vmapP(elem%NfpTot,lmesh%NeZ)
150 real(RP), intent(out), optional :: b1D_ij(3,elem%Nnode_v,lmesh%NeZ,elem%Nnode_h1D**2,lmesh%NeX*lmesh%NeY)
151
152 real(RP) :: RGsqrtV(elem%Np)
153 real(RP) :: Fscale(elem%NfpTot), Escale33(elem%Np)
154 real(RP) :: Fz(elem%Np), LiftDelFlx(elem%Np)
155 real(RP) :: del_flux(elem%NfpTot,lmesh%NeZ,lmesh%NeX*lmesh%NeY,PRGVAR_NUM)
156 real(RP) :: MOMZ(elem%Np), DDENS(elem%Np), DPRES(elem%Np), RHOT(elem%Np)
157 real(RP) :: MOMW(elem%Np)
158 integer :: ke_xy, ke_z
159 integer :: ke, ke2d
160 integer :: v
161 integer :: ij
162 integer :: ColMask(elem%Nnode_v)
163 real(RP) :: rdt
164 real(RP) :: drho(elem%Np)
165
166 integer :: kk, kkk, p, pp
167 real(RP) :: vmf_v
168
169 real(RP) :: gamm, rgamm, rP0
170 !--------------------------------------------------------
171
172 gamm = cpdry/cvdry
173 rgamm = cvdry/cpdry
174 rdt = 1.0_rp / dt
175 rp0 = 1.0_rp / pres00
176
177 call vi_cal_del_flux_dyn( del_flux, &
178 alph, & ! (in)
179 prog_vars, prog_vars0, & ! (in)
180 dens_hyd, pres_hyd, & ! (in)
181 rtot, cptot_ov_cvtot, & ! (in)
182 gnnm, g13, g23, gsqrtv, nz, vmapm, vmapp, & ! (in)
183 lmesh, elem ) ! (in)
184
185 !$omp parallel private( ke_xy, ke_z, ke, ke2d, ij, v, &
186 !$omp MOMZ, MOMW, DDENS, DPRES, RHOT, Fz, LiftDelFlx, &
187 !$omp RGsqrtV, ColMask, Fscale, Escale33, drho, &
188 !$omp kk, p, kkk, vmf_v, pp )
189
190 !$omp do collapse(2)
191 do ke_xy=1, lmesh%NeX*lmesh%NeY
192 do ke_z=1, lmesh%NeZ
193 ke = ke_xy + (ke_z-1)*lmesh%NeX*lmesh%NeY
194 ke2d = lmesh%EMap3Dto2D(ke)
195
196 ddens(:) = prog_vars(:,ke_z,dens_vid,ke_xy)
197 drho(:) = matmul(intrpmat_vpordm1, ddens(:))
198
199 momz(:) = prog_vars(:,ke_z,momz_vid,ke_xy)
200
201 rhot(:) = pres00/rdry * (pres_hyd(:,ke_z,ke_xy)/pres00)**rgamm &
202 + prog_vars(:,ke_z,rhot_vid,ke_xy)
203 dpres(:) = pres00 * ( rtot(:,ke_z,ke_xy) * rp0 * rhot(:) )**cptot_ov_cvtot(:,ke_z,ke_xy) &
204 - pres_hyd(:,ke_z,ke_xy)
205
206 rgsqrtv(:) = 1.0_rp / gsqrtv(:,ke_z,ke_xy)
207 fscale(:) = lmesh%Fscale(:,ke)
208 escale33(:) = lmesh%Escale(:,ke,3,3)
209
210 momw(:) = momz(:) &
211 + gsqrtv(:,ke_z,ke_xy) * g13(:,ke_z,ke_xy) * prog_vars(:,ke_z,momx_vid,ke_xy) &
212 + gsqrtv(:,ke_z,ke_xy) * g23(:,ke_z,ke_xy) * prog_vars(:,ke_z,momy_vid,ke_xy)
213
214 !- DENS
215 call sparsemat_matmul(dz, momw(:), fz)
216 call sparsemat_matmul(lift, fscale(:) * del_flux(:,ke_z,ke_xy,dens_vid), liftdelflx)
217 dens_t(:,ke) = - ( escale33(:) * fz(:) + liftdelflx(:) ) * rgsqrtv(:)
218
219 !-MOMZ
220! call sparsemat_matmul(Dz, MOMZ(:)**2 / ( DENS_hyd(:,ke_z,ke_xy) + DDENS(:) ) + DPRES(:), Fz) ! [<- MOMZ x MOMZ / DENS + DPRES ]
221 call sparsemat_matmul(dz, dpres(:), fz)
222 call sparsemat_matmul(lift, fscale(:) * del_flux(:,ke_z,ke_xy,momz_vid), liftdelflx)
223 momz_t(:,ke) = - ( escale33(:) * fz(:) + liftdelflx(:) ) * rgsqrtv(:) &
224 - grav * drho(:)
225
226 !-RHOT
227 call sparsemat_matmul(dz, rhot(:) * momw(:) / ( dens_hyd(:,ke_z,ke_xy) + ddens(:) ), fz)
228 call sparsemat_matmul(lift, fscale(:) * del_flux(:,ke_z,ke_xy,rhot_vid), liftdelflx)
229 rhot_t(:,ke) = - ( escale33(:) * fz(:) + liftdelflx(:) ) * rgsqrtv(:)
230
231 end do
232 end do
233 !$omp end do
234
235 if ( present( b1d_ij ) ) then
236 !$omp do collapse(2)
237 do ke_xy=1, lmesh%NeX*lmesh%NeY
238 do ke_z=1, lmesh%NeZ
239 ke = ke_xy + (ke_z-1)*lmesh%NeX*lmesh%NeY
240
241 do ij=1, elem%Nnode_h1D**2
242 colmask(:) = elem%Colmask(:,ij)
243 b1d_ij(1,:,ke_z,ij,ke_xy) = impl_fac * dens_t(colmask(:),ke) &
244 - prog_vars(colmask(:),ke_z,dens_vid,ke_xy) &
245 + ddens00(colmask(:),ke)
246 b1d_ij(2,:,ke_z,ij,ke_xy) = impl_fac * momz_t(colmask(:),ke) &
247 - prog_vars(colmask(:),ke_z,momz_vid,ke_xy) &
248 + momz00(colmask(:),ke)
249 b1d_ij(3,:,ke_z,ij,ke_xy) = impl_fac * rhot_t(colmask(:),ke) &
250 - prog_vars(colmask(:),ke_z,rhot_vid,ke_xy) &
251 + drhot00(colmask(:),ke)
252 end do
253 end do
254 end do
255 !$omp end do
256 end if
257 !$omp end parallel
258
259 return

References 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_asis(), scale_atm_dyn_dgm_nonhydro3d_rhot_hevi::atm_dyn_dgm_nonhydro3d_rhot_hevi_cal_vi_asis(), and scale_atm_dyn_dgm_nonhydro3d_rhot_hevi_splitform::atm_dyn_dgm_nonhydro3d_rhot_hevi_splitform_cal_vi().

◆ atm_dyn_dgm_nonhydro3d_rhot_hevi_common_eval_ax_uv()

subroutine, public scale_atm_dyn_dgm_nonhydro3d_rhot_hevi_common::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%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,prgvar_num,lmesh%nex*lmesh%ney), 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%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 263 of file scale_atm_dyn_dgm_nonhydro3d_rhot_hevi_common.F90.

276
277 implicit none
278
279 class(LocalMesh3D), intent(in) :: lmesh
280 class(ElementBase3D), intent(in) :: elem
281 real(RP), intent(out) :: MOMX_t(elem%Np,lmesh%NeA)
282 real(RP), intent(out) :: MOMY_t(elem%Np,lmesh%NeA)
283 real(RP), intent(out) :: alph(elem%NfpTot,lmesh%NeZ,lmesh%NeX*lmesh%NeY)
284 real(RP), intent(in) :: PROG_VARS (elem%Np,lmesh%NeZ,PRGVAR_NUM,lmesh%NeX*lmesh%NeY)
285 real(RP), intent(in) :: PROG_VARS0 (elem%Np,lmesh%NeZ,PRGVAR_NUM,lmesh%NeX*lmesh%NeY)
286 real(RP), intent(in) :: DDENS00(elem%Np,lmesh%NeA)
287 real(RP), intent(in) :: MOMX00 (elem%Np,lmesh%NeA)
288 real(RP), intent(in) :: MOMY00 (elem%Np,lmesh%NeA)
289 real(RP), intent(in) :: MOMZ00 (elem%Np,lmesh%NeA)
290 real(RP), intent(in) :: DRHOT00(elem%Np,lmesh%NeA)
291 real(RP), intent(in) :: DENS_hyd(elem%Np,lmesh%NeZ,lmesh%NeX*lmesh%NeY)
292 real(RP), intent(in) :: PRES_hyd(elem%Np,lmesh%NeZ,lmesh%NeX*lmesh%NeY)
293 real(RP), intent(in) :: Rtot(elem%Np,lmesh%NeZ,lmesh%NeX*lmesh%NeY)
294 real(RP), intent(in) :: CPtot_ov_CVtot(elem%Np,lmesh%NeZ,lmesh%NeX*lmesh%NeY)
295 class(SparseMat), intent(in) :: Dz, Lift
296 real(RP), intent(in) :: IntrpMat_VPOrdM1(elem%Np,elem%Np)
297 real(RP), intent(in) :: GnnM(elem%Np,lmesh%NeZ,lmesh%NeX*lmesh%NeY)
298 real(RP), intent(in) :: G13 (elem%Np,lmesh%NeZ,lmesh%NeX*lmesh%NeY)
299 real(RP), intent(in) :: G23 (elem%Np,lmesh%NeZ,lmesh%NeX*lmesh%NeY)
300 real(RP), intent(in) :: GsqrtV(elem%Np,lmesh%NeZ,lmesh%NeX*lmesh%NeY)
301 real(RP), intent(in) :: impl_fac
302 real(RP), intent(in) :: dt
303 real(RP), intent(in) :: nz(elem%NfpTot,lmesh%NeZ,lmesh%NeX*lmesh%NeY)
304 integer, intent(in) :: vmapM(elem%NfpTot,lmesh%NeZ)
305 integer, intent(in) :: vmapP(elem%NfpTot,lmesh%NeZ)
306 real(RP), intent(out), optional :: b1D_ij_uv(elem%Nnode_v,lmesh%NeZ,2,elem%Nnode_h1D**2,lmesh%NeX*lmesh%NeY)
307
308 real(RP) :: RGsqrtV(elem%Np)
309 real(RP) :: Fscale(elem%NfpTot), Escale33(elem%Np)
310 real(RP) :: Fz(elem%Np), LiftDelFlx(elem%Np)
311 real(RP) :: del_flux(elem%NfpTot,lmesh%NeZ,lmesh%NeX*lmesh%NeY,PRGVAR_NUM)
312 integer :: ke_xy, ke_z
313 integer :: ke
314 integer :: v
315 integer :: ij
316 integer :: ColMask(elem%Nnode_v)
317
318 integer :: kk, kkk, p, pp
319 !--------------------------------------------------------
320
321 call vi_cal_del_flux_dyn_uv( del_flux, alph, & ! (out)
322 prog_vars, prog_vars0, & ! (in)
323 dens_hyd, pres_hyd, & ! (in)
324 rtot, cptot_ov_cvtot, & ! (in)
325 gnnm, g13, g23, gsqrtv, nz, vmapm, vmapp, & ! (in)
326 lmesh, elem ) ! (in)
327
328 !$omp parallel private( ke_xy, ke_z, ke, ij, v, &
329 !$omp Fz, LiftDelFlx, Fscale, RGsqrtV, ColMask, &
330 !$omp kk, p, kkk, pp )
331
332 !$omp do collapse(2)
333 do ke_xy=1, lmesh%NeX*lmesh%NeY
334 do ke_z=1, lmesh%NeZ
335 ke = ke_xy + (ke_z-1)*lmesh%NeX*lmesh%NeY
336
337 rgsqrtv(:) = 1.0_rp / gsqrtv(:,ke_z,ke_xy)
338 fscale(:) = lmesh%Fscale(:,ke)
339
340 !- MOMX
341 call sparsemat_matmul(lift, fscale(:) * del_flux(:,ke_z,ke_xy,momx_vid), liftdelflx)
342 momx_t(:,ke) = - liftdelflx(:) * rgsqrtv(:)
343
344 !-MOMY
345 call sparsemat_matmul(lift, fscale(:) * del_flux(:,ke_z,ke_xy,momy_vid), liftdelflx)
346 momy_t(:,ke) = - liftdelflx(:) * rgsqrtv(:)
347 end do
348 end do
349 !$omp end do
350
351 if ( present( b1d_ij_uv ) ) then
352 !$omp do collapse(2)
353 do ke_xy=1, lmesh%NeX*lmesh%NeY
354 do ke_z=1, lmesh%NeZ
355 ke = ke_xy + (ke_z-1)*lmesh%NeX*lmesh%NeY
356
357 do ij=1, elem%Nnode_h1D**2
358 colmask(:) = elem%Colmask(:,ij)
359 b1d_ij_uv(:,ke_z,1,ij,ke_xy) = impl_fac * momx_t(colmask(:),ke) &
360 - prog_vars(colmask(:),ke_z,momx_vid,ke_xy) &
361 + momx00(colmask(:),ke)
362 b1d_ij_uv(:,ke_z,2,ij,ke_xy) = impl_fac * momy_t(colmask(:),ke) &
363 - prog_vars(colmask(:),ke_z,momy_vid,ke_xy) &
364 + momy00(colmask(:),ke)
365 end do
366 end do
367 end do
368 !$omp end do
369 end if
370 !$omp end parallel
371
372 return

References 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_asis(), scale_atm_dyn_dgm_nonhydro3d_rhot_hevi::atm_dyn_dgm_nonhydro3d_rhot_hevi_cal_vi_asis(), and scale_atm_dyn_dgm_nonhydro3d_rhot_hevi_splitform::atm_dyn_dgm_nonhydro3d_rhot_hevi_splitform_cal_vi().

◆ atm_dyn_dgm_nonhydro3d_rhot_hevi_common_construct_matbnd()

subroutine, public scale_atm_dyn_dgm_nonhydro3d_rhot_hevi_common::atm_dyn_dgm_nonhydro3d_rhot_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) 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,
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 376 of file scale_atm_dyn_dgm_nonhydro3d_rhot_hevi_common.F90.

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

References 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_asis(), scale_atm_dyn_dgm_nonhydro3d_rhot_hevi::atm_dyn_dgm_nonhydro3d_rhot_hevi_cal_vi_asis(), and scale_atm_dyn_dgm_nonhydro3d_rhot_hevi_splitform::atm_dyn_dgm_nonhydro3d_rhot_hevi_splitform_cal_vi().

◆ atm_dyn_dgm_nonhydro3d_rhot_hevi_common_construct_matbnd_uv()

subroutine, public scale_atm_dyn_dgm_nonhydro3d_rhot_hevi_common::atm_dyn_dgm_nonhydro3d_rhot_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) 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,
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 646 of file scale_atm_dyn_dgm_nonhydro3d_rhot_hevi_common.F90.

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

References 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_asis(), scale_atm_dyn_dgm_nonhydro3d_rhot_hevi::atm_dyn_dgm_nonhydro3d_rhot_hevi_cal_vi_asis(), and scale_atm_dyn_dgm_nonhydro3d_rhot_hevi_splitform::atm_dyn_dgm_nonhydro3d_rhot_hevi_splitform_cal_vi().

Variable Documentation

◆ vi_use_lapack_flag

logical, public scale_atm_dyn_dgm_nonhydro3d_rhot_hevi_common::vi_use_lapack_flag = .true.

Definition at line 64 of file scale_atm_dyn_dgm_nonhydro3d_rhot_hevi_common.F90.

64 logical, public :: VI_use_lapack_flag = .true.

Referenced by scale_atm_dyn_dgm_globalnonhydro3d_rhot_hevi::atm_dyn_dgm_globalnonhydro3d_rhot_hevi_cal_vi_asis(), scale_atm_dyn_dgm_nonhydro3d_rhot_hevi::atm_dyn_dgm_nonhydro3d_rhot_hevi_cal_vi_asis(), atm_dyn_dgm_nonhydro3d_rhot_hevi_common_init(), and scale_atm_dyn_dgm_nonhydro3d_rhot_hevi_splitform::atm_dyn_dgm_nonhydro3d_rhot_hevi_splitform_cal_vi().

Generated by doxygen 1.14.0