OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
spmd_tri25vox0.F File Reference
#include "implicit_f.inc"
#include "comlock.inc"
#include "task_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine spmd_tri25vox0 (x, bminmal, nrtm, stf, marge, curv_max, gap_m, irect, gap, bgapsmx, pmax_gap, vmaxdt, bgapemx, iedge, ledge, nedge, nledge, gape, drad, dgapload)
subroutine spmd_tri25vox0_edge (x, bminmal, nrtm, stfe, marge, curv_max, gap_m, irect, gap, bgapsmx, pmax_gap, vmaxdt, bgapemx, iedge, igap0, ledge, nedge, nledge, gape, dgapload)

Function/Subroutine Documentation

◆ spmd_tri25vox0()

subroutine spmd_tri25vox0 ( x,
bminmal,
integer, intent(in) nrtm,
stf,
marge,
curv_max,
gap_m,
integer, dimension(4,nrtm) irect,
gap,
bgapsmx,
pmax_gap,
vmaxdt,
bgapemx,
integer, intent(in) iedge,
integer, dimension(nledge,nedge), intent(in) ledge,
integer, intent(in) nedge,
integer, intent(in) nledge,
gape,
drad,
intent(in) dgapload )

Definition at line 31 of file spmd_tri25vox0.F.

37C-----------------------------------------------
38C M o d u l e s
39C-----------------------------------------------
40 USE tri25ebox
41 USE tri7box
42C-----------------------------------------------
43C I m p l i c i t T y p e s
44C-----------------------------------------------
45#include "implicit_f.inc"
46#include "comlock.inc"
47C-----------------------------------------------
48C C o m m o n B l o c k s
49C-----------------------------------------------
50#include "task_c.inc"
51C-----------------------------------------------
52C D u m m y A r g u m e n t s
53C-----------------------------------------------
54 INTEGER, INTENT(IN) :: NRTM
55 INTEGER, INTENT(IN) :: NLEDGE
56 INTEGER, INTENT(IN) :: NEDGE
57 INTEGER, INTENT(IN) :: IEDGE
58 INTEGER, INTENT(IN) :: LEDGE(NLEDGE,NEDGE)
59 INTEGER IRECT(4,NRTM)
60 my_real
61 . x(3,*), bminmal(*),
62 . stf(*), gap_m(*), bgapsmx,pmax_gap,vmaxdt,
63 . marge,gap,curv_max(nrtm),
64 . bgapemx,drad
65 my_real gape(*)
66 my_real , INTENT(IN) :: dgapload
67C-----------------------------------------------
68C L o c a l V a r i a b l e s
69C-----------------------------------------------
70 INTEGER LOC_PROC,
71 . NBX,NBY,NBZ,NE,M1,M2,M3,M4,
72 . IX1,IY1,IZ1,IX2,IY2,IZ2,IX,IY,IZ
73 my_real
74 . aaa,
75 . xmaxb,ymaxb,zmaxb,xminb,yminb,zminb,
76 . xmine,ymine,zmine,xmaxe,ymaxe,zmaxe,
77 . xx1,xx2,xx3,xx4,yy1,yy2,yy3,yy4,zz1,zz2,zz3,zz4
78
79 INTEGER :: SOL_EDGE,SH_EDGE
80 my_real :: dx,dy,dz
81 INTEGER :: TMP
82C-----------------------------------------------
83C S o u r c e L i n e s
84C-----------------------------------------------
85C
86C=======================================================================
87C tag of boxes containing facets
88C and creation of candidates
89C=======================================================================
90
91 sol_edge =iedge/10 ! solids
92 sh_edge =iedge-10*sol_edge ! shells
93
94 loc_proc = ispmd + 1
95
96 nbx = lrvoxel25
97 nby = lrvoxel25
98 nbz = lrvoxel25
99
100 xmaxb = bminmal(1)
101 ymaxb = bminmal(2)
102 zmaxb = bminmal(3)
103 xminb = bminmal(4)
104 yminb = bminmal(5)
105 zminb = bminmal(6)
106
107 DO ne=1,nrtm
108C We do not retain the Destruit facets
109 IF(stf(ne) <= zero)cycle
110 aaa = marge+curv_max(ne)+vmaxdt
111 + + max(max(pmax_gap,bgapsmx+gap_m(ne))+dgapload,drad)
112
113
114C verify with
115 IF(sol_edge > 0) aaa = max(aaa,marge+bgapemx+dgapload)
116
117c It is possible to improve the algo by cutting the facet
118c in 2 (4,3,6,9 ...) if the facet is large in front of AAA and inclinee
119
120 m1 = irect(1,ne)
121 m2 = irect(2,ne)
122 m3 = irect(3,ne)
123 m4 = irect(4,ne)
124
125 xx1=x(1,m1)
126 xx2=x(1,m2)
127 xx3=x(1,m3)
128 xx4=x(1,m4)
129 xmaxe=max(xx1,xx2,xx3,xx4)
130 xmine=min(xx1,xx2,xx3,xx4)
131
132 yy1=x(2,m1)
133 yy2=x(2,m2)
134 yy3=x(2,m3)
135 yy4=x(2,m4)
136 ymaxe=max(yy1,yy2,yy3,yy4)
137 ymine=min(yy1,yy2,yy3,yy4)
138
139 zz1=x(3,m1)
140 zz2=x(3,m2)
141 zz3=x(3,m3)
142 zz4=x(3,m4)
143 zmaxe=max(zz1,zz2,zz3,zz4)
144 zmine=min(zz1,zz2,zz3,zz4)
145
146 IF(sol_edge > 0 ) THEN
147 dx=em02*(xmaxe-xmine)
148 dy=em02*(ymaxe-ymine)
149 dz=em02*(zmaxe-zmine)
150 xmaxe=xmaxe+dx
151 xmine=xmine-dx
152 ymaxe=ymaxe+dy
153 ymine=ymine-dy
154 zmaxe=zmaxe+dz
155 zmine=zmine-dz
156 ENDIF
157
158c index of voxels occupied by the facet
159
160 ix1=int(nbx*(xmine-aaa-xminb)/(xmaxb-xminb))
161 iy1=int(nby*(ymine-aaa-yminb)/(ymaxb-yminb))
162 iz1=int(nbz*(zmine-aaa-zminb)/(zmaxb-zminb))
163
164 ix1=max(0,min(nbx,ix1))
165 iy1=max(0,min(nby,iy1))
166 iz1=max(0,min(nbz,iz1))
167
168 ix2=int(nbx*(xmaxe+aaa-xminb)/(xmaxb-xminb))
169 iy2=int(nby*(ymaxe+aaa-yminb)/(ymaxb-yminb))
170 iz2=int(nbz*(zmaxe+aaa-zminb)/(zmaxb-zminb))
171
172 ix2=max(0,min(nbx,ix2))
173 iy2=max(0,min(nby,iy2))
174 iz2=max(0,min(nbz,iz2))
175
176 DO iz = iz1, iz2
177 DO iy = iy1, iy2
178 tmp = 0
179 DO ix = ix1, ix2
180 tmp=ibset(tmp,ix)
181 END DO
182!$OMP ATOMIC
183 crvoxel25(iy,iz,1,loc_proc)=ior(crvoxel25(iy,iz,1,loc_proc),tmp)
184 END DO
185 END DO
186 ENDDO
187
188C
189 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21
tri25ebox::crvoxel25
integer, dimension(:,:,:,:), allocatable crvoxel25
Definition tri25ebox.F:72
tri25ebox::lrvoxel25
integer, parameter lrvoxel25
Definition tri25ebox.F:71

