PlasCom2  1.0
XPACC Multi-physics simluation application
ApplyOperator.f90
Go to the documentation of this file.
1 MODULE operators
2 
3  IMPLICIT NONE
4 
5 CONTAINS
6 
9 
34  SUBROUTINE applyoperator(numDim,dimSizes,numComponents,numPoints,opDir,opInterval,numStencils, &
35  stencilSizes,stencilStarts,numValues,stencilWeights,stencilOffsets,stencilID,U,dU)
36 
37  IMPLICIT NONE
38 
39  INTEGER(KIND=4), INTENT(IN) :: numDim, opDir,numStencils, numValues, numComponents
40  INTEGER(KIND=8), INTENT(IN) :: dimSizes(numdim), numPoints
41  INTEGER(KIND=8), INTENT(IN) :: opInterval(2*numdim)
42  INTEGER(KIND=4), INTENT(IN) :: stencilSizes(numstencils),stencilStarts(numstencils)
43  INTEGER(KIND=4), INTENT(IN) :: stencilOffsets(numvalues)
44  REAL(KIND=8), INTENT(IN) :: stencilWeights(numvalues)
45  INTEGER(KIND=4), INTENT(IN) :: stencilID(numpoints)
46  REAL(KIND=8), INTENT(IN) :: U(numpoints)
47  REAL(KIND=8), INTENT(OUT) :: dU(numpoints)
48 
49  INTEGER(KIND=8) :: I, J, K, jIndex, jkIndex, kIndex
50  REAL(KIND=8) :: fac
51  INTEGER(KIND=8) :: plane, pointOffset, iPoint
52  INTEGER(KIND=4) :: iStencil, iWeight
53 
54  ! WRITE(*,*) 'NUMDIM = ',numDim,'OPDIR = ',opDir
55 
56  ! dU(:) = 0.0_8
57  IF(numdim == 1) THEN
58  DO i = opinterval(1), opinterval(2)
59  istencil = stencilid(i)
60  du(i) = 0.0_8
61  DO iweight = stencilstarts(istencil),stencilstarts(istencil)+stencilsizes(istencil) - 1
62  du(i) = du(i) + stencilweights(iweight)*u(i+stenciloffsets(iweight))
63  END DO
64  END DO
65  ELSE IF(numdim == 2) THEN
66  IF(opdir == 1) THEN
67  DO j = opinterval(3), opinterval(4)
68  jindex = (j-1)*dimsizes(1)
69  DO i = opinterval(1), opinterval(2)
70  ipoint = jindex + i
71  istencil = stencilid(ipoint)
72  du(ipoint) = 0.0_8
73  DO iweight = stencilstarts(istencil),stencilstarts(istencil)+stencilsizes(istencil) - 1
74  du(ipoint) = du(ipoint) + stencilweights(iweight)*u(ipoint+stenciloffsets(iweight))
75  END DO
76  END DO
77  END DO
78  ELSE IF(opdir == 2) THEN
79  plane = dimsizes(1)
80  DO j = opinterval(3), opinterval(4)
81  jindex = (j-1)*plane
82  DO i = opinterval(1), opinterval(2)
83  ipoint = jindex + i
84  istencil = stencilid(ipoint)
85  du(ipoint) = 0.0_8
86  DO iweight = stencilstarts(istencil),stencilstarts(istencil)+stencilsizes(istencil) - 1
87  du(ipoint) = du(ipoint) + stencilweights(iweight)*u(ipoint+stenciloffsets(iweight)*plane)
88  END DO
89  END DO
90  END DO
91  ENDIF
92  ELSE IF(numdim == 3) THEN
93  plane = dimsizes(1) * dimsizes(2)
94  IF(opdir == 1) THEN
95  DO k = opinterval(5), opinterval(6)
96  kindex = (k-1)*plane
97  DO j = opinterval(3), opinterval(4)
98  jkindex = kindex + (j-1)*dimsizes(1)
99  DO i = opinterval(1), opinterval(2)
100  ipoint = jkindex + i
101  istencil = stencilid(ipoint)
102  du(ipoint) = 0.0_8
103  DO iweight = stencilstarts(istencil),stencilstarts(istencil)+stencilsizes(istencil) - 1
104  du(ipoint) = du(ipoint) + stencilweights(iweight)*u(ipoint+stenciloffsets(iweight))
105  END DO
106  END DO
107  END DO
108  END DO
109  ELSE
110  ! WRITE(*,*) 'IN 3D OPDIR(',opDir,')'
111  pointoffset = 1
112  IF(opdir == 2) THEN
113  pointoffset = dimsizes(1)
114  ELSE
115  pointoffset = plane
116  ENDIF
117  ! WRITE(*,*) 'OPINTERVAL(',opInterval(:),')'
118  DO k = opinterval(5), opinterval(6)
119  kindex = (k-1)*plane
120  DO j = opinterval(3), opinterval(4)
121  jkindex = kindex + (j-1)*dimsizes(1)
122  DO i = opinterval(1), opinterval(2)
123  ipoint = jkindex + i
124  istencil = stencilid(ipoint)
125  ! WRITE(*,*) ' PROCESSING POINT ',iPoint
126  du(ipoint) = 0.0_8
127  DO iweight = stencilstarts(istencil),stencilstarts(istencil)+stencilsizes(istencil) - 1
128  ! WRITE(*,*) 'DU[',iPoint,'](',I,',',J,',',K,') += ',stencilWeights(iWeight),'*U(',iPoint,&
129  ! '+',stencilOffsets(iWeight),'*',pointOffset,')'
130  ! WRITE(*,*) 'DU[',iPoint,'](',I,',',J,',',K,')<',DU(iPoint),'> += ',stencilWeights(iWeight),'*',&
131  ! U(iPoint+stencilOffsets(iWeight)*pointOffset)
132  du(ipoint) = du(ipoint) + stencilweights(iweight)*u(ipoint+stenciloffsets(iweight)*pointoffset)
133  END DO
134  END DO
135  END DO
136  END DO
137  ENDIF
138  ENDIF
139 
140  END SUBROUTINE applyoperator
141 
167  SUBROUTINE applyoperatorblobs(numDim,dimSizes,numComponents,numPointsBuffer,opDir,numStencils, &
168  stencilSizes,stencilStarts,numStencilValues,stencilWeights,stencilOffsets,numPointsStencil,&
169  numPointsApply,stencilPoints,U,dU)
170 
171  IMPLICIT NONE
172 
173  INTEGER(KIND=4), INTENT(IN) :: numDim, opDir,numStencils, numStencilValues, numComponents
174  INTEGER(KIND=8), INTENT(IN) :: numPointsApply, numPointsBuffer
175  INTEGER(KIND=8), INTENT(IN) :: dimSizes(numdim),numPointsStencil(numstencils)
176  INTEGER(KIND=8), INTENT(IN) :: stencilPoints(numpointsapply)
177  INTEGER(KIND=4), INTENT(IN) :: stencilSizes(numstencils),stencilStarts(numstencils)
178  INTEGER(KIND=4), INTENT(IN) :: stencilOffsets(numstencilvalues)
179  REAL(KIND=8), INTENT(IN) :: stencilWeights(numstencilvalues)
180  REAL(KIND=8), INTENT(IN) :: U(numpointsbuffer)
181  REAL(KIND=8), INTENT(OUT) :: dU(numpointsbuffer)
182 
183  INTEGER(KIND=8) :: stencilPointsOffset, iPoint, pointsStart,pointsEnd,numPointsThisStencil
184  INTEGER(KIND=4) :: iStencil, iWeight, stencilSize, stencilStart, stencilEnd
185 
186  ! dU(:) = 0.0_8
187  stencilpointsoffset = 1
188  ! WRITE(*,*) 'NumDim: ',numDim
189  ! WRITE(*,*) 'dimSizes:',dimSizes
190  ! WRITE(*,*) 'numComponents:',numComponents
191  ! WRITE(*,*) 'numPointsBuffer:',numPointsBuffer
192  ! WRITE(*,*) 'opDir:',opDir
193  ! WRITE(*,*) 'numStencils:',numStencils
194  ! WRITE(*,*) 'stencilSizes:',stencilSizes
195  ! WRITE(*,*) 'stencilStarts:',stencilStarts
196  ! WRITE(*,*) 'numStencilValues:',numStencilValues
197  ! WRITE(*,*) 'stencilWeights:',stencilWeights
198  ! WRITE(*,*) 'stencilOffsets:',stencilOffsets
199  ! WRITE(*,*) 'numPointsStencil:',numPointsStencil
200  WRITE(*,*) 'numPointsApply:',numpointsapply
201  DO istencil = 1, numstencils
202  numpointsthisstencil = numpointsstencil(istencil)
203  stencilsize = stencilsizes(istencil)
204  stencilstart = stencilstarts(istencil)
205  stencilend = stencilstart+stencilsize-1
206  pointsstart = stencilpointsoffset
207  pointsend = pointsstart + numpointsthisstencil-1
208  CALL applysinglestencil(numdim,dimsizes,numcomponents,numpointsbuffer,opdir,numpointsthisstencil, &
209  stencilpoints(pointsstart:pointsend),stencilsize,stencilweights(stencilstart:stencilend),&
210  stenciloffsets(stencilstart:stencilend),u,du)
211  stencilpointsoffset = stencilpointsoffset+numpointsthisstencil
212  END DO
213 
214  END SUBROUTINE applyoperatorblobs
215 
216 
217 
238  SUBROUTINE applysinglestencil(numDim,dimSizes,numComponents,numPointsBuffer,opDir,numPointsApply, &
239  applyPoints,stencilSize,stencilWeights,stencilOffsets,U,dU)
240 
241  IMPLICIT NONE
242 
243  INTEGER(KIND=4), INTENT(IN) :: numDim, opDir, stencilSize, numComponents
244  INTEGER(KIND=8), INTENT(IN) :: dimSizes(numdim), numPointsBuffer, numPointsApply
245  INTEGER(KIND=8), INTENT(IN) :: applyPoints(numpointsapply)
246  INTEGER(KIND=4), INTENT(IN) :: stencilOffsets(stencilsize)
247  REAL(KIND=8), INTENT(IN) :: stencilWeights(stencilsize)
248  REAL(KIND=8), INTENT(IN) :: U(numpointsbuffer)
249  REAL(KIND=8), INTENT(OUT) :: dU(numpointsbuffer)
250 
251  INTEGER(KIND=8) :: I, iPoint, plane
252  INTEGER(KIND=4) :: iStencil, iWeight
253 
254  IF(opdir == 1) THEN
255  DO i = 1,numpointsapply
256  ipoint = applypoints(i)
257  du(ipoint) = 0.0_8
258  DO iweight = 1, stencilsize
259  du(ipoint) = du(ipoint) + stencilweights(iweight)*u(ipoint+stenciloffsets(iweight))
260  END DO
261  END DO
262  ELSE
263  IF(opdir == 2) THEN
264  plane = dimsizes(1)
265  ELSE IF(opdir == 3) THEN
266  plane = dimsizes(1)*dimsizes(2)
267  ENDIF
268  DO i = 1, numpointsapply
269  ipoint = applypoints(i)
270  du(ipoint) = 0.0_8
271  DO iweight = 1,stencilsize
272  du(ipoint) = du(ipoint) + stencilweights(iweight)*u(ipoint+stenciloffsets(iweight)*plane)
273  END DO
274  END DO
275  END IF
276 
277  END SUBROUTINE applysinglestencil
278 
279 END MODULE operators
subroutine applyoperator(numDim, dimSizes, numComponents, numPoints, opDir, opInterval, numStencils, stencilSizes, stencilStarts, numValues, stencilWeights, stencilOffsets, stencilID, U, dU)
applyoperator applies an operator specified as a stencil set to the provided state data ...
Definition: Operators.f90:36
subroutine applyoperatorblobs(numDim, dimSizes, numComponents, numPointsBuffer, opDir, numStencils, stencilSizes, stencilStarts, numStencilValues, stencilWeights, stencilOffsets, numPointsStencil, numPointsApply, stencilPoints, U, dU)
applyoperatorblobs applies an operator by applying each stencil in turn to all the points to which it...
Definition: Operators.f90:312
subroutine applysinglestencil(numDim, dimSizes, numComponents, numPointsBuffer, opDir, numPointsApply, applyPoints, stencilSize, stencilWeights, stencilOffsets, U, dU)
applysinglestencil applies an operator by applying a given stencil to the specified points ...
Definition: Operators.f90:382