17 procedure:: scatter_0th
18 procedure:: scatter_1st
19 procedure,
nopass:: weights
29 SUBROUTINE init (self)
33 logical,
save:: first_time=.true.
34 namelist /remesh_params/ verbose, order
36 call trace%begin (
'remesh_t%init')
41 read (io_unit%input, remesh_params, iostat=iostat)
42 write (io_unit%output, remesh_params)
56 SUBROUTINE prolong (self, target, source, jt, pt, all_cells)
58 class(
patch_t),
pointer::
target, source
64 integer:: ll(3), nn(3)
66 call trace%begin (
'remesh_t%prolong')
69 pnt =
target%myposition (
target%mesh%li)
71 ll = source%index_only (pnt, roundup=.true.)
73 call self%scatter_0th (source,
target, ll, nn)
75 ll = source%index_only (pnt)
76 nn = source%mesh%n/2+1
77 call self%scatter_1st (source,
target, ll, nn)
80 write (io_unit%output,
'(a,2i6,3f10.6,2(2x,3i4))') &
81 'remesh_t%prolong: source, target, pnt, ll, nn =', &
82 source%id,
target%id, pnt, ll, nn
85 call io%abort(
'remesh_t%prolong: cannot handle all_cells=.false.')
88 END SUBROUTINE prolong
96 SUBROUTINE scatter_0th (self, coarse, fine, ll, nn)
98 class(
patch_t),
pointer:: coarse, fine
99 integer:: ll(3), nn(3)
102 integer:: i1, i2, i3, j1, j2, j3, iv, lc(3), uc(3), lf(3), uf(3)
103 real,
dimension(:,:,:),
pointer:: c, f
105 integer,
save:: itimer=0
107 call trace%begin (
'remesh_t%scatter_0th', itimer=itimer)
109 if (
present(nn))
then 112 uc = ll + coarse%mesh%n/2 - 1
120 c => coarse%mem(:,:,:,iv,coarse%it,1)
121 f => fine%mem(:,:,:,iv, fine%it,1)
130 f(j1 ,j2 ,j3 ) = c(i1,i2,i3)
131 f(j1+1,j2 ,j3 ) = c(i1,i2,i3)
132 f(j1 ,j2+1,j3 ) = c(i1,i2,i3)
133 f(j1+1,j2+1,j3 ) = c(i1,i2,i3)
134 f(j1 ,j2 ,j3+1) = c(i1,i2,i3)
135 f(j1+1,j2 ,j3+1) = c(i1,i2,i3)
136 f(j1 ,j2+1,j3+1) = c(i1,i2,i3)
137 f(j1+1,j2+1,j3+1) = c(i1,i2,i3)
144 if (verbose > 1)
then 145 s(1) = sum(c(lc(1):uc(1),lc(2):uc(2),lc(3):uc(3)))*product(coarse%ds)
146 s(2) = sum(f(lf(1):uf(1),lf(2):uf(2),lf(3):uf(3)))*product( fine%ds)
147 write (io_unit%output,
'(a,i4,1p,3e12.3,4(2x,3i4))') &
148 'remesh_t%scatter_0th: iv, sum_c, sum_f =', &
149 iv, s, fine%fmaxval(f), lc, uc, lf, uf
152 call trace%end (itimer)
153 END SUBROUTINE scatter_0th
162 SUBROUTINE scatter_1st (self, coarse, fine, ll, nn)
164 class(
patch_t),
pointer:: coarse, fine
165 integer:: ll(3), nn(3)
168 integer:: i1, i2, i3, j1, j2, j3, iv, j, lc(3), uc(3), lf(3), ic(3)
169 real,
dimension(:,:,:),
pointer:: c, f
170 real,
allocatable:: out(:,:), w(:,:)
171 integer,
save:: itimer=0
173 call trace%begin (
'remesh_t%scatter_1st', itimer=itimer)
176 if (
present(nn))
then 179 uc = ll + coarse%mesh%n/2 - 1
182 allocate (out(fine%gn(1),8), w(8,fine%gn(1)))
187 c => coarse%mem(:,:,:,iv,coarse%it,1)
188 f => fine%mem(:,:,:,iv, fine%it,1)
191 do i3=lc(3)-1,uc(3)+1
192 do i2=lc(2)-1,uc(2)+1
198 do i1=lc(1)-1,uc(1)+1
199 out(i1,j) = w(1,j)*c(i1,i2 ,i3 ) + w(2,j)*c(i1+1,i2 ,i3 ) &
200 + w(3,j)*c(i1,i2+1,i3 ) + w(4,j)*c(i1+1,i2+1,i3 ) &
201 + w(5,j)*c(i1,i2 ,i3+1) + w(6,j)*c(i1+1,i2 ,i3+1) &
202 + w(7,j)*c(i1,i2+1,i3+1) + w(8,j)*c(i1+1,i2+1,i3+1)
210 j1 = lf(1) + (i1-ic(1))*2
211 j2 = lf(2) + (i2-ic(2))*2
212 j3 = lf(3) + (i3-ic(3))*2
213 do i1=lc(1)-1,uc(1)+2
215 f(j1 ,j2 ,j3 ) = f(j1 ,j2 ,j3 ) + out(i1,1)
217 f(j1+1,j2 ,j3 ) = f(j1+1,j2 ,j3 ) + out(i1,2)
219 f(j1 ,j2+1,j3 ) = f(j1 ,j2+1,j3 ) + out(i1,3)
221 f(j1+1,j2+1,j3 ) = f(j1+1,j2+1,j3 ) + out(i1,4)
223 f(j1 ,j2 ,j3+1) = f(j1 ,j2 ,j3+1) + out(i1,5)
225 f(j1+1,j2 ,j3+1) = f(j1+1,j2 ,j3+1) + out(i1,6)
227 f(j1 ,j2+1,j3+1) = f(j1 ,j2+1,j3+1) + out(i1,7)
229 f(j1+1,j2+1,j3+1) = f(j1+1,j2+1,j3+1) + out(i1,8)
236 call trace%end (itimer)
237 END SUBROUTINE scatter_1st
248 FUNCTION weights (iv)
RESULT (w)
250 real:: w(8,8), w1, w2, w3
251 integer:: i1, i2, i3, i, j1, j2, j3, j
260 w3 = merge(0.75,0.25,i3==j3)
262 w2 = merge(0.75,0.25,i2==j2)
268 w1 = merge(0.75,0.25,i1==j1)
Support tic/toc timing, as in MATLAB, and accurate wallclock() function. The timing is generally much...
This module handles remeshing, eg from lower resolution to higher resolution, with special attention ...
Template module for patches, which adds pointers to memory and mesh, and number of dimensions and var...