8 double precision,
allocatable ::
xfi(:,:)
13 double precision,
allocatable ::
xt(:^
d&,:)
21 logical,
intent(in) :: mask
22 integer :: refine_factor,ix^D,ix(ndim),j,iFL,numL(ndim),finegrid
23 double precision :: lengthFL
24 double precision :: xprobmin(ndim),xprobmax(ndim),domain_nx(ndim)
30 ^d&xprobmin(^d)=xprobmin^d\
31 ^d&xprobmax(^d)=xprobmax^d\
32 ^d&domain_nx(^d)=domain_nx^d\
33 dl=(xprobmax(ndim)-xprobmin(ndim))/(domain_nx(ndim)*refine_factor)
48 finegrid=mhd_trac_finegrid
49 numl(j)=floor((xprobmax(j)-xprobmin(j))/
dl/finegrid)
53 xfi(:,ndim)=xprobmin(ndim)+
dl/50.d0
54 {
do ix^db=1,numl(^db)\}
58 ifl=ifl+(ix(j)-(ndim-1-j))*(numl(j))**(ndim-1-j)
60 xfi(ifl,1:ndim-1)=xprobmin(1:ndim-1)+finegrid*
dl*ix(1:ndim-1)-finegrid*
dl/2.d0
63 if(
mype .eq. 0)
write(*,*)
'NOTE: 2D TRAC method take the y-dir == grav-dir'
66 if(
mype .eq. 0)
write(*,*)
'NOTE: 3D TRAC method take the z-dir == grav-dir'
70 if (
mype==0)
write(*,*)
'Memory requirement for each processor in TRAC:'
71 if (
mype==0)
write(*,*) memxfi,
' MB'
78 logical,
intent(in) :: mask
79 integer :: refine_factor,finegrid,iFL,j
81 integer :: numL(ndim),ix(ndim)
82 double precision :: lengthFL
83 double precision :: ration,a0
84 double precision :: xprobmin(ndim),xprobmax(ndim),dxT(ndim)
86 refine_factor=2**(refine_max_level-1)
87 ^d&xprobmin(^d)=xprobmin^d\
88 ^d&xprobmax(^d)=xprobmax^d\
89 ^d&dxt^d=(xprobmax^d-xprobmin^d)/(domain_nx^d*refine_factor/block_nx^d)\
91 finegrid=mhd_trac_finegrid
96 dl=min(dxt^d)/finegrid
99 ^d&
xtmin(^d)=xprobmin^d\
100 ^d&
xtmax(^d)=xprobmax^d\
101 if(mask)
xtmax(ndim)=phys_trac_mask
104 lengthfl=maxval(
xtmax-xprobmin)*3.d0
106 lengthfl=maxval(xprobmax-xprobmin)*3.d0
114 xt(j^d%ixT^s,^d)=(j-0.5d0)*dxt^d+
xtmin(^d)
116 if(mask)
xtmax(ndim)=maxval(
xt(:^
d&,ndim))+half*
dxt(ndim)
121 numl(j)=floor((xprobmax(j)-xprobmin(j))/
dl)
125 xfi(:,ndim)=xprobmin(ndim)+
dl/50.d0
126 {
do ix^db=1,numl(^db)\}
130 ifl=ifl+(ix(j)-(ndim-1-j))*(numl(j))**(ndim-1-j)
132 xfi(ifl,1:ndim-1)=xprobmin(1:ndim-1)+
dl*ix(1:ndim-1)-
dl/2.d0
135 if(mype .eq. 0)
write(*,*)
'NOTE: 2D TRAC method take the y-dir == grav-dir'
138 if(mype .eq. 0)
write(*,*)
'NOTE: 3D TRAC method take the z-dir == grav-dir'
143 double precision,
intent(in) :: tco_global, trac_alfa,T_peak
144 integer :: iigrid, igrid
146 do iigrid=1,igridstail_active; igrid=igrids_active(iigrid);
148 ps(igrid)%special_values(1)=tco_global
150 if(ps(igrid)%special_values(1)<trac_alfa*ps(igrid)%special_values(2))
then
151 ps(igrid)%special_values(1)=trac_alfa*ps(igrid)%special_values(2)
153 if(ps(igrid)%special_values(1) .lt.
t_bott)
then
154 ps(igrid)%special_values(1)=
t_bott
155 else if(ps(igrid)%special_values(1) .gt. 0.2d0*t_peak)
then
156 ps(igrid)%special_values(1)=0.2d0*t_peak
158 ps(igrid)%wextra(ixg^t,iw_tcoff)=ps(igrid)%special_values(1)
160 ps(igrid)%special_values(2)=ps(igrid)%special_values(1)
165 double precision,
intent(in) :: T_peak
166 integer :: iigrid, igrid
167 integer :: ixO^L,trac_tcoff
171 do iigrid=1,igridstail_active; igrid=igrids_active(iigrid);
172 where(ps(igrid)%wextra(ixo^s,trac_tcoff) .lt.
t_bott)
173 ps(igrid)%wextra(ixo^s,trac_tcoff)=
t_bott
174 else where(ps(igrid)%wextra(ixo^s,trac_tcoff) .gt. 0.2d0*t_peak)
175 ps(igrid)%wextra(ixo^s,trac_tcoff)=0.2d0*t_peak
181 logical,
intent(in) :: mask
182 double precision,
intent(in) :: T_peak
184 integer :: iigrid, igrid
185 double precision :: xF(numFL,numLP,ndim)
186 integer :: numR(numFL),ix^L
187 double precision :: Tlcoff(numFL)
188 integer :: ipel(numFL,numLP),igridl(numFL,numLP)
189 logical :: forwardl(numFL)
198 call mpi_barrier(icomm,ierrmpi)
213 call mpi_barrier(icomm,ierrmpi)
219 logical,
intent(in) :: mask
220 double precision,
intent(in) :: T_peak
221 integer :: peArr(numxT^D),gdArr(numxT^D),numR(numFL)
222 double precision :: Tcoff(numxT^D),Tcmax(numxT^D),Bdir(numxT^D,ndim)
223 double precision :: xF(numFL,numLP,ndim),Tcoff_line(numFL)
224 integer :: xpe(numFL,numLP,2**ndim)
225 integer :: xgd(numFL,numLP,2**ndim)
237 call block_trace_mfl(mask,tcoff,tcoff_line,tcmax,bdir,pearr,gdarr,xf,numr,xpe,xgd)
243 double precision :: Tcoff(numxT^D),Tcoff_recv(numxT^D)
244 double precision :: Tcmax(numxT^D),Tcmax_recv(numxT^D)
245 double precision :: Bdir(numxT^D,ndim),Bdir_recv(numxT^D,ndim)
246 integer :: peArr(numxT^D),peArr_recv(numxT^D)
247 integer :: gdArr(numxT^D),gdArr_recv(numxT^D)
248 integer :: xc^L,xd^L,ix^D
249 integer :: iigrid,igrid,numxT,intab
250 double precision :: xb^L
258 xcmin^d=nghostcells+1\
259 xcmax^d=block_nx^d+nghostcells\
260 do iigrid=1,igridstail; igrid=igrids(iigrid);
261 ps(igrid)%wextra(:^d&,tweight_)=zero
262 ps(igrid)%wextra(:^d&,tcoff_)=zero
263 ^d&xbmin^d=rnode(rpxmin^d_,igrid)-
xtmin(^d)\
264 ^d&xbmax^d=rnode(rpxmax^d_,igrid)-
xtmin(^d)\
265 xdmin^d=nint(xbmin^d/
dxt^d)+1\
266 xdmax^d=ceiling((xbmax^d-smalldouble)/
dxt^d)\
267 {
do ix^d=xdmin^d,xdmax^d \}
269 {
if (ix^d .le. numxt^d) intab=intab+1 \}
270 if(intab .eq. ndim)
then
272 tcoff(ix^d)=max(tcoff(ix^d),ps(igrid)%special_values(1))
273 tcmax(ix^d)=ps(igrid)%special_values(2)
275 bdir(ix^d,1:ndim)=ps(igrid)%special_values(3:3+ndim-1)+2.d0
281 call mpi_barrier(icomm,ierrmpi)
283 call mpi_allreduce(pearr,pearr_recv,
numxt,mpi_integer,&
284 mpi_max,icomm,ierrmpi)
285 call mpi_allreduce(gdarr,gdarr_recv,
numxt,mpi_integer,&
286 mpi_max,icomm,ierrmpi)
287 call mpi_allreduce(tcoff,tcoff_recv,
numxt,mpi_double_precision,&
288 mpi_max,icomm,ierrmpi)
289 call mpi_allreduce(bdir,bdir_recv,
numxt*ndim,mpi_double_precision,&
290 mpi_max,icomm,ierrmpi)
292 call mpi_allreduce(tcmax,tcmax_recv,
numxt,mpi_double_precision,&
293 mpi_max,icomm,ierrmpi)
299 if(.not. mask) tcmax=tcmax_recv
302 subroutine block_trace_mfl(mask,Tcoff,Tcoff_line,Tcmax,Bdir,peArr,gdArr,xF,numR,xpe,xgd)
303 integer :: i,j,k,k^D,ix_next^D
304 logical :: mask,flag,first
305 double precision :: Tcoff(numxT^D),Tcoff_line(numFL)
306 double precision :: Tcmax(numxT^D),Tcmax_line(numFL)
307 double precision :: xF(numFL,numLP,ndim)
308 integer :: ix_mod(ndim,2),numR(numFL)
309 double precision :: alfa_mod(ndim,2)
310 double precision :: nowpoint(ndim),nowgridc(ndim)
311 double precision :: Bdir(numxT^D,ndim)
312 double precision :: init_dir,now_dir1(ndim),now_dir2(ndim)
313 integer :: peArr(numxT^D),xpe(numFL,numLP,2**ndim)
314 integer :: gdArr(numxT^D),xgd(numFL,numLP,2**ndim)
318 ^d&k^d=ceiling((
xfi(i,^d)-
xtmin(^d)-smalldouble)/
dxt^d)\
319 tcoff_line(i)=tcoff(k^d)
320 if(.not. mask) tcmax_line(i)=tcmax(k^d)
325 nowpoint(:)=xf(i,j,:)
326 nowgridc(:)=
xt(ix_next^d,:)
329 call rk_bdir(nowgridc,nowpoint,ix_next^d,now_dir1,bdir,&
330 ix_mod,first,init_dir)
332 call rk_bdir(nowgridc,nowpoint,ix_next^d,now_dir1,bdir,&
336 xgd(i,j,1)=gdarr(ix_mod(1,1),ix_mod(2,1))
337 xgd(i,j,2)=gdarr(ix_mod(1,2),ix_mod(2,1))
338 xgd(i,j,3)=gdarr(ix_mod(1,1),ix_mod(2,2))
339 xgd(i,j,4)=gdarr(ix_mod(1,2),ix_mod(2,2))
340 xpe(i,j,1)=pearr(ix_mod(1,1),ix_mod(2,1))
341 xpe(i,j,2)=pearr(ix_mod(1,2),ix_mod(2,1))
342 xpe(i,j,3)=pearr(ix_mod(1,1),ix_mod(2,2))
343 xpe(i,j,4)=pearr(ix_mod(1,2),ix_mod(2,2))
346 xgd(i,j,1)=gdarr(ix_mod(1,1),ix_mod(2,1),ix_mod(3,1))
347 xgd(i,j,2)=gdarr(ix_mod(1,2),ix_mod(2,1),ix_mod(3,1))
348 xgd(i,j,3)=gdarr(ix_mod(1,1),ix_mod(2,2),ix_mod(3,1))
349 xgd(i,j,4)=gdarr(ix_mod(1,2),ix_mod(2,2),ix_mod(3,1))
350 xgd(i,j,5)=gdarr(ix_mod(1,1),ix_mod(2,1),ix_mod(3,2))
351 xgd(i,j,6)=gdarr(ix_mod(1,2),ix_mod(2,1),ix_mod(3,2))
352 xgd(i,j,7)=gdarr(ix_mod(1,1),ix_mod(2,2),ix_mod(3,2))
353 xgd(i,j,8)=gdarr(ix_mod(1,2),ix_mod(2,2),ix_mod(3,2))
354 xpe(i,j,1)=pearr(ix_mod(1,1),ix_mod(2,1),ix_mod(3,1))
355 xpe(i,j,2)=pearr(ix_mod(1,2),ix_mod(2,1),ix_mod(3,1))
356 xpe(i,j,3)=pearr(ix_mod(1,1),ix_mod(2,2),ix_mod(3,1))
357 xpe(i,j,4)=pearr(ix_mod(1,2),ix_mod(2,2),ix_mod(3,1))
358 xpe(i,j,5)=pearr(ix_mod(1,1),ix_mod(2,1),ix_mod(3,2))
359 xpe(i,j,6)=pearr(ix_mod(1,2),ix_mod(2,1),ix_mod(3,2))
360 xpe(i,j,7)=pearr(ix_mod(1,1),ix_mod(2,2),ix_mod(3,2))
361 xpe(i,j,8)=pearr(ix_mod(1,2),ix_mod(2,2),ix_mod(3,2))
363 nowpoint(:)=nowpoint(:)+init_dir*now_dir1*
dl
364 {
if(nowpoint(^d) .gt.
xtmax(^d) .or. nowpoint(^d) .lt.
xtmin(^d))
then
367 if(mask .and. nowpoint(ndim) .gt. phys_trac_mask)
then
372 ^
d&ix_next^
d=ceiling((nowpoint(^
d)-
xtmin(^
d)-smalldouble)/
dxt^
d)\
373 nowgridc(:)=
xt(ix_next^
d,:)
374 call rk_bdir(nowgridc,nowpoint,ix_next^
d,now_dir2,bdir,&
376 xf(i,j+1,:)=xf(i,j,:)+init_dir*
dl*half*(now_dir1+now_dir2)
377 {
if(xf(i,j+1,^
d) .gt.
xtmax(^
d) .or. xf(i,j+1,^
d) .lt.
xtmin(^
d))
then
380 if(mask .and. xf(i,j+1,ndim) .gt. phys_trac_mask)
then
384 ^
d&ix_next^
d=ceiling((xf(i,j+1,^
d)-
xtmin(^
d)-smalldouble)/
dxt^
d)\
386 tcoff_line(i)=max(tcoff_line(i),tcoff(ix_next^
d))
387 if(.not.mask) tcmax_line(i)=max(tcmax_line(i),tcmax(ix_next^
d))
393 if(tcoff_line(i) .gt.
tmax*0.2d0)
then
394 tcoff_line(i)=
tmax*0.2d0
397 if(tcoff_line(i) .gt. tcmax_line(i)*0.2d0)
then
398 tcoff_line(i)=tcmax_line(i)*0.2d0
404 subroutine rk_bdir(nowgridc,nowpoint,ix_next^D,now_dir,Bdir,ix_mod,first,init_dir)
405 double precision :: nowpoint(ndim),nowgridc(ndim)
406 integer :: ix_mod(ndim,2)
407 double precision :: alfa_mod(ndim,2)
408 integer :: ix_next^D,k^D
409 double precision :: now_dir(ndim)
410 double precision :: Bdir(numxT^D,ndim)
412 double precision,
optional :: init_dir
414 {
if(nowpoint(^d) .gt.
xtmin(^d)+half*
dxt^d .and. nowpoint(^d) .lt.
xtmax(^d)-half*
dxt^d)
then
415 if(nowpoint(^d) .le. nowgridc(^d))
then
416 ix_mod(^d,1)=ix_next^d-1
417 ix_mod(^d,2)=ix_next^d
418 alfa_mod(^d,1)=abs(nowgridc(^d)-nowpoint(^d))/
dxt^d
419 alfa_mod(^d,2)=one-alfa_mod(^d,1)
421 ix_mod(^d,1)=ix_next^d
422 ix_mod(^d,2)=ix_next^d+1
423 alfa_mod(^d,2)=abs(nowgridc(^d)-nowpoint(^d))/
dxt^d
424 alfa_mod(^d,1)=one-alfa_mod(^d,2)
427 ix_mod(^d,:)=ix_next^d
434 now_dir=now_dir + bdir(ix_mod(1,k1),ix_mod(2,k2),:)*alfa_mod(1,k1)*alfa_mod(2,k2)
442 now_dir=now_dir + bdir(ix_mod(1,k1),ix_mod(2,k2),ix_mod(3,k3),:)&
443 *alfa_mod(1,k1)*alfa_mod(2,k2)*alfa_mod(3,k3)
448 if(
present(init_dir))
then
449 init_dir=sign(one,now_dir(ndim))
455 double precision :: xF(numFL,numLP,ndim)
456 integer :: numR(numFL)
457 integer :: xpe(numFL,numLP,2**ndim)
458 integer :: xgd(numFL,numLP,2**ndim)
459 double precision :: Tcoff_line(numFL)
460 double precision :: weightIndex,weight,ds
461 integer :: i,j,k,igrid,iigrid,ixO^L,ixc^L,ixc^D
462 double precision :: dxMax^D,dxb^D
471 if(mype .eq. xpe(i,j,k))
then
473 if(igrid .le. igrids(igridstail))
then
474 ^d&dxb^d=rnode(rpdx^d_,igrid)\
475 ^d&ixcmin^d=floor((xf(i,j,^d)-dxmax^d-ps(igrid)%x(ixomin^dd,^d))/dxb^d)+ixomin^d\
476 ^d&ixcmax^d=floor((xf(i,j,^d)+dxmax^d-ps(igrid)%x(ixomin^dd,^d))/dxb^d)+ixomin^d\
477 {
if (ixcmin^d<ixomin^d) ixcmin^d=ixomin^d\}
478 {
if (ixcmax^d>ixomax^d) ixcmax^d=ixomax^d\}
479 {
do ixc^d=ixcmin^d,ixcmax^d\}
481 {ds=ds+(xf(i,j,^d)-ps(igrid)%x(ixc^dd,^d))**2\}
483 if(ds .le. 0.099d0*
dl)
then
484 weight=(1/(0.099d0*
dl))**weightindex
486 weight=(1/ds)**weightindex
488 ps(igrid)%wextra(ixc^d,tweight_)=ps(igrid)%wextra(ixc^d,tweight_)+weight
489 ps(igrid)%wextra(ixc^d,tcoff_)=ps(igrid)%wextra(ixc^d,tcoff_)+weight*tcoff_line(i)
492 call mpistop(
"we need to check here 366Line in mod_trac.t")
499 do iigrid=1,igridstail; igrid=igrids(iigrid);
500 where (ps(igrid)%wextra(ixo^s,tweight_)>0.d0)
501 ps(igrid)%wextra(ixo^s,tcoff_)=ps(igrid)%wextra(ixo^s,tcoff_)/ps(igrid)%wextra(ixo^s,tweight_)
503 ps(igrid)%wextra(ixo^s,tcoff_)=0.2d0*
tmax
522 integer :: ixI^L,ixO^L,igrid,iigrid
527 do iigrid=1,igridstail; igrid=igrids(iigrid);
528 ps(igrid)%wextra(ixi^s,tcoff_)=0.d0
529 ps(igrid)%wextra(ixi^s,tweight_)=0.d0
550 double precision :: dxb^D,xb^L
551 integer :: iigrid,igrid,j
552 logical,
allocatable :: trac_pe_recv(:)
553 double precision :: hcmax_bt
555 allocate(trac_pe_recv(
npe))
559 do iigrid=1,igridstail; igrid=igrids(iigrid);
565 if (xbmin^nd<hcmax_bt)
then
575 deallocate(trac_pe_recv)
580 integer :: ixI^L,ixO^L,igrid,iigrid,j
588 call mhd_get_pthermal(ps(igrid)%w,ps(igrid)%x,ixi^l,ixi^l,ps(igrid)%wextra(ixi^s,tcoff_))
590 if(has_equi_rho0)
then
591 ps(igrid)%wextra(ixi^s,tcoff_)=ps(igrid)%wextra(ixi^s,tcoff_)/&
592 (ps(igrid)%w(ixi^s,rho_) + ps(igrid)%equi_vars(ixi^s,equi_rho0_,0))
594 ps(igrid)%wextra(ixi^s,tcoff_)=ps(igrid)%wextra(ixi^s,tcoff_)/ps(igrid)%w(ixi^s,rho_)
601 integer :: ipel(numFL,numLP),igridl(numFL,numLP)
602 logical :: forwardl(numFL)
604 integer :: igrid,ixO^L,iFL,j,ix^D,idir,ixb^D,ixbb^D
605 double precision :: xb^L,dxb^D,xd^D,factor,Bh
606 integer :: numL(ndim),ixmin(ndim),ixmax(ndim),ix(ndim)
607 logical :: forwardRC(numFL)
618 ^d&dxb^d=rnode(rpdx^d_,igrid);
619 ^d&xbmin^d=rnode(rpxmin^d_,igrid);
620 ^d&xbmax^d=rnode(rpxmax^d_,igrid);
621 ^d&ixmin(^d)=floor((xbmin^d-xprobmin^d)/(mhd_trac_finegrid*
dl))+1;
622 ^d&ixmax(^d)=floor((xbmax^d-xprobmin^d)/(mhd_trac_finegrid*
dl));
623 ^d&numl(^d)=floor((xprobmax^d-xprobmin^d)/(mhd_trac_finegrid*
dl));
628 {
do ix^db=ixmin(^db),ixmax(^db)\}
632 ifl=ifl+(ix(idir)-(ndim-1-idir))*(numl(idir))**(ndim-1-idir)
637 ^d&ixb^d=floor((
xfi(ifl,^d)-ps(igrid)%x(ixomin^dd,^d))/dxb^d)+ixomin^d;
638 ^d&xd^d=(
xfi(ifl,^d)-ps(igrid)%x(ixb^dd,^d))/dxb^d;
641 factor={abs(1-ix^d-xd^d)*}
643 bh=bh+factor*(ps(igrid)%w(ixb^d+ixbb^d,mag(^nd))+ps(igrid)%B0(ixb^d+ixbb^d,^nd,0))
645 bh=bh+factor*ps(igrid)%w(ixb^d+ixbb^d,mag(^nd))
651 forwardl(ifl)=.false.
656 call mpi_allreduce(forwardl,forwardrc,numfl,mpi_logical,&
657 mpi_land,icomm,ierrmpi)
665 double precision :: xFL(numFL,numLP,ndim)
666 integer :: numR(numFL)
667 double precision :: TcoffFL(numFL),TmaxFL(numFL)
668 integer :: ipeFL(numFL,numLP),igridFL(numFL,numLP)
669 logical :: forwardFL(numFL)
670 logical,
intent(in) :: mask
672 integer :: nwP,nwL,iFL,iLP
673 double precision :: wPm(numFL,numLP,2),wLm(numFL,1+2)
674 character(len=std_len) :: ftype,tcondi
680 call trace_field_multi(xfl,wpm,wlm,
dl,numfl,numlp,nwp,nwl,forwardfl,ftype,tcondi)
682 numr(ifl)=int(wlm(ifl,1))
683 tcofffl(ifl)=wlm(ifl,2)
684 tmaxfl(ifl)=wlm(ifl,3)
686 if(tcofffl(ifl)>0.2d0*
tmax) tcofffl(ifl)=0.2d0*
tmax
688 tmaxfl(ifl)=wlm(ifl,3)
689 if(tcofffl(ifl)>0.2d0*tmaxfl(ifl)) tcofffl(ifl)=0.2d0*tmaxfl(ifl)
696 if (numr(ifl)>0)
then
698 ipefl(ifl,ilp)=int(wpm(ifl,ilp,1))
699 igridfl(ifl,ilp)=int(wpm(ifl,ilp,2))
708 double precision :: xF(numFL,numLP,ndim)
709 integer :: numR(numFL),ipel(numFL,numLP),igridl(numFL,numLP)
710 double precision :: Tlcoff(numFL)
712 integer :: iFL,iLP,ixO^L,ixI^L,ixc^L,ixb^L,ixc^D
713 integer :: igrid,j,ipmin,ipmax,igrid_nb
714 double precision :: dxb^D,dxMax^D,xb^L,Tcnow
715 double precision :: xFnow(ndim)
716 integer :: weightIndex,idn^D,ixmax^ND
717 double precision :: ds,weight
729 do while (ilp<=numr(ifl))
732 do while (ipel(ifl,ipmin)/=mype .and. ipmin<=numr(ifl))
735 igrid=igridl(ifl,ipmin)
737 do while (ipel(ifl,ipmax)==mype .and. igridl(ifl,ipmax+1)==igrid .and. ipmax<numr(ifl))
742 ^d&dxb^d=rnode(rpdx^d_,igrid);
746 xfnow(:)=xf(ifl,ilp,:)
747 ^d&ixbmin^d=floor((xfnow(^d)-dxmax^d-ps(igrid)%x(ixomin^dd,^d))/dxb^d)+ixomin^d;
748 ^d&ixbmax^d=floor((xfnow(^d)+dxmax^d-ps(igrid)%x(ixomin^dd,^d))/dxb^d)+ixomin^d;
751 {ixcmin^d=max(ixbmin^d,ixomin^d)\}
752 {ixcmax^d=min(ixbmax^d,ixomax^d)\}
753 xbmin^nd=rnode(rpxmin^nd_,igrid)
754 xbmax^nd=rnode(rpxmax^nd_,igrid)
755 ixmax^nd=floor((phys_trac_mask-xbmin^nd)/dxb^nd)+ixomin^nd
756 if (xbmax^nd>phys_trac_mask) ixcmax^nd=min(ixmax^nd,ixcmax^nd)
757 {
do ixc^d=ixcmin^d,ixcmax^d\}
759 {ds=ds+(xfnow(^d)-ps(igrid)%x(ixc^dd,^d))**2\}
761 if(ds<1.0d-2*dxb1)
then
762 weight=(1/(1.0d-2*dxb1))**weightindex
764 weight=(1/ds)**weightindex
766 ps(igrid)%wextra(ixc^d,tweight_)=ps(igrid)%wextra(ixc^d,tweight_)+weight
767 ps(igrid)%wextra(ixc^d,tcoff_)=ps(igrid)%wextra(ixc^d,tcoff_)+weight*tcnow
772 if (ixbmin^d<ixomin^d)
then
775 if (neighbor(2,idn^dd,igrid)==mype .and. neighbor_type(idn^dd,igrid)==neighbor_sibling)
then
776 igrid_nb=neighbor(1,idn^dd,igrid)
777 ixcmin^dd=max(ixbmin^dd,ixomin^dd);
778 ixcmax^dd=min(ixbmax^dd,ixomax^dd);
779 ixcmin^d=ixomax^d+(ixbmin^d-ixomin^d)
781 xbmin^nd=rnode(rpxmin^nd_,igrid_nb)
782 xbmax^nd=rnode(rpxmax^nd_,igrid_nb)
783 ixmax^nd=floor((phys_trac_mask-xbmin^nd)/dxb^nd)+ixomin^nd
784 if (xbmax^nd>phys_trac_mask) ixcmax^nd=min(ixmax^nd,ixcmax^nd)
786 {
do ixc^dd=ixcmin^dd,ixcmax^dd;}
788 {ds=ds+(xfnow(^dd)-ps(igrid_nb)%x({ixc^dd},^dd))**2;}
790 if(ds<1.0d-2*dxb1)
then
791 weight=(1/(1.0d-2*dxb1))**weightindex
793 weight=(1/ds)**weightindex
795 ps(igrid_nb)%wextra(ixc^dd,tweight_)=ps(igrid_nb)%wextra(ixc^dd,tweight_)+weight
796 ps(igrid_nb)%wextra(ixc^dd,tcoff_)=ps(igrid_nb)%wextra(ixc^dd,tcoff_)+weight*tcnow
801 if (ixbmax^d>ixomin^d)
then
804 if (neighbor(2,idn^dd,igrid)==mype .and. neighbor_type(idn^dd,igrid)==neighbor_sibling)
then
805 igrid_nb=neighbor(1,idn^dd,igrid)
806 xbmin^nd=rnode(rpxmin^nd_,igrid_nb)
807 if (xbmin^nd<phys_trac_mask)
then
808 ixcmin^dd=max(ixbmin^dd,ixomin^dd);
809 ixcmax^dd=min(ixbmax^dd,ixomax^dd);
811 ixcmax^d=ixomin^d+(ixbmax^d-ixomax^d)
812 xbmax^nd=rnode(rpxmax^nd_,igrid_nb)
813 ixmax^nd=floor((phys_trac_mask-xbmin^nd)/dxb^nd)+ixomin^nd
814 if (xbmax^nd>phys_trac_mask) ixcmax^nd=min(ixmax^nd,ixcmax^nd)
816 {
do ixc^dd=ixcmin^dd,ixcmax^dd;}
818 {ds=ds+(xfnow(^dd)-ps(igrid_nb)%x({ixc^dd},^dd))**2;}
820 if(ds<1.0d-2*dxb1)
then
821 weight=(1/(1.0d-2*dxb1))**weightindex
823 weight=(1/ds)**weightindex
825 ps(igrid_nb)%wextra(ixc^dd,tweight_)=ps(igrid_nb)%wextra(ixc^dd,tweight_)+weight
826 ps(igrid_nb)%wextra(ixc^dd,tcoff_)=ps(igrid_nb)%wextra(ixc^dd,tcoff_)+weight*tcnow
841 where(ps(igrid)%wextra(ixo^s,tweight_)>0.d0)
842 ps(igrid)%wextra(ixo^s,tcoff_)=ps(igrid)%wextra(ixo^s,tcoff_)/ps(igrid)%wextra(ixo^s,tweight_)
844 ps(igrid)%wextra(ixo^s,tcoff_)=
t_bott
subroutine mpistop(message)
Exit MPI-AMRVAC with an error message.
This module contains definitions of global parameters and variables and some generic functions/subrou...
integer domain_nx
number of cells for each dimension in level-one mesh
double precision phys_trac_mask
integer, parameter ndim
Number of spatial dimensions for grid variables.
integer, parameter rpxmin
integer icomm
The MPI communicator.
integer mype
The rank of the current MPI task.
integer ierrmpi
A global MPI error return code.
integer npe
The number of MPI tasks.
double precision, dimension(:,:), allocatable rnode
Corner coordinates.
integer refine_max_level
Maximal number of AMR levels.
integer max_blocks
The maximum number of grid blocks in a processor.
subroutine get_btracing_dir(ipel, igridl, forwardl)
subroutine rk_bdir(nowgridc, nowpoint, ix_nextD, now_dir, Bdir, ix_mod, first, init_dir)
subroutine tracb(mask, T_peak)
subroutine init_trac_block(mask)
double precision, dimension(:,:), allocatable xfi
double precision, dimension(:^d &,:), allocatable xt
double precision, dimension(ndim) xtmax
subroutine interp_tcoff(xF, ipel, igridl, numR, Tlcoff)
subroutine block_estable(mask, Tcoff, Tcmax, Bdir, peArr, gdArr)
subroutine update_pegrid()
subroutine get_tcoff_line(xFL, numR, TcoffFL, ipeFL, igridFL, forwardFL, mask)
subroutine block_trace_mfl(mask, Tcoff, Tcoff_line, Tcmax, Bdir, peArr, gdArr, xF, numR, xpe, xgd)
logical, dimension(:), allocatable trac_pe
integer, dimension(:), allocatable ground_grid
double precision trac_delta
subroutine block_interp_grid(mask, xF, numR, xpe, xgd, Tcoff_line)
subroutine init_trac_tcoff()
integer, dimension(:), allocatable trac_grid
subroutine traverse_gridtable()
subroutine trac_simple(tco_global, trac_alfa, T_peak)
subroutine tracl(mask, T_peak)
double precision, dimension(ndim) xtmin
subroutine init_trac_line(mask)
subroutine trace_field_multi(xfm, wPm, wLm, dL, numL, numP, nwP, nwL, forwardm, ftype, tcondi)