OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
spmd_tri25egat.F
Go to the documentation of this file.
1Copyright> OpenRadioss
2Copyright> Copyright (C) 1986-2025 Altair Engineering Inc.
3Copyright>
4Copyright> This program is free software: you can redistribute it and/or modify
5Copyright> it under the terms of the GNU Affero General Public License as published by
6Copyright> the Free Software Foundation, either version 3 of the License, or
7Copyright> (at your option) any later version.
8Copyright>
9Copyright> This program is distributed in the hope that it will be useful,
10Copyright> but WITHOUT ANY WARRANTY; without even the implied warranty of
11Copyright> MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12Copyright> GNU Affero General Public License for more details.
13Copyright>
14Copyright> You should have received a copy of the GNU Affero General Public License
15Copyright> along with this program. If not, see <https://www.gnu.org/licenses/>.
16Copyright>
17Copyright>
18Copyright> Commercial Alternative: Altair Radioss Software
19Copyright>
20Copyright> As an alternative to this open-source version, Altair also offers Altair Radioss
21Copyright> software under a commercial license. Contact Altair to discuss further if the
22Copyright> commercial version may interest you: https://www.altair.com/radioss/.
23!||====================================================================
24!|| spmd_tri25egat ../engine/source/mpi/interfaces/spmd_tri25egat.f
25!||--- called by ------------------------------------------------------
26!|| i25main_tri ../engine/source/interfaces/intsort/i25main_tri.F
27!||--- uses -----------------------------------------------------
28!|| message_mod ../engine/share/message_module/message_mod.F
29!|| tri25ebox ../engine/share/modules/tri25ebox.F
30!|| tri7box ../engine/share/modules/tri7box.F
31!||====================================================================
32 SUBROUTINE spmd_tri25egat(
33 1 RESULT ,NIN , NEDGE ,CANDS_E2E ,I_STOK_E2E ,
34 2 CANDS_E2S ,I_STOK_E2S,IGAP ,INTFRIC ,ISTIF_MSDT )
35
36C-----------------------------------------------
37C M o d u l e s
38C-----------------------------------------------
39 USE tri25ebox
40 USE tri7box
41 USE message_mod
42C-----------------------------------------------
43C I m p l i c i t T y p e s
44C-----------------------------------------------
45#include "implicit_f.inc"
46C-----------------------------------------------
47C C o m m o n B l o c k s
48C-----------------------------------------------
49#include "com01_c.inc"
50#include "task_c.inc"
51#include "scr18_c.inc"
52#include "parit_c.inc"
53#include "spmd_c.inc"
54#include "sms_c.inc"
55#include "i25edge_c.inc"
56#include "assert.inc"
57C-----------------------------------------------
58C D u m m y A r g u m e n t s
59C-----------------------------------------------
60 INTEGER :: RESULT,NIN,NEDGE
61 INTEGER :: I_STOK_E2E,I_STOK_E2S
62 INTEGER :: CANDS_E2E(*),CANDS_E2S(*)
63 INTEGER :: IGAP , INTFRIC
64 INTEGER , INTENT(IN) :: ISTIF_MSDT
65C-----------------------------------------------
66C L o c a l V a r i a b l e s
67C-----------------------------------------------
68#ifdef MPI
69 INTEGER :: LOC_PROC,P
70 INTEGER, DIMENSION(:), ALLOCATABLE :: IAUX,INDEX
71 INTEGER :: N,NN,I,J,NNP
72 INTEGER :: N1,N2
73 INTEGER :: NEDGE_KEPT ! number of kept remote edges
74 INTEGER :: IDEB
75 INTEGER :: NODFI
76 INTEGER :: LSKYFI
77 INTEGER :: L2
78C-----------------------------------------------
79C S o u r c e L i n e s
80C-----------------------------------------------
81 loc_proc = ispmd + 1
82 lskyfi = 0
83 nodfi = 0
84C
85C Test succes du tri ?
86C
87
88
89 IF(result==0) THEN
90C
91C Reperage des candidats
92C
93 nedge_kept = 0
94 DO i = 1, i_stok_e2e
95 n = cands_e2e(i)
96 nn = n-nedge
97 IF(nn>0)THEN
98 IF(irem_edge(1,nn)>0)THEN
99 nedge_kept = nedge_kept + 1
100 irem_edge(1,nn) = -irem_edge(1,nn)
101 ENDIF
102 ENDIF
103 ENDDO
104
105 DO i = 1, i_stok_e2s
106 n = cands_e2s(i)
107 nn = n-nedge
108C WRITE(6,*) "CAND(",I,")=",N,NN
109 IF(nn>0)THEN
110 IF(irem_edge(1,nn)>0)THEN
111 nedge_kept = nedge_kept + 1
112 irem_edge(1,nn) = -irem_edge(1,nn)
113 ENDIF
114 ENDIF
115 ENDDO
116
117C
118C Allocation des tableaux de frontieres interfaces
119C
120 nodfi = nedge_kept * 2
121C IF(NEDGE_KEPT > ???) THEN
122C On pourrait eviter de faire des trous dans la memoire
123 IF(ASSOCIATED(nsvfie(nin)%P)) DEALLOCATE(nsvfie(nin)%P)
124C WRITE(6,*) __FILE__,"NSVFIE allocated size:",NEDGE_KEPT
125 ALLOCATE(nsvfie(nin)%P(nedge_kept))
126 IF(ASSOCIATED(xfie(nin)%P)) DEALLOCATE(xfie(nin)%P)
127 ALLOCATE(xfie(nin)%P(3,nodfi))
128 IF(ASSOCIATED(vfie(nin)%P)) DEALLOCATE(vfie(nin)%P)
129 ALLOCATE(vfie(nin)%P(3,nodfi))
130 IF(ASSOCIATED(msfie(nin)%P)) DEALLOCATE(msfie(nin)%P)
131 ALLOCATE(msfie(nin)%P(nodfi))
132 IF(ASSOCIATED(itafie(nin)%P)) DEALLOCATE(itafie(nin)%P)
133 ALLOCATE(itafie(nin)%P(nodfi))
134
135 IF(ASSOCIATED(gapfie(nin)%P)) DEALLOCATE(gapfie(nin)%P)
136 ALLOCATE(gapfie(nin)%P(nedge_kept))
137C IF(ASSOCIATED(MAIN_FIE(NIN)%P)) DEALLOCATE(MAIN_FIE(NIN)%P)
138C ALLOCATE(MAIN_FIE(NIN)%P(NEDGE_KEPT))
139 IF( igap == 3) THEN
140 IF(ASSOCIATED(gape_l_fie(nin)%P)) DEALLOCATE(gape_l_fie(nin)%P)
141 ALLOCATE(gape_l_fie(nin)%P(nedge_kept))
142 ENDIF
143 IF(ASSOCIATED(stifie(nin)%P)) DEALLOCATE(stifie(nin)%P)
144 ALLOCATE(stifie(nin)%P(nedge_kept))
145
146 IF(istif_msdt > 0) THEN
147 IF(ASSOCIATED(stife_msdt_fi(nin)%P))DEALLOCATE(stife_msdt_fi(nin)%P)
148 ALLOCATE(stife_msdt_fi(nin)%P(nodfi))
149 ENDIF
150
151 IF(ASSOCIATED(edg_bisector_fie(nin)%P)) DEALLOCATE(edg_bisector_fie(nin)%P)
152 ALLOCATE(edg_bisector_fie(nin)%P(3,3,nedge_kept))
153
154
155 IF(ASSOCIATED(vtx_bisector_fie(nin)%P)) DEALLOCATE(vtx_bisector_fie(nin)%P)
156 ALLOCATE(vtx_bisector_fie(nin)%P(3,4,nedge_kept))
157
158 IF(ASSOCIATED(ledge_fie(nin)%P)) DEALLOCATE(ledge_fie(nin)%P)
159 ALLOCATE(ledge_fie(nin)%P(e_ledge_size,nedge_kept))
160
161C Only for solids
162 IF(ASSOCIATED(x_seg_fie(nin)%P)) DEALLOCATE(x_seg_fie(nin)%P)
163 ALLOCATE(x_seg_fie(nin)%P(3,4,nedge_kept))
164
165
166 IF(idtmins == 2) THEN
167 IF(ASSOCIATED(nodnxfie(nin)%P)) DEALLOCATE(nodnxfie(nin)%P)
168 ALLOCATE(nodnxfie(nin)%P(nodfi))
169 IF(ASSOCIATED(nodamsfie(nin)%P)) DEALLOCATE(nodamsfie(nin)%P)
170 ALLOCATE(nodamsfie(nin)%P(nodfi))
171 IF(ASSOCIATED(procamsfie(nin)%P)) DEALLOCATE(procamsfie(nin)%P)
172 ALLOCATE(procamsfie(nin)%P(nodfi))
173 ELSEIF(idtmins_int /= 0) THEN
174 IF(ASSOCIATED(nodamsfie(nin)%P)) DEALLOCATE(nodamsfie(nin)%P)
175 ALLOCATE(nodamsfie(nin)%P(nodfi))
176 IF(ASSOCIATED(procamsfie(nin)%P)) DEALLOCATE(procamsfie(nin)%P)
177 ALLOCATE(procamsfie(nin)%P(nodfi))
178 ENDIF
179
180 IF(intfric > 0) THEN
181 IF(ASSOCIATED(ipartfric_fie(nin)%P)) DEALLOCATE(ipartfric_fie(nin)%P)
182 ALLOCATE(ipartfric_fie(nin)%P(nedge_kept))
183 ENDIF
184
185
186
187
188C ENDIF
189
190 ALLOCATE(index(nedge_remote))
191C
192C Compactage des candidats
193C
194 ideb = 0
195 nn = 0
196 DO p = 1, nspmd
197 nnp = nn
198! number of remote edges received from processor P in XREM
199 nedge_remote_old = nsnfie(nin)%P(p)
200C WRITE(6,*) ISPMD,"EDGE REMOTE TOTAL=",NEDGE_REMOTE_OLD
201 IF(nedge_remote_old/=0) THEN
202 DO i = 1, nedge_remote_old
203 IF(irem_edge(1,i+ideb)<0) THEN
204 irem_edge(1,i+ideb) = - irem_edge(1,i+ideb)
205! edge that are candidates
206 nn = nn + 1
207 index(i+ideb) = nn
208 assert(irem_edge(e_local_id,i+ideb) > 0)
209c WRITE(6,*) "KEEP",IREM_EDGE(E_LOCAL_ID,I+IDEB)
210 nsvfie(nin)%P(nn) = irem_edge(e_local_id,i+ideb)
211 ledge_fie(nin)%P(1:e_ledge_size,nn) = irem_edge(1:e_ledge_size ,i+ideb)
212
213C====================== AMS
214 IF(idtmins /= 0) THEN
215 n1 = 2*(nn-1)+1
216 n2 = 2*nn
217 IF(idtmins/=2 .AND. idtmins_int == 0) THEN
218
219 ELSEIF(idtmins==2) THEN
220 nodnxfie(nin)%P(n1) = irem_edge(e_nodnx1,i+ideb)
221 nodamsfie(nin)%P(n1) = irem_edge(e_nodams1,i+ideb)
222 procamsfie(nin)%P(n1) = p
223 nodnxfie(nin)%P(n2) = irem_edge(e_nodnx2,i+ideb)
224 nodamsfie(nin)%P(n2) = irem_edge(e_nodams2,i+ideb)
225 procamsfie(nin)%P(n2) = p
226
227 assert(nodnxfie(nin)%P(n1) >= 0)
228 assert(nodnxfie(nin)%P(n2) >= 0)
229C IF(NODNXFIE(NIN)%P(N1) < 0 .OR. NODNXFIE(NIN)%P(N2)<0 ) THEN
230C WRITE(6,"(A,X,4I10)") __FILE__,NN,I+IDEB, NODNXFIE(NIN)%P(N1), NODNXFIE(NIN)%P(N2)
231C ENDIF
232
233 ELSE ! idtmins_int == 0
234 nodamsfie(nin)%P(n1) = irem_edge(e_nodams1,i+ideb)
235 procamsfie(nin)%P(n1) = p
236 nodamsfie(nin)%P(n2) = irem_edge(e_nodams2,i+ideb)
237 procamsfie(nin)%P(n2) = p
238 ENDIF
239 ENDIF ! IDTMINS /= 0
240
241 IF(intfric > 0) THEN
242 ipartfric_fie(nin)%P(nn) = irem_edge(e_ipartfric_e,i+ideb)
243 ENDIF
244C=======================================================================
245
246 debug_e2e(ledge_fie(nin)%P(e_global_id,nn)==d_es,nn)
247
248 n1 = 2*(nn-1)+1
249 xfie(nin)%P(1,n1) = xrem_edge(e_x1,i+ideb)
250 xfie(nin)%P(2,n1) = xrem_edge(e_y1,i+ideb)
251 xfie(nin)%P(3,n1) = xrem_edge(e_z1,i+ideb)
252 vfie(nin)%P(1,n1) = xrem_edge(e_vx1,i+ideb)
253 vfie(nin)%P(2,n1) = xrem_edge(e_vy1,i+ideb)
254 vfie(nin)%P(3,n1) = xrem_edge(e_vz1,i+ideb)
255 msfie(nin)%P(n1) = xrem_edge(e_ms1,i+ideb)
256 itafie(nin)%P(n1) = irem_edge(e_node1_globid,i+ideb)
257 n2 = 2*nn
258 xfie(nin)%P(1,n2) = xrem_edge(e_x2,i+ideb)
259 xfie(nin)%P(2,n2) = xrem_edge(e_y2,i+ideb)
260 xfie(nin)%P(3,n2) = xrem_edge(e_z2,i+ideb)
261 vfie(nin)%P(1,n2) = xrem_edge(e_vx2,i+ideb)
262 vfie(nin)%P(2,n2) = xrem_edge(e_vy2,i+ideb)
263 vfie(nin)%P(3,n2) = xrem_edge(e_vz2,i+ideb)
264 msfie(nin)%P(n2) = xrem_edge(e_ms2,i+ideb)
265 itafie(nin)%P(n2) = irem_edge(e_node2_globid,i+ideb)
266
267 gapfie(nin)%p(nn) = xrem_edge(e_gap,i+ideb)
268
269 IF(igap == 3) THEN
270 gape_l_fie(nin)%P(nn) = xrem_edge(e_gapl,i+ideb)
271 ENDIF
272
273 stifie(nin)%p(nn) = xrem_edge(e_stife,i+ideb)
274
275 IF(istif_msdt > 0) THEN
276 stife_msdt_fi(nin)%P(nn) = xrem_edge(e_stife_msdt_fi,i+ideb)
277 ENDIF
278
279C MAIN_FIE(NIN)%P(NN) = XREM_EDGE(E_MAIN,I+IDEB)
280
281 l2 = e_edg_bis
282C Simple -> double -> simple = pb PON?
283 edg_bisector_fie(nin)%p(1:3,1,nn) = xrem_edge(l2:l2+2,i+ideb)
284 l2 = e_vtx_bis
285 vtx_bisector_fie(nin)%p(1:3,1,nn) = xrem_edge(l2:l2+2,i+ideb)
286 l2 = l2 + 3
287 vtx_bisector_fie(nin)%p(1:3,2,nn) = xrem_edge(l2:l2+2,i+ideb)
288 l2 = l2 + 3
289 vtx_bisector_fie(nin)%p(1:3,3,nn) = xrem_edge(l2:l2+2,i+ideb)
290 l2 = l2 + 3
291 vtx_bisector_fie(nin)%p(1:3,4,nn) = xrem_edge(l2:l2+2,i+ideb)
292 l2 = l2 + 3
293 edg_bisector_fie(nin)%p(1:3,2,nn) = xrem_edge(l2:l2+2,i+ideb)
294 l2 = l2 + 3
295 edg_bisector_fie(nin)%p(1:3,3,nn) = xrem_edge(l2:l2+2,i+ideb)
296
297
298
299 ENDIF ! Kept edge
300 ENDDO ! NEDGE_REMOTE_OLD
301 ideb = ideb + nedge_remote_old
302 ENDIF !IF(NEDGE_REMOTE_OLD/=0)
303 assert(nn - nnp >= 0)
304 nsnfie(nin)%P(p) = nn-nnp
305 ENDDO ! end do NSPMD
306 lskyfi = nn*multimax
307C nsnr nouveau utile pour inacti
308 nedge_remote = nn
309C WRITE(6,*) ISPMD,"EDGE REMOTE kept=",NEDGE_REMOTE
310
311 ENDIF
312 nedge_remote_old = nedge_remote
313
314C
315C Deallocation de XREM IREM
316C
317 IF(ALLOCATED(irem_edge)) DEALLOCATE(irem_edge)
318 IF(ALLOCATED(xrem_edge)) DEALLOCATE(xrem_edge)
319
320
321C
322C Allocation Parith/OFF
323C
324 IF(iparit==0) THEN
325 IF(ASSOCIATED(afie(nin)%P)) DEALLOCATE(afie(nin)%P)
326 IF(ASSOCIATED(stnfie(nin)%P)) DEALLOCATE(stnfie(nin)%P)
327 IF(nodfi>0)ALLOCATE(afie(nin)%P(3,nodfi*nthread))
328 IF(nodfi>0)ALLOCATE(stnfie(nin)%P(nodfi*nthread))
329C Init a 0
330 DO i = 1, nodfi*nthread
331 afie(nin)%P(1,i) = zero
332 afie(nin)%P(2,i) = zero
333 afie(nin)%P(3,i) = zero
334 stnfie(nin)%P(i) = zero
335 ENDDO
336C
337 IF(kdtint/=0)THEN
338 IF(ASSOCIATED(vscfie(nin)%P)) DEALLOCATE(vscfie(nin)%P)
339 IF(nodfi>0)ALLOCATE(vscfie(nin)%P(nodfi*nthread))
340C Init a 0
341 DO i = 1, nodfi*nthread
342 vscfie(nin)%P(i) = zero
343 ENDDO
344 ENDIF
345C
346 nlskyfie(nin) = nodfi
347C
348 ELSE
349C
350C Allocation Parith/ON Done in upgrade_rem_slv
351C
352 IF(ASSOCIATED(fskyfie(nin)%P)) DEALLOCATE(fskyfie(nin)%P)
353 IF(ASSOCIATED(iskyfie(nin)%P)) DEALLOCATE(iskyfie(nin)%P)
354 NULLIFY(fskyfie(nin)%P)
355 NULLIFY(iskyfie(nin)%P)
356 nlskyfie(nin) = lskyfi
357 IF(lskyfi>0) THEN
358 ALLOCATE(iskyfie(nin)%P(lskyfi))
359 iskyfie(nin)%P(1:lskyfi) = 0
360c IF(KDTINT==0) THEN
361c ALLOCATE(FSKYFIE(NIN)%P(8,LSKYFI))
362c ELSE
363 nfskyie = 8
364C WRITE(6,*) "ALLOCATE FSKYFIE",NFSKYIE,LSKYFI
365 ALLOCATE(fskyfie(nin)%P(nfskyie,lskyfi))
366 fskyfie(nin)%P(1:nfskyie,1:lskyfi) = 0
367c ENDIF
368 ENDIF
369
370 ENDIF
371
372C
373C Renumerotation des candidats
374C
375 DO i = 1, i_stok_e2e
376 n = cands_e2e(i)
377 nn = n-nedge
378 IF(nn>0)THEN
379 cands_e2e(i) = index(nn)+nedge
380 ENDIF
381 ENDDO
382C
383C Renumerotation des candidats
384C
385 DO i = 1, i_stok_e2s
386 n = cands_e2s(i)
387 nn = n-nedge
388 IF(nn>0)THEN
389 cands_e2s(i) = index(nn)+nedge
390 ENDIF
391 ENDDO
392
393
394 DEALLOCATE(index)
395C
396#endif
397 RETURN
398 END
399
message_mod
Definition message_mod.F:1249
tri25ebox::gape_l_fie
type(real_pointer), dimension(:), allocatable gape_l_fie
Definition tri25ebox.F:86
tri25ebox::nfskyie
integer nfskyie
Definition tri25ebox.F:81
tri25ebox::nedge_remote
integer nedge_remote
Definition tri25ebox.F:73
tri25ebox::nedge_remote_old
integer nedge_remote_old
Definition tri25ebox.F:96
tri25ebox::edg_bisector_fie
type(real4_pointer3), dimension(:), allocatable edg_bisector_fie
Definition tri25ebox.F:83
tri25ebox::vtx_bisector_fie
type(real4_pointer3), dimension(:), allocatable vtx_bisector_fie
Definition tri25ebox.F:84
tri25ebox::x_seg_fie
type(real_pointer3), dimension(:), allocatable x_seg_fie
Definition tri25ebox.F:85
tri25ebox::irem_edge
integer, dimension(:,:), allocatable irem_edge
Definition tri25ebox.F:64
tri25ebox::ledge_fie
type(int_pointer2), dimension(:), allocatable ledge_fie
Definition tri25ebox.F:88
tri7box::gapfie
type(real_pointer), dimension(:), allocatable gapfie
Definition tri7box.F:449
tri7box::vfie
type(real_pointer2), dimension(:), allocatable vfie
Definition tri7box.F:459
tri7box::fskyfie
type(real_pointer2), dimension(:), allocatable fskyfie
Definition tri7box.F:459
tri7box::ipartfric_fie
type(int_pointer), dimension(:), allocatable ipartfric_fie
Definition tri7box.F:440
tri7box::xfie
type(real_pointer2), dimension(:), allocatable xfie
Definition tri7box.F:459
tri7box::iskyfie
type(int_pointer), dimension(:), allocatable iskyfie
Definition tri7box.F:480
tri7box::nsnfie
type(int_pointer), dimension(:), allocatable nsnfie
Definition tri7box.F:440
tri7box::stifie
type(real_pointer), dimension(:), allocatable stifie
Definition tri7box.F:449
tri7box::stnfie
type(real_pointer), dimension(:), allocatable stnfie
Definition tri7box.F:449
tri7box::procamsfie
type(int_pointer), dimension(:), allocatable procamsfie
Definition tri7box.F:440
tri7box::nodnxfie
type(int_pointer), dimension(:), allocatable nodnxfie
Definition tri7box.F:440
tri7box::afie
type(real_pointer2), dimension(:), allocatable afie
Definition tri7box.F:459
tri7box::nsvfie
type(int_pointer), dimension(:), allocatable nsvfie
Definition tri7box.F:440
tri7box::nodamsfie
type(int_pointer), dimension(:), allocatable nodamsfie
Definition tri7box.F:440
tri7box::vscfie
type(real_pointer), dimension(:), allocatable vscfie
Definition tri7box.F:449
tri7box::itafie
type(int_pointer), dimension(:), allocatable itafie
Definition tri7box.F:440
tri7box::nlskyfie
integer, dimension(:), allocatable nlskyfie
Definition tri7box.F:512
tri7box::stife_msdt_fi
type(real_pointer), dimension(:), allocatable stife_msdt_fi
Definition tri7box.F:553
tri7box::msfie
type(real_pointer), dimension(:), allocatable msfie
Definition tri7box.F:449
spmd_tri25egat
subroutine spmd_tri25egat(result, nin, nedge, cands_e2e, i_stok_e2e, cands_e2s, i_stok_e2s, igap, intfric, istif_msdt)
Definition spmd_tri25egat.F:35