7 double precision,
dimension(:^D&,:),
allocatable :: w
60 integer,
private :: itag
125 integer :: nghostcellsCo, interpolation_order
126 integer :: nx^D, nxCo^D, ixG^L, i^D, ic^D, inc^D, idir
129 ixm^l=ixg^l^lsubnghostcells;
133 ixcogsmax^d=ixcogmax^d;
137 nx^d=ixmmax^d-ixmmin^d+1;
141 interpolation_order=1
143 interpolation_order=2
147 if (nghostcellsco+interpolation_order-1>
nghostcells)
then
148 call mpistop(
"interpolation order for prolongation in getbc too high")
157 ixs_srl_min^d(:,-1)=ixmmin^d
158 ixs_srl_min^d(:, 0)=ixmmin^d
161 ixs_srl_max^d(:, 0)=ixmmax^d
162 ixs_srl_max^d(:, 1)=ixmmax^d
164 ixr_srl_min^d(:,-1)=1
165 ixr_srl_min^d(:, 0)=ixmmin^d
166 ixr_srl_min^d(:, 1)=ixmmax^d+1
168 ixr_srl_max^d(:, 0)=ixmmax^d
169 ixr_srl_max^d(:, 1)=ixgmax^d
171 ixs_r_min^d(:,-1)=ixcommin^d
172 ixs_r_min^d(:, 0)=ixcommin^d
175 ixs_r_max^d(:, 0)=ixcommax^d
176 ixs_r_max^d(:, 1)=ixcommax^d
179 ixr_r_min^d(:, 1)=ixmmin^d
180 ixr_r_min^d(:, 2)=ixmmin^d+nxco^d
181 ixr_r_min^d(:, 3)=ixmmax^d+1
183 ixr_r_max^d(:, 1)=ixmmin^d-1+nxco^d
184 ixr_r_max^d(:, 2)=ixmmax^d
185 ixr_r_max^d(:, 3)=ixgmax^d
187 ixs_p_min^d(:, 0)=ixmmin^d-(interpolation_order-1)
188 ixs_p_min^d(:, 1)=ixmmin^d-(interpolation_order-1)
189 ixs_p_min^d(:, 2)=ixmmin^d+nxco^d-nghostcellsco-(interpolation_order-1)
190 ixs_p_min^d(:, 3)=ixmmax^d+1-nghostcellsco-(interpolation_order-1)
191 ixs_p_max^d(:, 0)=ixmmin^d-1+nghostcellsco+(interpolation_order-1)
192 ixs_p_max^d(:, 1)=ixmmin^d-1+nxco^d+nghostcellsco+(interpolation_order-1)
193 ixs_p_max^d(:, 2)=ixmmax^d+(interpolation_order-1)
194 ixs_p_max^d(:, 3)=ixmmax^d+(interpolation_order-1)
198 ixs_p_min^d(:, 0)=ixmmin^d
199 ixs_p_max^d(:, 3)=ixmmax^d
200 ixs_p_max^d(:, 1)=ixmmin^d-1+nxco^d+(interpolation_order-1)
201 ixs_p_min^d(:, 2)=ixmmin^d+nxco^d-(interpolation_order-1)
204 ixr_p_min^d(:, 0)=ixcommin^d-nghostcellsco-(interpolation_order-1)
205 ixr_p_min^d(:, 1)=ixcommin^d-(interpolation_order-1)
206 ixr_p_min^d(:, 2)=ixcommin^d-nghostcellsco-(interpolation_order-1)
207 ixr_p_min^d(:, 3)=ixcommax^d+1-(interpolation_order-1)
208 ixr_p_max^d(:, 0)=
nghostcells+(interpolation_order-1)
209 ixr_p_max^d(:, 1)=ixcommax^d+nghostcellsco+(interpolation_order-1)
210 ixr_p_max^d(:, 2)=ixcommax^d+(interpolation_order-1)
211 ixr_p_max^d(:, 3)=ixcommax^d+nghostcellsco+(interpolation_order-1)
215 ixr_p_min^d(:, 3)=ixcommax^d+1
216 ixr_p_max^d(:, 1)=ixcommax^d+(interpolation_order-1)
217 ixr_p_min^d(:, 2)=ixcommin^d-(interpolation_order-1)
223 allocate(pole_buf%ws(ixgs^t,nws))
226 { ixs_srl_stg_min^d(idir,-1)=ixmmin^d-
kr(idir,^d)
228 ixs_srl_stg_min^d(idir,0) =ixmmin^d-
kr(idir,^d)
229 ixs_srl_stg_max^d(idir,0) =ixmmax^d
230 ixs_srl_stg_min^d(idir,1) =ixmmax^d-
nghostcells+1-
kr(idir,^d)
231 ixs_srl_stg_max^d(idir,1) =ixmmax^d
233 ixr_srl_stg_min^d(idir,-1)=1-
kr(idir,^d)
235 ixr_srl_stg_min^d(idir,0) =ixmmin^d-
kr(idir,^d)
236 ixr_srl_stg_max^d(idir,0) =ixmmax^d
237 ixr_srl_stg_min^d(idir,1) =ixmmax^d+1-
kr(idir,^d)
238 ixr_srl_stg_max^d(idir,1) =ixgmax^d
240 ixs_r_stg_min^d(idir,-1)=ixcommin^d-
kr(idir,^d)
242 ixs_r_stg_min^d(idir,0) =ixcommin^d-
kr(idir,^d)
243 ixs_r_stg_max^d(idir,0) =ixcommax^d
244 ixs_r_stg_min^d(idir,1) =ixcommax^d+1-
nghostcells-
kr(idir,^d)
245 ixs_r_stg_max^d(idir,1) =ixcommax^d
247 ixr_r_stg_min^d(idir,0)=1-
kr(idir,^d)
249 ixr_r_stg_min^d(idir,1)=ixmmin^d-
kr(idir,^d)
250 ixr_r_stg_max^d(idir,1)=ixmmin^d-1+nxco^d
251 ixr_r_stg_min^d(idir,2)=ixmmin^d+nxco^d-
kr(idir,^d)
252 ixr_r_stg_max^d(idir,2)=ixmmax^d
253 ixr_r_stg_min^d(idir,3)=ixmmax^d+1-
kr(idir,^d)
254 ixr_r_stg_max^d(idir,3)=ixgmax^d
259 ixs_p_stg_min^d(idir,0)=ixmmin^d-1
260 ixs_p_stg_max^d(idir,0)=ixmmin^d-1+nghostcellsco
261 ixs_p_stg_min^d(idir,1)=ixmmin^d-1
262 ixs_p_stg_max^d(idir,1)=ixmmin^d-1+nxco^d+nghostcellsco
263 ixs_p_stg_min^d(idir,2)=ixmmax^d-nxco^d-nghostcellsco
264 ixs_p_stg_max^d(idir,2)=ixmmax^d
265 ixs_p_stg_min^d(idir,3)=ixmmax^d-nghostcellsco
266 ixs_p_stg_max^d(idir,3)=ixmmax^d
268 ixr_p_stg_min^d(idir,0)=ixcommin^d-1-nghostcellsco
269 ixr_p_stg_max^d(idir,0)=ixcommin^d-1
270 ixr_p_stg_min^d(idir,1)=ixcommin^d-1
271 ixr_p_stg_max^d(idir,1)=ixcommax^d+nghostcellsco
272 ixr_p_stg_min^d(idir,2)=ixcommin^d-1-nghostcellsco
273 ixr_p_stg_max^d(idir,2)=ixcommax^d
274 ixr_p_stg_min^d(idir,3)=ixcommax^d+1-1
275 ixr_p_stg_max^d(idir,3)=ixcommax^d+nghostcellsco
280 ixs_p_stg_min^d(idir,0)=ixmmin^d
281 ixs_p_stg_max^d(idir,0)=ixmmin^d-1+nghostcellsco+(interpolation_order-1)
282 ixs_p_stg_min^d(idir,1)=ixmmin^d
283 ixs_p_stg_max^d(idir,1)=ixmmin^d-1+nxco^d+nghostcellsco+(interpolation_order-1)
284 ixs_p_stg_min^d(idir,2)=ixmmax^d+1-nxco^d-nghostcellsco-(interpolation_order-1)
285 ixs_p_stg_max^d(idir,2)=ixmmax^d
286 ixs_p_stg_min^d(idir,3)=ixmmax^d+1-nghostcellsco-(interpolation_order-1)
287 ixs_p_stg_max^d(idir,3)=ixmmax^d
289 ixr_p_stg_min^d(idir,0)=ixcommin^d-nghostcellsco-(interpolation_order-1)
290 ixr_p_stg_max^d(idir,0)=ixcommin^d-1
291 ixr_p_stg_min^d(idir,1)=ixcommin^d
292 ixr_p_stg_max^d(idir,1)=ixcommax^d+nghostcellsco+(interpolation_order-1)
293 ixr_p_stg_min^d(idir,2)=ixcommin^d-nghostcellsco-(interpolation_order-1)
294 ixr_p_stg_max^d(idir,2)=ixcommax^d
295 ixr_p_stg_min^d(idir,3)=ixcommax^d+1
296 ixr_p_stg_max^d(idir,3)=ixcommax^d+nghostcellsco+(interpolation_order-1)
305 sizes_srl_send_stg(idir,i^d)={(ixs_srl_stg_max^d(idir,i^d)-ixs_srl_stg_min^d(idir,i^d)+1)|*}
306 sizes_srl_recv_stg(idir,i^d)={(ixr_srl_stg_max^d(idir,i^d)-ixr_srl_stg_min^d(idir,i^d)+1)|*}
307 sizes_r_send_stg(idir,i^d)={(ixs_r_stg_max^d(idir,i^d)-ixs_r_stg_min^d(idir,i^d)+1)|*}
317 sizes_r_recv_stg(idir,i^d)={(ixr_r_stg_max^d(idir,i^d)-ixr_r_stg_min^d(idir,i^d)+1)|*}
318 sizes_p_send_stg(idir,i^d)={(ixs_p_stg_max^d(idir,i^d)-ixs_p_stg_min^d(idir,i^d)+1)|*}
319 sizes_p_recv_stg(idir,i^d)={(ixr_p_stg_max^d(idir,i^d)-ixr_p_stg_min^d(idir,i^d)+1)|*}
326 if(.not.stagger_grid .or. physics_type==
'mf')
then
329 ixs_srl_min^d(-1,0)=1
330 ixs_srl_min^d( 1,0)=ixmmin^d
331 ixs_srl_min^d( 2,0)=1
332 ixs_srl_max^d(-1,0)=ixmmax^d
333 ixs_srl_max^d( 1,0)=ixgmax^d
334 ixs_srl_max^d( 2,0)=ixgmax^d
336 ixr_srl_min^d(-1,0)=1
337 ixr_srl_min^d( 1,0)=ixmmin^d
338 ixr_srl_min^d( 2,0)=1
339 ixr_srl_max^d(-1,0)=ixmmax^d
340 ixr_srl_max^d( 1,0)=ixgmax^d
341 ixr_srl_max^d( 2,0)=ixgmax^d
344 ixs_r_min^d( 1,0)=ixcommin^d
345 ixs_r_max^d(-1,0)=ixcommax^d
346 ixs_r_max^d( 1,0)=ixcogmax^d
349 ixr_r_max^d(-1,1)=ixmmin^d-1+nxco^d
350 ixr_r_min^d( 1,2)=ixmmin^d+nxco^d
351 ixr_r_max^d( 1,2)=ixgmax^d
354 ixs_p_max^d( 1,2)=ixgmax^d
357 ixr_p_max^d( 1,2)=ixcogmax^d
366 integer,
intent(in) :: nwstart, nwbc
367 integer :: i^D, ic^D, inc^D, iib^D
370 if (i^d==0|.and.) cycle
374 if (iib^d==2|.or.) cycle
376 {
do ic^db=1+int((1-i^db)/2),2-int((1+i^db)/2)
377 inc^db=2*i^db+ic^db\}
390 integer,
intent(inout) :: comm_type
391 integer,
intent(in) :: ix^L, ixG^L, nwstart, nwbc
393 integer,
dimension(ndim+1) :: fullsize, subsize, start
395 ^
d&fullsize(^
d)=ixgmax^
d;
397 ^
d&subsize(^
d)=ixmax^
d-ixmin^
d+1;
399 ^
d&start(^
d)=ixmin^
d-1;
400 start(
ndim+1)=nwstart-1
402 call mpi_type_create_subarray(
ndim+1,fullsize,subsize,start,mpi_order_fortran, &
403 mpi_double_precision,comm_type,
ierrmpi)
404 call mpi_type_commit(comm_type,
ierrmpi)
411 integer :: i^D, ic^D, inc^D, iib^D
414 if (i^d==0|.and.) cycle
419 if (iib^d==2|.or.) cycle
421 {
do ic^db=1+int((1-i^db)/2),2-int((1+i^db)/2)
422 inc^db=2*i^db+ic^db\}
433 subroutine getbc(time,qdt,psb,nwstart,nwbc,req_diag)
437 double precision,
intent(in) :: time, qdt
438 type(state),
target :: psb(max_blocks)
439 integer,
intent(in) :: nwstart
440 integer,
intent(in) :: nwbc
441 logical,
intent(in),
optional :: req_diag
443 double precision :: time_bcin
444 integer :: ipole, nwhead, nwtail
445 integer :: iigrid, igrid, ineighbor, ipe_neighbor, isizes
446 integer :: ixR^L, ixS^L
447 integer :: i^D, n_i^D, ic^D, inc^D, n_inc^D, iib^D, idir
449 integer :: idphyb(ndim,max_blocks)
450 integer :: isend_buf(npwbuf), ipwbuf, nghostcellsco
452 integer :: ibuf_start, ibuf_next
454 integer,
dimension(1) :: shapes
455 logical :: req_diagonal
458 time_bcin=mpi_wtime()
461 nwtail=nwstart+nwbc-1
463 req_diagonal = .true.
464 if (
present(req_diag)) req_diagonal = req_diag
474 do iigrid=1,igridstail; igrid=igrids(iigrid);
483 do iigrid=1,igridstail; igrid=igrids(iigrid);
484 if(any(neighbor_type(:^d&,igrid)==neighbor_coarse))
then
501 if(stagger_grid)
then
517 do iigrid=1,igridstail; igrid=igrids(iigrid);
519 ^d&idphyb(^d,igrid)=iib^d;
522 select case (neighbor_type(i^d,igrid))
523 case (neighbor_sibling)
532 do iigrid=1,igridstail; igrid=igrids(iigrid);
533 ^d&iib^d=idphyb(^d,igrid);
536 select case (neighbor_type(i^d,igrid))
537 case (neighbor_sibling)
539 case (neighbor_coarse)
547 do iigrid=1,igridstail; igrid=igrids(iigrid);
548 ^d&iib^d=idphyb(^d,igrid);
551 select case (neighbor_type(i^d,igrid))
552 case(neighbor_sibling)
554 case(neighbor_coarse)
564 if(stagger_grid)
then
572 do iigrid=1,igridstail; igrid=igrids(iigrid);
573 ^d&iib^d=idphyb(^d,igrid);
576 select case (neighbor_type(i^d,igrid))
577 case (neighbor_sibling)
587 if (isend_buf(ipwbuf)/=0)
deallocate(pwbuf(ipwbuf)%w)
596 do iigrid=1,igridstail; igrid=igrids(iigrid);
597 ^d&iib^d=idphyb(^d,igrid);
604 do iigrid=1,igridstail; igrid=igrids(iigrid);
605 ^d&iib^d=idphyb(^d,igrid);
614 do iigrid=1,igridstail; igrid=igrids(iigrid);
615 ^d&iib^d=idphyb(^d,igrid);
618 if (neighbor_type(i^d,igrid)==neighbor_fine)
call bc_fill_prolong(igrid,i^d,iib^d)
626 if(stagger_grid)
then
632 do iigrid=1,igridstail; igrid=igrids(iigrid);
633 ^d&iib^d=idphyb(^d,igrid);
642 do iigrid=1,igridstail; igrid=igrids(iigrid);
648 if (isend_buf(ipwbuf)/=0)
deallocate(pwbuf(ipwbuf)%w)
652 if(
bcphys.and.stagger_grid)
then
654 do iigrid=1,igridstail; igrid=igrids(iigrid);
655 if(.not.phyboundblock(igrid)) cycle
662 if(
bcphys.and.
associated(phys_boundary_adjust))
then
664 do iigrid=1,igridstail; igrid=igrids(iigrid);
665 if(.not.phyboundblock(igrid)) cycle
666 call phys_boundary_adjust(igrid,psb)
671 time_bc=time_bc+(mpi_wtime()-time_bcin)
676 integer,
intent(in) :: dir(^nd)
678 if (all(dir == 0))
then
680 else if (.not. req_diagonal .and. count(dir /= 0) > 1)
then
690 integer,
intent(in) :: igrid
692 integer :: idims,iside,i^D,k^L,ixB^L
695 ^d&dxlevel(^d)=rnode(rpdx^d_,igrid);
701 kmin^d=merge(0, 1, idims==^d)
702 kmax^d=merge(0, 1, idims==^d)
703 ixbmin^d=ixglo^d+kmin^d*nghostcells
704 ixbmax^d=ixghi^d-kmax^d*nghostcells
707 if(idims > 1 .and. neighbor_type(-1,0,igrid)==neighbor_boundary) ixbmin1=ixglo1
708 if(idims > 1 .and. neighbor_type( 1,0,igrid)==neighbor_boundary) ixbmax1=ixghi1}
710 if(idims > 1 .and. neighbor_type(-1,0,0,igrid)==neighbor_boundary) ixbmin1=ixglo1
711 if(idims > 1 .and. neighbor_type( 1,0,0,igrid)==neighbor_boundary) ixbmax1=ixghi1
712 if(idims > 2 .and. neighbor_type(0,-1,0,igrid)==neighbor_boundary) ixbmin2=ixglo2
713 if(idims > 2 .and. neighbor_type(0, 1,0,igrid)==neighbor_boundary) ixbmax2=ixghi2}
715 i^d=kr(^d,idims)*(2*iside-3);
716 if (aperiodb(idims))
then
717 if (neighbor_type(i^d,igrid) /= neighbor_boundary .and. &
718 .not. psb(igrid)%is_physical_boundary(2*idims-2+iside)) cycle
720 if (neighbor_type(i^d,igrid) /= neighbor_boundary) cycle
722 call bc_phys(iside,idims,time,qdt,psb(igrid),ixg^ll,ixb^l)
731 integer,
intent(in) :: igrid
733 integer :: idims,iside,i^D,k^L,ixB^L
736 ^d&dxlevel(^d)=rnode(rpdx^d_,igrid);
743 kmin2=merge(1, 0, idims .lt. 2 .and. neighbor_type(0,-1,igrid)==1)
744 kmax2=merge(1, 0, idims .lt. 2 .and. neighbor_type(0, 1,igrid)==1)}
746 kmin2=merge(1, 0, idims .lt. 2 .and. neighbor_type(0,-1,0,igrid)==1)
747 kmax2=merge(1, 0, idims .lt. 2 .and. neighbor_type(0, 1,0,igrid)==1)
748 kmin3=merge(1, 0, idims .lt. 3 .and. neighbor_type(0,0,-1,igrid)==1)
749 kmax3=merge(1, 0, idims .lt. 3 .and. neighbor_type(0,0, 1,igrid)==1)}
750 ixbmin^d=ixglo^d+kmin^d*nghostcells;
751 ixbmax^d=ixghi^d-kmax^d*nghostcells;
753 i^d=kr(^d,idims)*(2*iside-3);
754 if (aperiodb(idims))
then
755 if (neighbor_type(i^d,igrid) /= neighbor_boundary .and. &
756 .not. psb(igrid)%is_physical_boundary(2*idims-2+iside)) cycle
758 if (neighbor_type(i^d,igrid) /= neighbor_boundary) cycle
760 call bc_phys(iside,idims,time,qdt,psb(igrid),ixg^ll,ixb^l)
769 ipe_neighbor=neighbor(2,i^d,igrid)
770 if (ipe_neighbor/=mype)
then
772 itag=(3**^nd+4**^nd)*(igrid-1)+{(i^d+1)*3**(^d-1)+}
775 if(stagger_grid)
then
788 {
do ic^db=1+int((1-i^db)/2),2-int((1+i^db)/2)
789 inc^db=2*i^db+ic^db\}
790 ipe_neighbor=neighbor_child(2,inc^d,igrid)
791 if (ipe_neighbor/=mype)
then
793 itag=(3**^nd+4**^nd)*(igrid-1)+3**^nd+{inc^d*4**(^d-1)+}
794 call mpi_irecv(psb(igrid)%w,1,
type_recv_r(iib^d,inc^d), &
796 if(stagger_grid)
then
799 mpi_double_precision,ipe_neighbor,itag, &
811 ipe_neighbor=neighbor(2,i^d,igrid)
813 if(ipe_neighbor/=mype)
then
814 ineighbor=neighbor(1,i^d,igrid)
815 ipole=neighbor_pole(i^d,igrid)
819 itag=(3**^nd+4**^nd)*(ineighbor-1)+{(n_i^d+1)*3**(^d-1)+}
822 if(stagger_grid)
then
829 reshape(psb(igrid)%ws(ixs^s,idir),shapes)
841 n_i^d=i^d^d%n_i^dd=-i^dd;\}
843 if (isend_buf(ipwbuf)/=0)
then
846 deallocate(pwbuf(ipwbuf)%w)
848 allocate(pwbuf(ipwbuf)%w(ixs^s,nwhead:nwtail))
849 call pole_buffer(pwbuf(ipwbuf)%w,ixs^
l,ixs^
l,psb(igrid)%w,ixg^ll,ixs^
l)
852 itag=(3**^nd+4**^nd)*(ineighbor-1)+{(n_i^d+1)*3**(^d-1)+}
853 isizes={(ixsmax^d-ixsmin^d+1)*}*nwbc
854 call mpi_isend(pwbuf(ipwbuf)%w,isizes,mpi_double_precision, &
856 ipwbuf=1+modulo(ipwbuf,
npwbuf)
857 if(stagger_grid)
then
864 reshape(psb(igrid)%ws(ixs^s,idir),shapes)
878 integer,
intent(in) :: igrid,i^D,iib^D
879 integer :: ineighbor,ipe_neighbor,ipole,ixS^L,ixR^L,n_i^D,idir
881 ipe_neighbor=neighbor(2,i^d,igrid)
882 if(ipe_neighbor==mype)
then
883 ineighbor=neighbor(1,i^d,igrid)
884 ipole=neighbor_pole(i^d,igrid)
889 psb(ineighbor)%w(ixr^s,nwhead:nwtail)=&
890 psb(igrid)%w(ixs^s,nwhead:nwtail)
891 if(stagger_grid)
then
895 psb(ineighbor)%ws(ixr^s,idir)=psb(igrid)%ws(ixs^s,idir)
902 n_i^d=i^d^d%n_i^dd=-i^dd;\}
905 call pole_copy(psb(ineighbor)%w,ixg^ll,ixr^l,psb(igrid)%w,ixg^ll,ixs^l,ipole)
906 if(stagger_grid)
then
910 call pole_copy_stg(psb(ineighbor)%ws,ixgs^ll,ixr^l,psb(igrid)%ws,ixgs^ll,ixs^l,idir,ipole)
919 integer,
intent(in) :: igrid,i^D
921 integer :: idims,iside,k^L,ixB^L,ii^D
923 if(phyboundblock(igrid).and..not.stagger_grid.and.
bcphys)
then
932 {kmin^d=merge(0, 1, idims==^d)
933 kmax^d=merge(0, 1, idims==^d)
934 ixbmin^d=ixcogmin^d+kmin^d*nghostcells
935 ixbmax^d=ixcogmax^d-kmax^d*nghostcells\}
937 if(idims > 1 .and. neighbor_type(-1,0,igrid)==neighbor_boundary) ixbmin1=ixcogmin1
938 if(idims > 1 .and. neighbor_type( 1,0,igrid)==neighbor_boundary) ixbmax1=ixcogmax1}
940 if(idims > 1 .and. neighbor_type(-1,0,0,igrid)==neighbor_boundary) ixbmin1=ixcogmin1
941 if(idims > 1 .and. neighbor_type( 1,0,0,igrid)==neighbor_boundary) ixbmax1=ixcogmax1
942 if(idims > 2 .and. neighbor_type(0,-1,0,igrid)==neighbor_boundary) ixbmin2=ixcogmin2
943 if(idims > 2 .and. neighbor_type(0, 1,0,igrid)==neighbor_boundary) ixbmax2=ixcogmax2}
945 ixbmin^d=ixcogmin^d+nghostcells
946 ixbmax^d=ixcogmin^d+2*nghostcells-1
948 ixbmin^d=ixcogmax^d-2*nghostcells+1
949 ixbmax^d=ixcogmax^d-nghostcells
952 ii^d=kr(^d,idims)*(2*iside-3);
953 if ({abs(i^d)==1.and.abs(ii^d)==1|.or.}) cycle
954 if (neighbor_type(ii^d,igrid)/=neighbor_boundary) cycle
965 ipe_neighbor=neighbor(2,i^d,igrid)
966 if(ipe_neighbor/=mype)
then
967 ic^d=1+modulo(node(pig^d_,igrid)-1,2);
968 if({.not.(i^d==0.or.i^d==2*ic^d-3)|.or.})
return
969 ineighbor=neighbor(1,i^d,igrid)
970 ipole=neighbor_pole(i^d,igrid)
974 itag=(3**^nd+4**^nd)*(ineighbor-1)+3**^nd+{n_inc^d*4**(^d-1)+}
975 call mpi_isend(psc(igrid)%w,1,
type_send_r(iib^d,i^d), &
977 if(stagger_grid)
then
984 reshape(psc(igrid)%ws(ixs^s,idir),shapes)
989 mpi_double_precision,ipe_neighbor,itag, &
997 n_inc^d=2*i^d+(3-ic^d)^d%n_inc^dd=-2*i^dd+ic^dd;\}
999 if(isend_buf(ipwbuf)/=0)
then
1002 deallocate(pwbuf(ipwbuf)%w)
1004 allocate(pwbuf(ipwbuf)%w(ixs^s,nwhead:nwtail))
1008 itag=(3**^nd+4**^nd)*(ineighbor-1)+3**^nd+{n_inc^d*4**(^d-1)+}
1009 isizes={(ixsmax^d-ixsmin^d+1)*}*nwbc
1010 call mpi_isend(pwbuf(ipwbuf)%w,isizes,mpi_double_precision, &
1012 ipwbuf=1+modulo(ipwbuf,
npwbuf)
1013 if(stagger_grid)
then
1020 reshape(psc(igrid)%ws(ixs^s,idir),shapes)
1021 ibuf_start=ibuf_next
1025 mpi_double_precision,ipe_neighbor,itag, &
1036 integer,
intent(in) :: igrid,i^D,iib^D
1038 integer :: ic^D,n_inc^D,ixS^L,ixR^L,ipe_neighbor,ineighbor,ipole,idir
1040 ipe_neighbor=neighbor(2,i^d,igrid)
1041 if(ipe_neighbor==mype)
then
1042 ic^d=1+modulo(node(pig^d_,igrid)-1,2);
1043 if({.not.(i^d==0.or.i^d==2*ic^d-3)|.or.})
return
1044 ineighbor=neighbor(1,i^d,igrid)
1045 ipole=neighbor_pole(i^d,igrid)
1047 n_inc^d=-2*i^d+ic^d;
1048 ixs^l=
ixs_r_^l(iib^d,i^d);
1049 ixr^l=
ixr_r_^l(iib^d,n_inc^d);
1050 psb(ineighbor)%w(ixr^s,nwhead:nwtail)=&
1051 psc(igrid)%w(ixs^s,nwhead:nwtail)
1052 if(stagger_grid)
then
1056 psb(ineighbor)%ws(ixr^s,idir)=psc(igrid)%ws(ixs^s,idir)
1060 ixs^l=
ixs_r_^l(iib^d,i^d);
1063 n_inc^d=2*i^d+(3-ic^d)^d%n_inc^dd=-2*i^dd+ic^dd;\}
1065 ixr^l=
ixr_r_^l(iib^d,n_inc^d);
1066 call pole_copy(psb(ineighbor)%w,ixg^ll,ixr^l,psc(igrid)%w,
ixcog^l,ixs^l,ipole)
1067 if(stagger_grid)
then
1072 call pole_copy_stg(psb(ineighbor)%ws,ixgs^ll,ixr^l,psc(igrid)%ws,
ixcogs^l,ixs^l,idir,ipole)
1082 double precision :: tmp(ixGs^T)
1083 integer :: ixS^L,ixR^L,n_i^D,ixSsync^L,ixRsync^L
1086 ipe_neighbor=neighbor(2,i^d,igrid)
1087 if(ipe_neighbor/=mype)
then
1088 ineighbor=neighbor(1,i^d,igrid)
1089 ipole=neighbor_pole(i^d,igrid)
1101 psb(igrid)%ws(ixr^s,idir) = tmp(ixs^s)
1107 n_i^d=i^d^d%n_i^dd=-i^dd;\}
1115 shape=shape(psb(igrid)%ws(ixs^s,idir)))
1117 call pole_copy_stg(psb(igrid)%ws,ixgs^ll,ixr^l,pole_buf%ws,ixgs^ll,ixs^l,idir,ipole)
1125 integer,
intent(in) :: i^D,idir
1126 integer,
intent(inout) :: ixR^L,ixS^L
1127 integer,
intent(out) :: ixRsync^L,ixSsync^L
1133 if (i^d == -1 .and. idir == ^d)
then
1134 ixrsyncmin^d = ixrmax^d
1135 ixrsyncmax^d = ixrmax^d
1136 ixssyncmin^d = ixsmax^d
1137 ixssyncmax^d = ixsmax^d
1138 ixrmax^d = ixrmax^d - 1
1139 ixsmax^d = ixsmax^d - 1
1140 else if (i^d == 1 .and. idir == ^d)
then
1141 ixrsyncmin^d = ixrmin^d
1142 ixrsyncmax^d = ixrmin^d
1143 ixssyncmin^d = ixsmin^d
1144 ixssyncmax^d = ixsmin^d
1145 ixrmin^d = ixrmin^d + 1
1146 ixsmin^d = ixsmin^d + 1
1155 ipole=neighbor_pole(i^d,igrid)
1158 {
do ic^db=1+int((1-i^db)/2),2-int((1+i^db)/2)
1159 inc^db=2*i^db+ic^db\}
1160 ipe_neighbor=neighbor_child(2,inc^d,igrid)
1161 if(ipe_neighbor/=mype)
then
1162 ineighbor=neighbor_child(1,inc^d,igrid)
1169 shape=shape(psb(igrid)%ws(ixr^s,idir)))
1175 {
do ic^db=1+int((1-i^db)/2),2-int((1+i^db)/2)
1176 inc^db=2*i^db+ic^db\}
1177 ipe_neighbor=neighbor_child(2,inc^d,igrid)
1178 if(ipe_neighbor/=mype)
then
1179 ineighbor=neighbor_child(1,inc^d,igrid)
1182 n_i^d=i^d^d%n_i^dd=-i^dd;\}
1192 shape=shape(psb(igrid)%ws(ixr^s,idir)))
1193 call pole_copy_stg(psb(igrid)%ws,ixgs^ll,ixr^
l,pole_buf%ws,ixgs^ll,ixr^
l,idir,ipole)
1205 ic^d=1+modulo(node(pig^d_,igrid)-1,2);
1206 if ({.not.(i^d==0.or.i^d==2*ic^d-3)|.or.})
return
1208 ipe_neighbor=neighbor(2,i^d,igrid)
1209 if (ipe_neighbor/=mype)
then
1212 itag=(3**^nd+4**^nd)*(igrid-1)+3**^nd+{inc^d*4**(^d-1)+}
1213 call mpi_irecv(psc(igrid)%w,1,
type_recv_p(iib^d,inc^d), &
1215 if(stagger_grid)
then
1218 mpi_double_precision,ipe_neighbor,itag,&
1230 ipole=neighbor_pole(i^d,igrid)
1232 {
do ic^db=1+int((1-i^db)/2),2-int((1+i^db)/2)
1233 inc^db=2*i^db+ic^db\}
1234 ipe_neighbor=neighbor_child(2,inc^d,igrid)
1235 if(ipe_neighbor/=mype)
then
1237 ineighbor=neighbor_child(1,inc^d,igrid)
1242 itag=(3**^nd+4**^nd)*(ineighbor-1)+3**^nd+{n_inc^d*4**(^d-1)+}
1243 call mpi_isend(psb(igrid)%w,1,
type_send_p(iib^d,inc^d), &
1245 if(stagger_grid)
then
1252 reshape(psb(igrid)%ws(ixs^s,idir),shapes)
1253 ibuf_start=ibuf_next
1257 mpi_double_precision,ipe_neighbor,itag, &
1264 n_inc^d=inc^d^d%n_inc^dd=ic^dd-i^dd;\}
1266 if(isend_buf(ipwbuf)/=0)
then
1269 deallocate(pwbuf(ipwbuf)%w)
1271 allocate(pwbuf(ipwbuf)%w(ixs^s,nwhead:nwtail))
1272 call pole_buffer(pwbuf(ipwbuf)%w,ixs^
l,ixs^
l,psb(igrid)%w,ixg^ll,ixs^
l)
1275 itag=(3**^nd+4**^nd)*(ineighbor-1)+3**^nd+{n_inc^d*4**(^d-1)+}
1276 isizes={(ixsmax^d-ixsmin^d+1)*}*nwbc
1277 call mpi_isend(pwbuf(ipwbuf)%w,isizes,mpi_double_precision, &
1279 ipwbuf=1+modulo(ipwbuf,
npwbuf)
1280 if(stagger_grid)
then
1287 reshape(psb(igrid)%ws(ixs^s,idir),shapes)
1288 ibuf_start=ibuf_next
1292 mpi_double_precision,ipe_neighbor,itag, &
1304 integer,
intent(in) :: igrid,i^D,iib^D
1306 integer :: ipe_neighbor,ineighbor,ixS^L,ixR^L,ic^D,inc^D,ipole,idir
1308 ipole=neighbor_pole(i^d,igrid)
1311 {
do ic^db=1+int((1-i^db)/2),2-int((1+i^db)/2)
1312 inc^db=2*i^db+ic^db\}
1313 ipe_neighbor=neighbor_child(2,inc^d,igrid)
1314 if(ipe_neighbor==mype)
then
1315 ixs^l=
ixs_p_^l(iib^d,inc^d);
1316 ineighbor=neighbor_child(1,inc^d,igrid)
1317 ipole=neighbor_pole(i^d,igrid)
1320 ixr^l=
ixr_p_^l(iib^d,n_inc^d);
1321 psc(ineighbor)%w(ixr^s,nwhead:nwtail) &
1322 =psb(igrid)%w(ixs^s,nwhead:nwtail)
1323 if(stagger_grid)
then
1327 psc(ineighbor)%ws(ixr^s,idir)=psb(igrid)%ws(ixs^s,idir)
1333 {
do ic^db=1+int((1-i^db)/2),2-int((1+i^db)/2)
1334 inc^db=2*i^db+ic^db\}
1335 ipe_neighbor=neighbor_child(2,inc^d,igrid)
1336 if(ipe_neighbor==mype)
then
1338 ineighbor=neighbor_child(1,inc^d,igrid)
1339 ipole=neighbor_pole(i^d,igrid)
1342 n_inc^d=inc^d^d%n_inc^dd=ic^dd-i^dd;\}
1346 if(stagger_grid)
then
1359 integer,
intent(in) :: igrid
1361 integer :: iib^D,i^D,idims,iside
1362 logical,
dimension(-1:1^D&) :: NeedProlong
1364 ^d&iib^d=idphyb(^d,igrid);
1368 if (neighbor_type(i^d,igrid)==neighbor_coarse)
then
1370 needprolong(i^d)=.true.
1373 if(stagger_grid)
then
1384 if (needprolong(i^dd))
call bc_prolong_stg(igrid,i^dd,iib^dd,needprolong)
1395 if (needprolong(i^d))
call bc_prolong_stg(igrid,i^d,iib^d,needprolong)
1401 if (needprolong(i^d))
call bc_prolong_stg(igrid,i^d,iib^d,needprolong)
1407 if (needprolong(i^d))
call bc_prolong_stg(igrid,i^d,iib^d,needprolong)
1413 if (needprolong(i^d))
call bc_prolong_stg(igrid,i^d,iib^d,needprolong)
1420 ic^d=1+modulo(node(pig^d_,igrid)-1,2);
1421 if ({.not.(i^d==0.or.i^d==2*ic^d-3)|.or.})
return
1423 ipe_neighbor=neighbor(2,i^d,igrid)
1424 if(ipe_neighbor/=mype)
then
1425 ineighbor=neighbor(1,i^d,igrid)
1426 ipole=neighbor_pole(i^d,igrid)
1435 shape=shape(psc(igrid)%ws(ixr^s,idir)))
1442 n_inc^d=2*i^d+(3-ic^d)^d%n_inc^dd=-2*i^dd+ic^dd;\}
1450 shape=shape(psc(igrid)%ws(ixr^s,idir)))
1463 integer :: i^D,iib^D,igrid
1464 integer :: ixFi^L,ixCo^L,ii^D, idims,iside,ixB^L
1465 double precision :: dxFi^D, dxCo^D, xFimin^D, xComin^D, invdxCo^D
1468 dxfi^d=rnode(rpdx^d_,igrid);
1470 invdxco^d=1.d0/dxco^d;
1476 xfimin^d=rnode(rpxmin^d_,igrid)-dble(nghostcells)*dxfi^d;
1477 xcomin^d=rnode(rpxmin^d_,igrid)-dble(nghostcells)*dxco^d;
1479 if(stagger_grid.and.phyboundblock(igrid).and.
bcphys)
then
1482 ixcomin^d=int((xfimin^d+(dble(ixfimin^d)-half)*dxfi^d-xcomin^d)*invdxco^d)+1-1;
1483 ixcomax^d=int((xfimin^d+(dble(ixfimax^d)-half)*dxfi^d-xcomin^d)*invdxco^d)+1+1;
1487 if(neighbor_type(-1,0,0,igrid)==neighbor_boundary .or. &
1488 neighbor_type(1,0,0,igrid)==neighbor_boundary)
then
1489 if(neighbor_type(0,-1,0,igrid)==neighbor_boundary) ixcomin2=ixcommin2
1490 if(neighbor_type(0,0,-1,igrid)==neighbor_boundary) ixcomin3=ixcommin3
1491 if(neighbor_type(0,1,0,igrid)==neighbor_boundary) ixcomax2=ixcommax2
1492 if(neighbor_type(0,0,1,igrid)==neighbor_boundary) ixcomax3=ixcommax3
1494 else if(idims == 2)
then
1495 if(neighbor_type(0,-1,0,igrid)==neighbor_boundary .or. &
1496 neighbor_type(0,1,0,igrid)==neighbor_boundary)
then
1497 if(neighbor_type(0,0,-1,igrid)==neighbor_boundary) ixcomin3=ixcommin3
1498 if(neighbor_type(0,0,1,igrid)==neighbor_boundary) ixcomax3=ixcommax3
1503 ii^d=kr(^d,idims)*(2*iside-3);
1504 if(neighbor_type(ii^d,igrid)/=neighbor_boundary) cycle
1505 if(( {(iside==1.and.idims==^d.and.ixcomin^d<ixcogmin^d+nghostcells)|.or.} ) &
1506 .or.( {(iside==2.and.idims==^d.and.ixcomax^d>ixcogmax^d-nghostcells)|.or. }))
then
1507 {ixbmin^d=merge(ixcogmin^d,ixcomin^d,idims==^d);}
1508 {ixbmax^d=merge(ixcogmax^d,ixcomax^d,idims==^d);}
1509 call bc_phys(iside,idims,time,0.d0,psc(igrid),
ixcog^l,ixb^l)
1515 if(prolongprimitive)
then
1522 ixcomin^d=int((xfimin^d+(dble(ixfimin^d)-half)*dxfi^d-xcomin^d)*invdxco^d)+1-1;
1523 ixcomax^d=int((xfimin^d+(dble(ixfimax^d)-half)*dxfi^d-xcomin^d)*invdxco^d)+1+1;
1533 if(prolongprimitive)
then
1542 integer :: igrid,i^D,iib^D
1543 logical,
dimension(-1:1^D&) :: NeedProlong
1544 logical :: fine_^Lin
1545 integer :: ixFi^L,ixCo^L
1546 double precision :: dxFi^D,dxCo^D,xFimin^D,xComin^D,invdxCo^D
1550 if(i^d>-1) fine_min^din=(.not.needprolong(i^dd-kr(^d,^dd)).and.neighbor_type(i^dd-kr(^d,^dd),igrid)/=1)
1551 if(i^d<1) fine_max^din=(.not.needprolong(i^dd+kr(^d,^dd)).and.neighbor_type(i^dd+kr(^d,^dd),igrid)/=1)
1556 dxfi^d=rnode(rpdx^d_,igrid);
1558 invdxco^d=1.d0/dxco^d;
1560 xfimin^d=rnode(rpxmin^d_,igrid)-dble(nghostcells)*dxfi^d;
1561 xcomin^d=rnode(rpxmin^d_,igrid)-dble(nghostcells)*dxco^d;
1566 ixcomin^d=int((xfimin^d+(dble(ixfimin^d)-half)*dxfi^d-xcomin^d)*invdxco^d)+1-1;
1567 ixcomax^d=int((xfimin^d+(dble(ixfimax^d)-half)*dxfi^d-xcomin^d)*invdxco^d)+1+1;
1569 if(prolongprimitive)
call phys_to_primitive(ixg^ll,ixfi^l,psb(igrid)%w,psb(igrid)%x)
1571 call prolong_2nd_stg(psc(igrid),psb(igrid),ixco^l,ixfi^l,dxco^d,xcomin^d,dxfi^d,xfimin^d,.true.,fine_^lin)
1573 if(prolongprimitive)
call phys_to_conserved(ixg^ll,ixfi^l,psb(igrid)%w,psb(igrid)%x)
1576 needprolong(i^d)=.false.
1581 dxCo^D,invdxCo^D,xComin^D)
1583 integer,
intent(in) :: igrid, ixFi^L
1584 double precision,
intent(in) :: dxFi^D, xFimin^D,dxCo^D, invdxCo^D, xComin^D
1586 integer :: ixCo^D, jxCo^D, hxCo^D, ixFi^D, ix^D, iw, idims, nwmin,nwmax
1587 double precision :: xCo^D, xFi^D, eta^D
1588 double precision :: slopeL, slopeR, slopeC, signC, signR
1589 double precision :: slope(1:nw,ndim)
1591 double precision :: signedfactorhalf^D
1596 if(prolongprimitive)
then
1604 {
do ixfi^db = ixfi^lim^db
1607 xfi^db=xfimin^db+(dble(ixfi^db)-half)*dxfi^db
1612 ixco^db=int((xfi^db-xcomin^db)*invdxco^db)+1
1616 xco^db=xcomin^db+(dble(ixco^db)-half)*dxco^db \}
1622 if(slab_uniform)
then
1631 eta^d=(xfi^d-xco^d)*invdxco^d;
1665 ix^d=2*int((ixfi^d+ixmlo^d)/2)-ixmlo^d;
1666 {
if(xfi^d>xco^d)
then
1667 signedfactorhalf^d=0.5d0
1669 signedfactorhalf^d=-0.5d0
1671 eta^d=signedfactorhalf^d*(one-psb(igrid)%dvolume(ixfi^dd) &
1672 /sum(psb(igrid)%dvolume(ix^d:ix^d+1^d%ixFi^dd))) \}
1679 hxco^d=ixco^d-kr(^d,idims)\
1680 jxco^d=ixco^d+kr(^d,idims)\
1683 slopel=psc(igrid)%w(ixco^d,iw)-psc(igrid)%w(hxco^d,iw)
1684 sloper=psc(igrid)%w(jxco^d,iw)-psc(igrid)%w(ixco^d,iw)
1685 slopec=half*(sloper+slopel)
1688 signr=sign(one,sloper)
1689 signc=sign(one,slopec)
1707 slope(iw,idims)=signc*max(zero,min(dabs(slopec), &
1708 signc*slopel,signc*sloper))
1714 psb(igrid)%w(ixfi^d,nwmin:nwmax)=psc(igrid)%w(ixco^d,nwmin:nwmax)+&
1715 {(slope(nwmin:nwmax,^d)*eta^d)+}
1719 if(prolongprimitive)
then
1721 call phys_to_conserved(ixg^ll,ixfi^
l,psb(igrid)%w,psb(igrid)%x)
1727 dxCo^D,invdxCo^D,xComin^D)
1729 integer,
intent(in) :: igrid, ixFi^L
1730 double precision,
intent(in) :: dxFi^D, xFimin^D,dxCo^D, invdxCo^D, xComin^D
1732 integer :: ixCo^D, ixFi^D, nwmin,nwmax
1733 double precision :: xFi^D
1735 if(prolongprimitive)
then
1743 {
do ixfi^db = ixfi^lim^db
1745 xfi^db=xfimin^db+(dble(ixfi^db)-half)*dxfi^db
1749 ixco^db=int((xfi^db-xcomin^db)*invdxco^db)+1\}
1752 psb(igrid)%w(ixfi^d,nwmin:nwmax)=psc(igrid)%w(ixco^d,nwmin:nwmax)
1756 if(prolongprimitive)
call phys_to_conserved(ixg^ll,ixfi^
l,psb(igrid)%w,psb(igrid)%x)
1760 subroutine pole_copy(wrecv,ixIR^L,ixR^L,wsend,ixIS^L,ixS^L,ipole)
1762 integer,
intent(in) :: ixIR^L,ixR^L,ixIS^L,ixS^L,ipole
1763 double precision :: wrecv(ixIR^S,1:nw), wsend(ixIS^S,1:nw)
1765 integer :: iw, iside, iB
1769 iside=int((i^d+3)/2)
1772 select case (typeboundary(iw,ib))
1774 wrecv(ixr^s,iw) = wsend(ixsmax^d:ixsmin^d:-1^d%ixS^s,iw)
1776 wrecv(ixr^s,iw) =-wsend(ixsmax^d:ixsmin^d:-1^d%ixS^s,iw)
1778 call mpistop(
"Pole boundary condition should be symm or asymm")
1787 integer,
intent(in) :: ixIR^L,ixR^L,ixIS^L,ixS^L,idirs,ipole
1789 double precision :: wrecv(ixIR^S,1:nws), wsend(ixIS^S,1:nws)
1790 integer :: iB, iside
1794 iside=int((i^d+3)/2)
1796 select case (typeboundary(iw_mag(idirs),ib))
1798 wrecv(ixr^s,idirs) = wsend(ixsmax^d:ixsmin^d:-1^d%ixS^s,idirs)
1800 wrecv(ixr^s,idirs) =-wsend(ixsmax^d:ixsmin^d:-1^d%ixS^s,idirs)
1802 call mpistop(
"Pole boundary condition should be symm or asymm")
1811 integer,
intent(in) :: ixIR^L,ixR^L,ixIS^L,ixS^L
1812 double precision :: wrecv(ixIR^S,nwhead:nwtail), wsend(ixIS^S,1:nw)
1814 integer :: iw, iside, iB
1818 iside=int((i^d+3)/2)
1821 select case (typeboundary(iw,ib))
1823 wrecv(ixr^s,iw) = wsend(ixsmax^d:ixsmin^d:-1^d%ixS^s,iw)
1825 wrecv(ixr^s,iw) =-wsend(ixsmax^d:ixsmin^d:-1^d%ixS^s,iw)
1827 call mpistop(
"Pole boundary condition should be symm or asymm")
1834 end subroutine getbc
1840 integer,
intent(out) :: iib^D
1843 if(s%is_physical_boundary(2*^d) .and. &
1844 s%is_physical_boundary(2*^d-1))
then
1846 else if(s%is_physical_boundary(2*^d-1))
then
1848 else if(s%is_physical_boundary(2*^d))
then
subroutine bc_phys(iside, idims, time, qdt, s, ixGL, ixBL)
fill ghost cells at a physical boundary
subroutine getintbc(time, ixGL)
fill inner boundary values
subroutine coarsen_grid(sFi, ixFiGL, ixFiL, sCo, ixCoGL, ixCoL)
coarsen one grid to its coarser representative
subroutine mpistop(message)
Exit MPI-AMRVAC with an error message.
subroutine bc_recv_restrict
Receive from fine neighbor.
subroutine gc_prolong(igrid)
subroutine interpolation_linear(igrid, ixFiL, dxFiD, xFiminD, dxCoD, invdxCoD, xCominD)
subroutine bc_prolong(igrid, iD, iibD)
do prolongation for fine blocks after receipt data from coarse neighbors
subroutine indices_for_syncing(idir, iD, ixRL, ixSL, ixRsyncL, ixSsyncL)
subroutine bc_fill_srl_stg
fill siblings ghost cells with received data
subroutine pole_copy(wrecv, ixIRL, ixRL, wsend, ixISL, ixSL, ipole)
subroutine bc_recv_prolong
Receive from coarse neighbor.
subroutine bc_fill_prolong(igrid, iD, iibD)
Send to finer neighbor.
subroutine bc_recv_srl
Receive from sibling at same refinement level.
subroutine bc_fill_restrict(igrid, iD, iibD)
fill coarser neighbor's ghost cells
subroutine fill_coarse_boundary(igrid, iD)
subroutine interpolation_copy(igrid, ixFiL, dxFiD, xFiminD, dxCoD, invdxCoD, xCominD)
subroutine pole_copy_stg(wrecv, ixIRL, ixRL, wsend, ixISL, ixSL, idirs, ipole)
subroutine bc_send_restrict
Send to coarser neighbor.
subroutine pole_buffer(wrecv, ixIRL, ixRL, wsend, ixISL, ixSL)
subroutine fill_boundary_before_gc(igrid)
Physical boundary conditions.
subroutine bc_fill_srl(igrid, iD, iibD)
subroutine bc_fill_restrict_stg
fill restricted ghost cells after receipt
subroutine bc_send_srl
Send to sibling at same refinement level.
subroutine fill_boundary_after_gc(igrid)
Physical boundary conditions.
logical function skip_direction(dir)
subroutine bc_send_prolong
Send to finer neighbor.
subroutine bc_fill_prolong_stg
fill coarser representative with data from coarser neighbors
subroutine bc_prolong_stg(igrid, iD, iibD, NeedProlong)
subroutine, public prolong_2nd_stg(sCo, sFi, ixCoLin, ixFiLin, dxCoD, xCominD, dxFiD, xFiminD, ghost, fine_Lin)
This subroutine performs a 2nd order prolongation for a staggered field F, preserving the divergence ...
update ghost cells of all blocks including physical boundaries
integer, dimension(-1:2^d &,-1:1^d &), target type_recv_srl_f
integer, dimension(-1:1^d &) sizes_r_send_total
integer, dimension(-1:1^d &, 0:3^d &), target type_recv_p_p1
integer, dimension(-1:2^d &,-1:1^d &), target type_recv_srl_p2
integer, dimension(-1:1^d &,-1:1^d &), target type_send_r_p2
integer, dimension(^nd, 0:3) l
integer, dimension(:), allocatable sendrequest_c_p
integer, dimension(^nd,-1:1) ixs_r_stg_
integer, dimension(^nd,-1:1) ixs_srl_stg_
subroutine get_bc_comm_type(comm_type, ixL, ixGL, nwstart, nwbc)
integer, dimension(^nd, 0:3^d &) sizes_p_send_stg
integer, dimension(-1:1^d &) sizes_srl_send_total
integer, dimension(-1:1^d &, 0:3^d &), target type_send_p_p1
subroutine identifyphysbound(s, iibD)
integer, dimension(^nd, 0:3) ixr_r_stg_
integer, dimension(:), allocatable sendrequest_r
integer, dimension(-1:2^d &,-1:1^d &), target type_send_srl_p1
integer, dimension(:), allocatable recvrequest_r
double precision, dimension(:), allocatable sendbuffer_p
integer, dimension(:,:), allocatable sendstatus_c_p
integer, dimension(^nd,-1:1^d &) sizes_r_send_stg
integer, dimension(-1:1^d &, 0:3^d &), target type_send_p_f
integer, dimension(-1:2,-1:1) ixr_srl_
integer, dimension(:^d &,:^d &), pointer type_recv_srl
integer, dimension(:,:), allocatable sendstatus_c_sr
integer, dimension(-1:1^d &, 0:3^d &), target type_recv_r_p2
double precision, dimension(:), allocatable recvbuffer_r
integer, dimension(:), allocatable recvrequest_c_p
subroutine create_bc_mpi_datatype(nwstart, nwbc)
integer, dimension(:), allocatable recvrequest_c_sr
integer, dimension(-1:2^d &,-1:1^d &), target type_recv_srl_p1
integer, dimension(:), allocatable sendrequest_c_sr
integer, dimension(-1:2^d &,-1:1^d &), target type_send_srl_p2
integer, dimension(-1:2,-1:1) ixs_srl_
double precision, dimension(:), allocatable recvbuffer_srl
integer, dimension(:^d &,:^d &), pointer type_send_srl
integer, dimension(:,:), allocatable recvstatus_p
integer, dimension(^nd, 0:3) ixs_p_stg_
integer, dimension(^nd, 0:3^d &) sizes_p_recv_stg
integer, dimension(-1:1^d &, 0:3^d &), target type_recv_p_p2
integer, dimension(-1:1^d &, 0:3^d &), target type_recv_r_f
integer, dimension(:^d &,:^d &), pointer type_recv_r
integer, dimension(:^d &,:^d &), pointer type_send_r
integer, dimension(^nd,-1:1^d &) sizes_srl_recv_stg
double precision, dimension(:), allocatable recvbuffer_p
integer, dimension(^nd,-1:1) ixr_srl_stg_
integer, dimension(-1:1^d &, 0:3^d &), target type_recv_r_p1
double precision, dimension(:), allocatable sendbuffer_r
integer, dimension(-1:1^d &, 0:3^d &), target type_recv_p_f
integer, dimension(-1:1, 0:3) ixr_p_
integer, dimension(-1:1, 0:3) ixr_r_
integer, dimension(0:3^d &) sizes_p_recv_total
integer, dimension(:,:), allocatable recvstatus_c_sr
integer, dimension(0:3^d &) sizes_r_recv_total
integer, parameter npwbuf
integer, dimension(-1:1, 0:3) ixs_p_
integer, dimension(:), allocatable sendrequest_p
integer, dimension(^nd, 0:3^d &) sizes_r_recv_stg
subroutine getbc(time, qdt, psb, nwstart, nwbc, req_diag)
do update ghost cells of all blocks including physical boundaries
subroutine put_bc_comm_types()
double precision, dimension(:), allocatable sendbuffer_srl
integer, dimension(-1:1^d &, 0:3^d &), target type_send_p_p2
integer, dimension(:,:), allocatable sendstatus_srl
integer, dimension(:,:), allocatable recvstatus_srl
integer, dimension(:), allocatable sendrequest_srl
integer, dimension(-1:2^d &,-1:1^d &), target type_send_srl_f
integer, dimension(:,:), allocatable recvstatus_r
integer, dimension(-1:1,-1:1) ixs_r_
integer, dimension(-1:1^d &,-1:1^d &), target type_send_r_p1
integer, dimension(0:3^d &) sizes_p_send_total
integer, dimension(:^d &,:^d &), pointer type_recv_p
integer, dimension(^nd, 0:3) ixr_p_stg_
integer, dimension(:^d &,:^d &), pointer type_send_p
integer, dimension(:,:), allocatable sendstatus_r
integer, dimension(:,:), allocatable sendstatus_p
integer, dimension(-1:1^d &) sizes_srl_recv_total
integer, dimension(-1:1^d &,-1:1^d &), target type_send_r_f
integer, dimension(:), allocatable recvrequest_p
integer, dimension(:), allocatable recvrequest_srl
integer, dimension(^nd,-1:1^d &) sizes_srl_send_stg
integer, dimension(:,:), allocatable recvstatus_c_p
This module contains definitions of global parameters and variables and some generic functions/subrou...
logical internalboundary
if there is an internal boundary
integer ixghi
Upper index of grid block arrays.
integer, dimension(3, 3) kr
Kronecker delta tensor.
integer, parameter ndim
Number of spatial dimensions for grid variables.
logical stagger_grid
True for using stagger grid.
logical, dimension(:), allocatable phyboundblock
True if a block has any physical boundary.
integer, dimension(:), allocatable, parameter d
logical ghost_copy
whether copy values instead of interpolation in ghost cells of finer blocks
integer ierrmpi
A global MPI error return code.
integer nghostcells
Number of ghost cells surrounding a grid.
This module defines the procedures of a physics module. It contains function pointers for the various...
procedure(sub_convert), pointer phys_to_primitive
logical phys_req_diagonal
Whether the physics routines require diagonal ghost cells, for example for computing a curl.
procedure(sub_convert), pointer phys_to_conserved
character(len=name_len) physics_type
String describing the physics type of the simulation.