44 type :: veccovariantcomp
45 type(MeshField2D),
pointer :: u1 => null()
46 type(MeshField2D),
pointer :: u2 => null()
52 type(veccovariantcomp),
allocatable :: vec_covariant_comp_ptrlist(:)
54 integer :: halosize_1d
56 procedure,
public :: init => meshfieldcommcubedspheredom2d_init
57 procedure,
public :: put => meshfieldcommcubedspheredom2d_put
58 procedure,
public :: get => meshfieldcommcubedspheredom2d_get
59 procedure,
public :: exchange => meshfieldcommcubedspheredom2d_exchange
60 procedure,
public :: setcovariantvec => meshfieldcommcubedspheredom2d_set_covariantvec
61 procedure,
public :: final => meshfieldcommcubedspheredom2d_final
73 private :: post_exchange_core
74 private :: push_localsendbuf
84 subroutine meshfieldcommcubedspheredom2d_init( this, &
85 sfield_num, hvfield_num, htensorfield_num, mesh2d, &
92 integer,
intent(in) :: sfield_num
93 integer,
intent(in) :: hvfield_num
94 integer,
intent(in) :: htensorfield_num
96 integer,
intent(in),
optional :: halosize_1d
101 integer :: nnode_lcmeshface(
comm_face_num,mesh2d%local_mesh_num)
104 this%mesh2d => mesh2d
105 lcmesh => mesh2d%lcmesh_list(1)
106 elem => lcmesh%refElem2D
109 if (
present(halosize_1d) )
then
110 this%haloSize_1D = halosize_1d
116 allocate( this%VMapB_size(this%mesh2d%LOCAL_MESH_NUM) )
118 this%bufsize_per_field = 2*(lcmesh%NeX + lcmesh%NeY) * elem%Nfp*this%haloSize_1D
120 do n=1, this%mesh2d%LOCAL_MESH_NUM
121 lcmesh => this%mesh2d%lcmesh_list(n)
122 nnode_lcmeshface(:,n) = (/ lcmesh%NeX, lcmesh%NeY, lcmesh%NeX, lcmesh%NeY /) * lcmesh%refElem2D%Nfp*this%haloSize_1D
128 if ( this%haloSize_1D > 1 )
then
129 this%use_vmap_wide_flag = .true.
130 allocate( this%VMapB2(this%bufsize_per_field) )
132 lcmesh => this%mesh2d%lcmesh_list(1)
133 call meshutilcubedsphere2d_genpatchboundarymap_wide( this%VMapB2, &
134 lcmesh%VMapB, this%haloSize_1D, &
135 lcmesh%NeX, lcmesh%NeY, &
139 this%use_vmap_wide_flag = .false.
142 do n=1, this%mesh2d%LOCAL_MESH_NUM
143 lcmesh => this%mesh2d%lcmesh_list(n)
144 if ( this%use_vmap_wide_flag )
then
145 this%VMapB_size(n) =
size(this%VMapB2)
147 this%VMapB_size(n) =
size(lcmesh%VMapB)
153 if (hvfield_num > 0)
then
154 allocate( this%vec_covariant_comp_ptrlist(hvfield_num) )
158 end subroutine meshfieldcommcubedspheredom2d_init
161 subroutine meshfieldcommcubedspheredom2d_final( this )
167 if ( this%hvfield_num > 0 )
then
168 deallocate( this%vec_covariant_comp_ptrlist )
173 end subroutine meshfieldcommcubedspheredom2d_final
176 subroutine meshfieldcommcubedspheredom2d_set_covariantvec( &
177 this, hvfield_ID, u1, u2 )
180 integer,
intent(in) :: hvfield_id
185 this%vec_covariant_comp_ptrlist(hvfield_id)%u1 => u1
186 this%vec_covariant_comp_ptrlist(hvfield_id)%u2 => u2
188 end subroutine meshfieldcommcubedspheredom2d_set_covariantvec
191 subroutine meshfieldcommcubedspheredom2d_put(this, field_list, varid_s)
195 integer,
intent(in) :: varid_s
200 if ( this%use_vmap_wide_flag )
then
204 field_list, 2, varid_s, this%mesh2d%lcmesh_list,
size(this%mesh2d%lcmesh_list(1)%VMapB), &
210 end subroutine meshfieldcommcubedspheredom2d_put
213 subroutine meshfieldcommcubedspheredom2d_get(this, field_list, varid_s)
220 integer,
intent(in) :: varid_s
228 integer :: varid_vec_s
230 integer,
allocatable :: vmapb(:)
233 varnum =
size(field_list)
236 if ( this%call_wait_flag_sub_get )
then
241 call post_exchange_core( this )
244 do n=1, this%mesh2d%LOCAL_MESH_NUM
245 lcmesh => this%mesh2d%lcmesh_list(n)
246 if ( this%use_vmap_wide_flag )
then
248 this%VMapB2, this%VMapB_size(1), &
249 field_list(i)%field2d%local(n)%val )
252 field_list(i)%field2d%local(n)%val )
258 varid_e = varid_s + varnum - 1
259 if ( varid_e > this%sfield_num )
then
260 do i=1, this%hvfield_num
262 varid_vec_s = this%sfield_num + 2*i - 1
263 if ( varid_vec_s > varid_e )
exit
265 if (
associated(this%vec_covariant_comp_ptrlist(i)%u1 ) &
266 .and.
associated(this%vec_covariant_comp_ptrlist(i)%u2 ) )
then
268 do n=1, this%mesh2d%LOCAL_MESH_NUM
269 lcmesh => this%mesh2d%lcmesh_list(n)
271 if ( this%use_vmap_wide_flag )
then
272 allocate(vmapb(this%VMapB_size(n)))
273 vmapb(:) = this%VMapB2(:)
275 allocate(vmapb(
size(lcmesh%VMapB)))
276 vmapb(:) = lcmesh%VMapB(:)
279 call set_boundary_data2d_u1u2( &
280 this%recv_buf(:,varid_vec_s,n), this%recv_buf(:,varid_vec_s+1,n), &
281 this%bufsize_per_field, lcmesh%refElem2D, lcmesh, lcmesh%G_ij, vmapb, &
282 this%vec_covariant_comp_ptrlist(i)%u1%local(n)%val, &
283 this%vec_covariant_comp_ptrlist(i)%u2%local(n)%val )
294 end subroutine meshfieldcommcubedspheredom2d_get
300 subroutine meshfieldcommcubedspheredom2d_exchange( this, do_wait )
307 use scale_prc,
only: prc_abort
311 logical,
intent(in),
optional :: do_wait
317 real(rp),
allocatable :: fpos2d(:,:)
318 real(rp),
allocatable :: lcfpos2d(:,:)
319 real(rp),
allocatable :: unity_fac(:)
320 real(rp),
allocatable :: tmp_svec2d(:,:)
326 integer,
pointer :: vmapb(:)
331 if (
present(do_wait) )
then
332 if ( .not. do_wait )
then
333 log_info(
"MeshFieldCommCubedSphereDom2D_exchange",*)
"do_wait=False is not currently supported. Check!"
338 do n=1, this%mesh%LOCAL_MESH_NUM
339 lcmesh => this%mesh2d%lcmesh_list(n)
340 elem => lcmesh%refElem2D
342 allocate( fpos2d(this%Nnode_LCMeshAllFace(n),2) )
344 if ( this%use_vmap_wide_flag )
then
347 vmapb => lcmesh%VMapB
354 do f=1, this%nfaces_comm
355 commdata => this%commdata_list(f,n)
357 call push_localsendbuf( commdata%send_buf, &
358 this%send_buf(:,:,n), commdata%s_faceID, this%is_f(f,n), &
359 commdata%Nnode_LCMeshFace, this%bufsize_per_field, &
360 this%field_num_tot, lcmesh, this%HaloSize_1D )
362 if ( commdata%s_panelID /= lcmesh%panelID &
363 .and. ( this%hvfield_num > 0 .or. this%htensorfield_num > 0 ) )
then
365 allocate( lcfpos2d(commdata%Nnode_LCMeshFace,2), unity_fac(commdata%Nnode_LCMeshFace) )
366 unity_fac(:) = 1.0_rp
369 call push_localsendbuf( lcfpos2d, &
370 fpos2d, commdata%s_faceID, this%is_f(f,n), &
371 commdata%Nnode_LCMeshFace, this%Nnode_LCMeshAllFace(n), 2, &
372 lcmesh, this%HaloSize_1D )
375 if ( commdata%s_panelID /= lcmesh%panelID )
then
376 if ( this%hvfield_num > 0 )
then
377 allocate( tmp_svec2d(commdata%Nnode_LCMeshFace,2) )
380 do varid=this%sfield_num+1, this%field_num_tot-1,2
382 do i=1,
size(tmp_svec2d,1)
383 tmp_svec2d(i,1) = commdata%send_buf(i,varid )
384 tmp_svec2d(i,2) = commdata%send_buf(i,varid+1)
388 lcmesh%panelID, lcfpos2d(:,1), lcfpos2d(:,2), unity_fac, &
389 commdata%Nnode_LCMeshFace, &
390 tmp_svec2d(:,1), tmp_svec2d(:,2), &
391 commdata%send_buf(:,varid), commdata%send_buf(:,varid+1), &
395 deallocate( tmp_svec2d )
400 if (
allocated(lcfpos2d) )
then
402 deallocate( lcfpos2d, unity_fac )
413 if ( .not. this%call_wait_flag_sub_get ) &
414 call post_exchange_core( this )
419 end subroutine meshfieldcommcubedspheredom2d_exchange
423 subroutine post_exchange_core( this )
434 real(rp),
allocatable :: fpos2d(:,:)
435 real(rp),
allocatable :: lcfpos2d(:,:)
436 real(rp),
allocatable :: unity_fac(:)
443 integer,
pointer :: vmapb(:)
446 do n=1, this%mesh%LOCAL_MESH_NUM
447 lcmesh => this%mesh2d%lcmesh_list(n)
448 elem => lcmesh%refElem2D
450 allocate( fpos2d(this%Nnode_LCMeshAllFace(n),2) )
451 if ( this%use_vmap_wide_flag )
then
454 vmapb => lcmesh%VMapB
462 do f=1, this%nfaces_comm
463 commdata => this%commdata_list(f,n)
464 ire = irs + commdata%Nnode_LCMeshFace - 1
466 if ( commdata%s_panelID /= lcmesh%panelID &
467 .and. ( this%hvfield_num > 0 .or. this%htensorfield_num > 0 ) )
then
469 allocate( lcfpos2d(commdata%Nnode_LCMeshFace,2), unity_fac(commdata%Nnode_LCMeshFace) )
470 unity_fac(:) = 1.0_rp
473 call push_localsendbuf( lcfpos2d, &
474 fpos2d, f, this%is_f(f,n), &
475 commdata%Nnode_LCMeshFace, this%Nnode_LCMeshAllFace(n), 2, &
476 lcmesh, this%HaloSize_1D )
480 if ( commdata%s_panelID /= lcmesh%panelID )
then
481 if ( this%hvfield_num > 0 )
then
482 do varid=this%sfield_num+1, this%field_num_tot-1, 2
484 lcmesh%panelID, lcfpos2d(:,1), lcfpos2d(:,2), unity_fac(:), &
485 commdata%Nnode_LCMeshFace, &
486 commdata%recv_buf(:,varid), commdata%recv_buf(:,varid+1), &
487 this%recv_buf(irs:ire,varid,n), this%recv_buf(irs:ire,varid+1,n) )
493 if (
allocated(lcfpos2d) )
then
495 deallocate( lcfpos2d, unity_fac )
505 end subroutine post_exchange_core
508 subroutine push_localsendbuf( lc_send_buf, &
509 send_buf, s_faceID, is, Nnode_LCMeshFace, bufsize_per_field, var_num, &
510 lcmesh, haloSize_1D )
513 integer,
intent(in) :: var_num
514 integer,
intent(in) :: nnode_lcmeshface
515 integer,
intent(in) :: bufsize_per_field
516 real(rp),
intent(inout) :: lc_send_buf(nnode_lcmeshface,var_num)
517 real(rp),
intent(in) :: send_buf(bufsize_per_field,var_num)
518 integer,
intent(in) :: s_faceid, is
520 integer,
intent(in) :: halosize_1d
527 if ( s_faceid > 0 )
then
531 do i=1, nnode_lcmeshface
532 lc_send_buf(i,v) = send_buf(is+i-1,v)
535 else if ( s_faceid < 0 )
then
536 nfp = lcmesh%refElem2D%Nfp
537 ne_h1d = nnode_lcmeshface / ( nfp * halosize_1d )
538 call revert_hori( lc_send_buf, &
539 send_buf, is, ne_h1d, halosize_1d, nfp )
545 subroutine revert_hori( revert, ori, is_, Ne_h1D_, haloSize_1D_, Nfp_ )
547 integer,
intent(in) :: is_
548 integer,
intent(in) :: ne_h1d_
549 integer,
intent(in) :: halosize_1d_
550 integer,
intent(in) :: nfp_
552 real(rp),
intent(out) :: revert(nfp_, halosize_1d_, ne_h1d_, var_num)
553 real(rp),
intent(in) :: ori(bufsize_per_field,var_num)
555 integer :: p, ph, i, v
563 do ph=1, halosize_1d_
572 + (i_-1) * nfp_ * halosize_1d_
574 revert(p,ph,i,v) = ori(id_src,v)
580 end subroutine revert_hori
581 end subroutine push_localsendbuf
583 subroutine set_boundary_data2d_u1u2( buf_U, buf_V, &
584 bufsize_per_field, elem, mesh, G_ij, VMapB, &
588 integer,
intent(in) :: bufsize_per_field
591 real(dp),
intent(in) :: buf_u(bufsize_per_field)
592 real(dp),
intent(in) :: buf_v(bufsize_per_field)
593 real(dp),
intent(in) :: g_ij(elem%np * mesh%ne,2,2)
594 integer,
intent(in) :: vmapb(bufsize_per_field)
595 real(dp),
intent(inout) :: u1(elem%np * mesh%nea)
596 real(dp),
intent(inout) :: u2(elem%np * mesh%nea)
603 iis = elem%Np*mesh%NeE
605 do ii=1, bufsize_per_field
607 u1(iis+ii) = g_ij(vmap_b,1,1) * buf_u(ii) + g_ij(vmap_b,1,2) * buf_v(ii)
608 u2(iis+ii) = g_ij(vmap_b,2,1) * buf_u(ii) + g_ij(vmap_b,2,2) * buf_v(ii)
611 u1(elem%Np*mesh%NeE+1:elem%Np*mesh%NeE+bufsize_per_field) &
612 = g_ij(vmapb,1,1) * buf_u(:) + g_ij(vmapb,1,2) * buf_v(:)
613 u2(elem%Np*mesh%NeE+1:elem%Np*mesh%NeE+bufsize_per_field) &
614 = g_ij(vmapb,2,1) * buf_u(:) + g_ij(vmapb,2,2) * buf_v(:)
617 end subroutine set_boundary_data2d_u1u2
Module common / Coordinate conversion with cubed-sphere projection.
subroutine, public cubedspherecoordcnv_lonlat2csvec(panelid, alpha, beta, gam, np, veclon, veclat, vecalpha, vecbeta, lat, gpu_async_id)
Convert the components of a vector in longitude and latitude coordinates to those in local coordinate...
subroutine, public cubedspherecoordcnv_cs2lonlatvec(panelid, alpha, beta, gam, np, vecalpha, vecbeta, veclon, veclat, lat, gpu_async_id)
Convert the components of a vector in local coordinates with an equiangular gnomonic cubed-sphere pro...
module FElib / Element / Base
module FElib / Mesh / Local 2D
module FElib / Mesh / Cubed-sphere 2D domain
module FElib / Data / base
module FElib / Data / Communication base
subroutine, public meshfieldcommbase_extract_bounddata(var, refelem, mesh, buf)
Extract halo data from data array with MeshField object and set it to the receiving buffer.
subroutine, public meshfieldcommbase_extract_bounddata_3(field_list, dim, varid_s, lcmesh_list, vmapb2, vmapb2_size, buf)
Extract halo data from data array with MeshField object and set it to the recieving buffer.
subroutine, public meshfieldcommbase_final(this)
Finalize a base object to manage data communication of fields.
subroutine, public meshfieldcommbase_wait_core(this, commdata_list, field_list, dim, varid_s, lcmesh_list)
Wait data communication and move tmp data of LocalMeshCommData object to a recv buffer.
subroutine, public meshfieldcommbase_set_bounddata(buf, refelem, mesh, var)
Extract halo data from the receiving buffer and set it to data array with MeshField object.
subroutine, public meshfieldcommbase_set_bounddata_3(buf, refelem, mesh, vmapb, vmapb_size, var)
Extract halo data from the recieving buffer and set it to data array with MeshField object.
subroutine, public meshfieldcommbase_init(this, sfield_num, hvfield_num, htensorfield_num, bufsize_per_field, comm_face_num, nnode_lcmeshface, mesh)
Initialize a base object to manage data communication of fields.
subroutine, public meshfieldcommbase_extract_bounddata_2(field_list, dim, varid_s, lcmesh_list, vmapb_size, buf)
Extract halo data from data array with MeshField object and set it to the receiving buffer.
subroutine, public meshfieldcommbase_extract_bounddata2(var, vmapb, vmapb_size, npxnea, buf)
Extract halo data from data array with MeshField object and set it to the receiving buffer.
subroutine, public meshfieldcommbase_exchange_core(this, commdata_list, do_wait)
Exchange halo data.
module FElib / Data / Communication in 2D cubed-sphere domain
integer, parameter comm_face_num
module FElib / Mesh / utility for 2D cubed-sphere mesh
Derived type representing a 2D reference element.
Derived type representing an arbitrary finite element.
Derived type representing a local mesh for 2D domain.
Derived type to manage a cubed-sphere 2D computational domain.
Derived type representing a field with 2D mesh.
Derived type to manage data communication at a face between adjacent local meshes.
Base derived type to manage data communication.
Container to save a pointer of MeshField(1D, 2D, 3D) object.
Base derived type to manage data communication with 2D cubed-sphere domain.