◆ spmd_tri25vox0_edge()

subroutine spmd_tri25vox0_edge ( x,
bminmal,
integer, intent(in) nrtm,
stfe,
marge,
curv_max,
gap_m,
integer, dimension(4,nrtm) irect,
gap,
bgapsmx,
pmax_gap,
vmaxdt,
bgapemx,
integer, intent(in) iedge,
integer, intent(in) igap0,
integer, dimension(nledge,nedge), intent(in) ledge,
integer, intent(in) nedge,
integer, intent(in) nledge,
gape,
intent(in) dgapload )

Definition at line 199 of file spmd_tri25vox0.F.

205C-----------------------------------------------
206C M o d u l e s
207C-----------------------------------------------
208 USE tri25ebox
209 USE tri7box
210C-----------------------------------------------
211C I m p l i c i t T y p e s
212C-----------------------------------------------
213#include "implicit_f.inc"
214#include "comlock.inc"
215C-----------------------------------------------
216C C o m m o n B l o c k s
217C-----------------------------------------------
218#include "task_c.inc"
219C-----------------------------------------------
220C D u m m y A r g u m e n t s
221C-----------------------------------------------
222 INTEGER, INTENT(IN) :: NRTM
223 INTEGER, INTENT(IN) :: NLEDGE
224 INTEGER, INTENT(IN) :: NEDGE
225 INTEGER, INTENT(IN) :: IEDGE, IGAP0
226 INTEGER, INTENT(IN) :: LEDGE(NLEDGE,NEDGE)
227 INTEGER IRECT(4,NRTM)
228 my_real
229 . x(3,*), bminmal(*),
230 . stfe(nedge), gap_m(*), bgapsmx,pmax_gap,vmaxdt,
231 . marge,gap,curv_max(nrtm),
232 . bgapemx
233 my_real gape(*)
234 my_real , INTENT(IN) :: dgapload
235C-----------------------------------------------
236C L o c a l V a r i a b l e s
237C-----------------------------------------------
238 INTEGER LOC_PROC,
239 . NBX,NBY,NBZ,M1,
240 . IX1,IY1,IZ1,IX2,IY2,IZ2,IX,IY,IZ
241 my_real
242 . aaa,
243 . xmaxb,ymaxb,zmaxb,xminb,yminb,zminb,
244 . xmine,ymine,zmine,xmaxe,ymaxe,zmaxe,
245 . xx1,xx2,yy1,yy2,zz1,zz2
246
247 INTEGER :: SOL_EDGE,SH_EDGE
248 INTEGER :: IE,N1,N2
249 INTEGER :: TMP
250
251C-----------------------------------------------
252C S o u r c e L i n e s
253C-----------------------------------------------
254C
255C=======================================================================
256C tag of boxes containing facets
257C and creation of candidates
258C=======================================================================
259
260 sol_edge =iedge/10 ! solids
261 sh_edge =iedge-10*sol_edge ! shells
262
263 loc_proc = ispmd + 1
264
265 nbx = lrvoxel25
266 nby = lrvoxel25
267 nbz = lrvoxel25
268
269 xmaxb = bminmal(1)
270 ymaxb = bminmal(2)
271 zmaxb = bminmal(3)
272 xminb = bminmal(4)
273 yminb = bminmal(5)
274 zminb = bminmal(6)
275
276!$OMP DO
277 DO ie = 1, nedge
278C check with :
279 IF(stfe(ie) <= zero ) cycle
280 IF(ledge(9,ie) == 0) cycle ! not main of secnd edge
281
282 m1 = ledge(1,ie)
283c IF(M1 > 0) THEN
284c IF(STF(M1) == ZERO) CYCLE
285c ENDIF
286
287C BGAPEMX already counted in BMINMAL
288 aaa=zero + dgapload
289C IF(IGAP0==0)THEN
290C AAA = MARGE+BGAPEMX+GAPE(IE)
291C ELSE
292C AAA = MARGE+TWO*BGAPEMX+GAPE(IE)
293C END IF
294
295 n1 = ledge(5,ie)
296 n2 = ledge(6,ie)
297
298 xx1=x(1,n1)
299 xx2=x(1,n2)
300 yy1=x(2,n1)
301 yy2=x(2,n2)
302 zz1=x(3,n1)
303 zz2=x(3,n2)
304 xmaxe=max(xx1,xx2)+gape(ie) ! +TZINF
305 xmine=min(xx1,xx2)-gape(ie) ! -TZINF
306 ymaxe=max(yy1,yy2)+gape(ie) ! +TZINF
307 ymine=min(yy1,yy2)-gape(ie) ! -TZINF
308 zmaxe=max(zz1,zz2)+gape(ie) ! +TZINF
309 zmine=min(zz1,zz2)-gape(ie) ! -TZINF
310 !-------------------------------------------!
311 ! VOXEL OCCUPIED BY THE EDGE !
312 !-------------------------------------------!
313 !Voxel_lower_left_bound for this element---+
314
315 ix1=int(nbx*(xmine-aaa-xminb)/(xmaxb-xminb))
316 iy1=int(nby*(ymine-aaa-yminb)/(ymaxb-yminb))
317 iz1=int(nbz*(zmine-aaa-zminb)/(zmaxb-zminb))
318
319 ix1=max(0,min(nbx,ix1))
320 iy1=max(0,min(nby,iy1))
321 iz1=max(0,min(nbz,iz1))
322
323 ix2=int(nbx*(xmaxe+aaa-xminb)/(xmaxb-xminb))
324 iy2=int(nby*(ymaxe+aaa-yminb)/(ymaxb-yminb))
325 iz2=int(nbz*(zmaxe+aaa-zminb)/(zmaxb-zminb))
326
327 ix2=max(0,min(nbx,ix2))
328 iy2=max(0,min(nby,iy2))
329 iz2=max(0,min(nbz,iz2))
330
331 DO iz = iz1, iz2
332 DO iy = iy1, iy2
333 tmp = 0
334 DO ix = ix1, ix2
335 tmp=ibset(tmp,ix)
336 END DO
337!$OMP ATOMIC
338 crvoxel25(iy,iz,1,loc_proc)=ior(crvoxel25(iy,iz,1,loc_proc),tmp)
339 END DO
340 END DO
341 END DO
342!$OMP END DO
343 RETURN