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 . ratio, 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 INTEGER :: IE,N1,N2
81 my_real :: dx,dy,dz
82 INTEGER :: IDS(4)
83 INTEGER :: TMP
84C-----------------------------------------------
85C S o u r c e L i n e s
86C-----------------------------------------------
87C
88C=======================================================================
89C tag des boites contenant des facettes
90C et creation des candidats
91C=======================================================================
92
93 sol_edge =iedge/10 ! solids
94 sh_edge =iedge-10*sol_edge ! shells
95
96 loc_proc = ispmd + 1
97
98 nbx = lrvoxel25
99 nby = lrvoxel25
100 nbz = lrvoxel25
101
102 xmaxb = bminmal(1)
103 ymaxb = bminmal(2)
104 zmaxb = bminmal(3)
105 xminb = bminmal(4)
106 yminb = bminmal(5)
107 zminb = bminmal(6)
108
109 DO ne=1,nrtm
110C on ne retient pas les facettes detruites
111 IF(stf(ne) <= zero)cycle
112 aaa = marge+curv_max(ne)+vmaxdt
113 + + max(max(pmax_gap,bgapsmx+gap_m(ne))+dgapload,drad)
114
115
116C verifier avec
117 IF(sol_edge > 0) aaa = max(aaa,marge+bgapemx+dgapload)
118
119c il est possible d'ameliorer l'algo en decoupant la facette
120c en 2(4,3,6,9...) si la facette est grande devant AAA et inclinee
121
122 m1 = irect(1,ne)
123 m2 = irect(2,ne)
124 m3 = irect(3,ne)
125 m4 = irect(4,ne)
126
127 xx1=x(1,m1)
128 xx2=x(1,m2)
129 xx3=x(1,m3)
130 xx4=x(1,m4)
131 xmaxe=max(xx1,xx2,xx3,xx4)
132 xmine=min(xx1,xx2,xx3,xx4)
133
134 yy1=x(2,m1)
135 yy2=x(2,m2)
136 yy3=x(2,m3)
137 yy4=x(2,m4)
138 ymaxe=max(yy1,yy2,yy3,yy4)
139 ymine=min(yy1,yy2,yy3,yy4)
140
141 zz1=x(3,m1)
142 zz2=x(3,m2)
143 zz3=x(3,m3)
144 zz4=x(3,m4)
145 zmaxe=max(zz1,zz2,zz3,zz4)
146 zmine=min(zz1,zz2,zz3,zz4)
147
148 IF(sol_edge > 0 ) THEN
149 dx=em02*(xmaxe-xmine)
150 dy=em02*(ymaxe-ymine)
151 dz=em02*(zmaxe-zmine)
152 xmaxe=xmaxe+dx
153 xmine=xmine-dx
154 ymaxe=ymaxe+dy
155 ymine=ymine-dy
156 zmaxe=zmaxe+dz
157 zmine=zmine-dz
158 ENDIF
159
160c indice des voxels occupes par la facette
161
162 ix1=int(nbx*(xmine-aaa-xminb)/(xmaxb-xminb))
163 iy1=int(nby*(ymine-aaa-yminb)/(ymaxb-yminb))
164 iz1=int(nbz*(zmine-aaa-zminb)/(zmaxb-zminb))
165
166 ix1=max(0,min(nbx,ix1))
167 iy1=max(0,min(nby,iy1))
168 iz1=max(0,min(nbz,iz1))
169
170 ix2=int(nbx*(xmaxe+aaa-xminb)/(xmaxb-xminb))
171 iy2=int(nby*(ymaxe+aaa-yminb)/(ymaxb-yminb))
172 iz2=int(nbz*(zmaxe+aaa-zminb)/(zmaxb-zminb))
173
174 ix2=max(0,min(nbx,ix2))
175 iy2=max(0,min(nby,iy2))
176 iz2=max(0,min(nbz,iz2))
177
178 DO iz = iz1, iz2
179 DO iy = iy1, iy2
180 tmp = 0
181 DO ix = ix1, ix2
182 tmp=ibset(tmp,ix)
183 END DO
184!$OMP ATOMIC
185 crvoxel25(iy,iz,1,loc_proc)=ior(crvoxel25(iy,iz,1,loc_proc),tmp)
186 END DO
187 END DO
188 ENDDO
189
190C
191 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:70
tri25ebox::lrvoxel25
integer, parameter lrvoxel25
Definition tri25ebox.F:69

◆ 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 201 of file spmd_tri25vox0.F.

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