OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
i23main_tri.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!|| i23main_tri ../engine/source/interfaces/intsort/i23main_tri.F
25!||--- called by ------------------------------------------------------
26!|| inttri ../engine/source/interfaces/intsort/inttri.F
27!||--- calls -----------------------------------------------------
28!|| ancmsg ../engine/source/output/message/message.f
29!|| arret ../engine/source/system/arret.F
30!|| check_sorting_criteria ../engine/source/interfaces/intsort/check_sorting_criteria.F90
31!|| i23buce ../engine/source/interfaces/intsort/i23buce.F
32!|| i23trc ../engine/source/interfaces/intsort/i23trc.F
33!|| i7xsave ../engine/source/interfaces/intsort/i7xsave.f
34!|| imp_rnumcd ../engine/source/implicit/imp_int_k.F
35!|| my_barrier ../engine/source/system/machine.F
36!|| spmd_rnumcd ../engine/source/mpi/interfaces/spmd_i7tool.F
37!|| spmd_tri23vox0 ../engine/source/mpi/interfaces/spmd_int.F
38!|| spmd_tri7gat ../engine/source/mpi/interfaces/spmd_int.F
39!|| spmd_tri7vox ../engine/source/mpi/interfaces/spmd_int.F
40!|| startime ../engine/source/system/timer_mod.F90
41!|| stoptime ../engine/source/system/timer_mod.f90
42!|| upgrade_multimp ../common_source/interf/upgrade_multimp.F
43!||--- uses -----------------------------------------------------
44!|| check_sorting_criteria_mod ../engine/source/interfaces/intsort/check_sorting_criteria.F90
45!|| h3d_mod ../engine/share/modules/h3d_mod.F
46!|| intbufdef_mod ../common_source/modules/interfaces/intbufdef_mod.F90
47!|| message_mod ../engine/share/message_module/message_mod.F
48!|| multi_fvm_mod ../common_source/modules/ale/multi_fvm_mod.F90
49!|| timer_mod ../engine/source/system/timer_mod.F90
50!|| tri7box ../engine/share/modules/tri7box.F
51!||====================================================================
52 SUBROUTINE i23main_tri(TIMERS,
53 1 IPARI ,X ,INTBUF_TAB,V ,
54 2 MS ,NIN ,ITASK ,MWAG ,WEIGHT ,
55 3 ISENDTO ,IRCVFROM,RETRI ,IAD_ELEM,FR_ELEM ,
56 4 ITAB ,KINET ,NRTM_T ,RENUM ,
57 5 NSNFIOLD,ESHIFT ,NUM_IMP ,IND_IMP ,NODNX_SMS,
58 6 H3D_DATA, MULTI_FVM,INTHEAT,IDT_THERM,NODADT_THERM)
59C-----------------------------------------------
60C M o d u l e s
61C-----------------------------------------------
62 USE timer_mod
63 USE tri7box
64 USE message_mod
65 USE intbufdef_mod
66 USE h3d_mod
67 USE multi_fvm_mod
68 use check_sorting_criteria_mod , only : check_sorting_criteria
69C-----------------------------------------------
70C I m p l i c i t T y p e s
71C-----------------------------------------------
72#include "implicit_f.inc"
73#include "comlock.inc"
74C-----------------------------------------------
75C C o m m o n B l o c k s
76C-----------------------------------------------
77#include "com01_c.inc"
78#include "com04_c.inc"
79#include "com08_c.inc"
80#include "param_c.inc"
81#include "task_c.inc"
82#include "timeri_c.inc"
83C common pour variable globale en memoire partagee
84 COMMON /i7mainc/bminma,curv_max_max,result,nsnr,nsnrold,i_memg,nmn_g
85 INTEGER RESULT,NSNR,NSNROLD,I_MEMG,NMN_G
86 my_real
87 . BMINMA(6),CURV_MAX_MAX
88C-----------------------------------------------
89C D u m m y A r g u m e n t s
90C-----------------------------------------------
91 TYPE(timer_), INTENT(INOUT) :: TIMERS
92 INTEGER NIN ,ITASK, RETRI, NRTM_T,ESHIFT,
93 . NUM_IMP ,IND_IMP(*),
94 . ITAB(*), KINET(*),
95 . IPARI(NPARI,NINTER), MWAG(*),
96 . ISENDTO(NINTER+1,*),IRCVFROM(NINTER+1,*),
97 . weight(*), iad_elem(2,*) ,fr_elem(*),
98 . renum(*), nsnfiold(nspmd), nodnx_sms(*)
99 INTEGER, INTENT(IN) :: INTHEAT
100 INTEGER, INTENT(IN) :: IDT_THERM
101 INTEGER, INTENT(IN) :: NODADT_THERM
102C REAL
103 my_real
104 . X(*), V(*), MS(*)
105 TYPE(intbuf_struct_) INTBUF_TAB
106 TYPE(h3d_database) :: H3D_DATA
107 TYPE(multi_fvm_struct), INTENT(INOUT) :: MULTI_FVM
108C-----------------------------------------------
109C L o c a l V a r i a b l e s
110C-----------------------------------------------
111 INTEGER LOC_PROC, IFQ, INTTH, ITIED,
112 . i, ip0, ip1, ip2, ip21, i_sk_old,
113 . add1, nb_n_b, noint, inacti, multimp, igap, i_stok ,nmn_l
114 INTEGER
115 . ILD, NCONTACT,NCONT,INTFRIC,
116 . I_MEM,CAND_N_OLD,IDUM1(1),ILEV, IVIS2
117C REAL
118 my_real
119 . gap,maxbox,minbox,tzinf,
120 . xmaxl, ymaxl, zmaxl, xminl, yminl, zminl, gapmin, gapmax,
121 . sx,sy,sz,sx2,sy2,sz2,
122 . c_maxl,curv_max(nrtm_t),rdum1(1)
123 INTEGER :: NMN,NSN,NTY
124 logical :: need_computation
125C-----------------------------------------------
126 ! --------------
127 ! check if the current interface needs to be sorted
128 call check_sorting_criteria( need_computation,nin,npari,nspmd,
129 . itask,ipari(1,nin),tt,intbuf_tab )
130 if( .not.need_computation ) return
131 ! --------------
132 i_mem = 0
133 i_memg = 0
134 nmn_g = 0
135 nmn_l = 0
136! INTFRIC is a local variable (local to each thread in OMP //)
137 intfric = 0
138C
139C Specific TYPE7 :
140 itied = 0
141C
142 loc_proc=ispmd+1
143 nsn =ipari(5,nin)
144 nmn =ipari(6,nin)
145 nty =ipari(7,nin)
146 ivis2 =ipari(14,nin)
147 noint =ipari(15,nin)
148 ncont =ipari(18,nin)
149 ilev =ipari(20,nin)
150 inacti =ipari(22,nin)
151 multimp=ipari(23,nin)
152
153 ncontact=multimp*ncont
154C
155 nsnrold = ipari(24,nin)
156C
157 gap =intbuf_tab%VARIABLES(2)
158 gapmin=intbuf_tab%VARIABLES(13)
159 gapmax=intbuf_tab%VARIABLES(16)
160C
161C
162C -------------------------------------------------------------
163C
164 retri = 1
165C
166C -------------------------------------------------------------
167C
168 maxbox = intbuf_tab%VARIABLES(9)
169 minbox = intbuf_tab%VARIABLES(12)
170 tzinf = intbuf_tab%VARIABLES(8)
171 bminma(1)=-ep30
172 bminma(2)=-ep30
173 bminma(3)=-ep30
174 bminma(4)=ep30
175 bminma(5)=ep30
176 bminma(6)=ep30
177 curv_max_max = zero
178C
179C -------------------------------------------------------------
180C STOCKAGE DES ANCIENS CANDIDATS
181C -------------------------------------------------------------
182C
183C Barriere dans tous les cas pour bminma [et cur_max_max]
184C
185 CALL my_barrier
186C
187 IF(itask==0)THEN
188 ip0 = 1
189 ip1 = ip0 + nsn + nsnrold + 3
190C MWA = MWAG SUR TASK 0
191 i_sk_old = intbuf_tab%I_STOK(1)
192 CALL i23trc(
193 1 nsn+nsnrold ,i_sk_old ,intbuf_tab%CAND_N,intbuf_tab%CAND_E,
194 2 intbuf_tab%CAND_P,intbuf_tab%FTSAVX,intbuf_tab%FTSAVY,intbuf_tab%FTSAVZ,
195 3 mwag(ip0) ,intbuf_tab%IFPEN)
196C
197 intbuf_tab%I_STOK(1)=i_sk_old
198 ENDIF
199C -------------------------------------------------------------
200C CALCUL BORNE DOMAINE REMONTE DANS I7XSAVE
201C -------------------------------------------------------------
202C eshift : decalage sur cand_e
203 CALL i7xsave(
204 1 x ,intbuf_tab%NSV,intbuf_tab%MSR,nsn ,nmn ,
205 2 itask ,intbuf_tab%XSAV,xminl ,yminl ,zminl ,
206 3 xmaxl ,ymaxl ,zmaxl ,c_maxl,curv_max,
207 4 ipari(39,nin),intbuf_tab%IRECTM(1+4*eshift) ,nrtm_t,sx ,sy ,
208 5 sz ,sx2 ,sy2 ,sz2 ,nmn_l)
209#include "lockon.inc"
210 bminma(1) = max(bminma(1),xmaxl)
211 bminma(2) = max(bminma(2),ymaxl)
212 bminma(3) = max(bminma(3),zmaxl)
213 bminma(4) = min(bminma(4),xminl)
214 bminma(5) = min(bminma(5),yminl)
215 bminma(6) = min(bminma(6),zminl)
216 curv_max_max = max(curv_max_max,c_maxl)
217 nmn_g = nmn_g + nmn_l
218#include "lockoff.inc"
219
220 result = 0
221C BARRIER II_STOK et RESULT
222 CALL my_barrier
223 IF(itask==0)THEN
224 IF(abs(bminma(6)-bminma(3))>2*ep30.OR.
225 + abs(bminma(5)-bminma(2))>2*ep30.OR.
226 + abs(bminma(4)-bminma(1))>2*ep30)THEN
227 CALL ancmsg(msgid=87,anmode=aninfo,
228 . i1=noint,c1='(I23BUCE)')
229 CALL arret(2)
230 END IF
231C
232 bminma(1)=bminma(1)+tzinf+curv_max_max
233 bminma(2)=bminma(2)+tzinf+curv_max_max
234 bminma(3)=bminma(3)+tzinf+curv_max_max
235 bminma(4)=bminma(4)-tzinf-curv_max_max
236 bminma(5)=bminma(5)-tzinf-curv_max_max
237 bminma(6)=bminma(6)-tzinf-curv_max_max
238
239 IF(nspmd > lrvoxelp)THEN
240 CALL ancmsg(msgid=36,anmode=aninfo,
241 . c1='(I7MAINTRI)')
242 CALL arret(2)
243 END IF
244
245 nsnr = 0
246
247 END IF
248
249
250 IF(nspmd > 1) THEN
251
252 IF(itask==0) crvoxel(0:lrvoxel,0:lrvoxel,loc_proc)=0
253c goto 150
254 CALL my_barrier
255
256 IF (imonm > 0 .AND. itask == 0) CALL startime(timers,26)
257 CALL spmd_tri23vox0(
258 1 x ,bminma ,ipari(21,nin),nrtm_t,intbuf_tab%STFM(1+eshift),
259 2 tzinf ,curv_max,gapmin ,gapmax,intbuf_tab%GAP_M(1+eshift),
260 3 intbuf_tab%IRECTM(1+4*eshift),gap ,intbuf_tab%VARIABLES(7) ,intbuf_tab%MSR)
261
262 CALL my_barrier
263 IF (imonm > 0 .AND. itask == 0) CALL stoptime(timers,26)
264c 150 continue
265 IF(itask==0)THEN
266C
267C recuperation des noeuds remote NSNR stockes dans XREM
268C
269 ifq =0
270 intth=0
271 IF (imonm > 0 .AND. itask == 0) CALL startime(timers,25)
272
273 CALL spmd_tri7vox(
274 1 intbuf_tab%NSV,nsn ,x ,v ,ms ,
275 2 bminma ,weight ,intbuf_tab%STFNS,nin ,isendto,
276 3 ircvfrom ,iad_elem,fr_elem ,nsnr ,ipari(21,nin),
277 4 intbuf_tab%GAP_S,itab ,kinet ,ifq ,inacti ,
278 5 nsnfiold,intth,idum1,rdum1,rdum1 ,
279 6 num_imp ,nodnx_sms,rdum1,nty ,idum1 ,
280 7 rdum1 ,rdum1,rdum1,rdum1 ,idum1 ,ilev,idum1,
281 8 intfric ,idum1 ,itied, ivis2, intbuf_tab%IF_ADH)
282 IF (imonm > 0 .AND. itask == 0) CALL stoptime(timers,25)
283
284c 300 continue
285C
286C renumerotation locale des anciens candidats
287C
288 CALL spmd_rnumcd(
289 1 intbuf_tab%CAND_N,renum ,intbuf_tab%I_STOK(1), nin, nsn,
290 2 nsnfiold ,nsnrold)
291 END IF
292 END IF
293C
294 cand_n_old = intbuf_tab%I_STOK(1)
295 40 CONTINUE
296
297 ild = 0
298 nb_n_b = 1
299C
300C Barrier comm spmd_tri7box + BMINMA + Retour I7BUCE
301C
302 50 CALL my_barrier
303
304 IF (imonm > 0 .AND. itask == 0) CALL startime(timers,30)
305 CALL i23buce(
306 1 x ,intbuf_tab%IRECTM(1+4*eshift),intbuf_tab%NSV ,ipari(22,nin),
307 2 nrtm_t ,nsn ,intbuf_tab%CAND_E ,intbuf_tab%CAND_N,gap ,
308 3 noint ,intbuf_tab%I_STOK(1),tzinf ,maxbox ,minbox ,
309 4 ncontact ,nb_n_b ,eshift ,intbuf_tab%CAND_P,ncont ,
310 6 ild ,weight ,intbuf_tab%STFNS,nin ,
311 7 intbuf_tab%STFM(1+eshift) ,ipari(21,nin),intbuf_tab%GAP_S,gapmin,gapmax,
312 8 ipari(39,nin),num_imp ,itask,
313 9 i_mem ,intbuf_tab%MSR,intbuf_tab%GAP_M(1+eshift),nsnr ,curv_max ,
314 a renum ,nsnrold ,intbuf_tab%IFPEN,mwag ,bminma ,
315 b nmn ,intbuf_tab%IRECTM,intbuf_tab%VARIABLES(7),
316 c intheat,idt_therm,nodadt_therm )
317
318C Upgrade MultiMP
319 IF (i_mem == 2)THEN
320#include "lockon.inc"
321 i_memg = i_mem
322#include "lockoff.inc"
323 ENDIF
324
325C New barrier needed for Dynamic MultiMP
326 CALL my_barrier
327
328 IF(i_memg /=0)THEN
329C CARE : JINBUF & JBUFIN array are reallocated in
330C UPGRADE_MULTIMP routine !!!!
331
332
333
334!$omp single
335 multimp = ipari(23,nin) + 4
336 CALL upgrade_multimp(nin,multimp,intbuf_tab)
337!$OMP END SINGLE
338 i_mem = 0
339 i_memg = 0
340 intbuf_tab%I_STOK(1)=cand_n_old
341 multimp=ipari(23,nin)
342 ncontact=multimp*ncont
343C eshift : decalage sur cand_e
344 GOTO 40
345 ENDIF
346
347C
348 IF (imonm > 0 .AND. itask == 0) CALL stoptime(timers,30)
349C
350#include "lockon.inc"
351 intbuf_tab%VARIABLES(9) = min(maxbox,intbuf_tab%VARIABLES(9))
352 intbuf_tab%VARIABLES(12) = min(minbox,intbuf_tab%VARIABLES(12))
353 intbuf_tab%VARIABLES(8) = min(tzinf,intbuf_tab%VARIABLES(8))
354 intbuf_tab%VARIABLES(5) = intbuf_tab%VARIABLES(8)-sqrt(three)*gap
355 result = result + ild
356#include "lockoff.inc"
357C--------------------------------------------------------------
358C--------------------------------------------------------------
359 CALL my_barrier
360 IF (result/=0) THEN
361 CALL my_barrier
362 IF (itask==0) THEN
363C utile si on revient
364 intbuf_tab%I_STOK(1) = i_sk_old
365 result = 0
366 ENDIF
367 CALL my_barrier
368 ild = 0
369 maxbox = intbuf_tab%VARIABLES(9)
370 minbox = intbuf_tab%VARIABLES(12)
371 tzinf = intbuf_tab%VARIABLES(8)
372 GOTO 50
373 ENDIF
374C mise a - de dist temporairement pour reperage dans partie frontiere
375 IF(nspmd>1)THEN
376C mono tache
377!$OMP SINGLE
378 IF (imonm > 0) CALL startime(timers,26)
379 intbuf_tab%VARIABLES(5) = -intbuf_tab%VARIABLES(5)
380C
381 CALL spmd_tri7gat(
382 1 result ,nsn ,intbuf_tab%CAND_N,intbuf_tab%I_STOK(1),nin,
383 2 ipari(21,nin),nsnr,multimp ,nty,ipari(47,nin),
384 3 ilev ,nsnfiold, ipari, h3d_data,intfric,
385 4 multi_fvm,nodadt_therm)
386 ipari(24,nin) = nsnr
387C
388 IF (num_imp>0)
389 . CALL imp_rnumcd(intbuf_tab%CAND_N,nin,nsn,num_imp,ind_imp )
390C
391 IF (imonm > 0) CALL stoptime(timers,26)
392!$OMP END SINGLE
393 END IF
394C
395 RETURN
396 END
i23buce
subroutine i23buce(x, irect, nsv, inacti, nrtm, nsn, cand_e, cand_n, gap, noint, ii_stok, tzinf, maxbox, minbox, ncontact, nb_n_b, eshift, cand_p, ncont, ild, weight, stfn, nin, stf, igap, gap_s, gapmin, gapmax, icurv, num_imp, itask, i_mem, msr, gap_m, nsnr, curv_max, renum, nsnrold, ifpen, mwag, bminma, nmn, irectg, bgapsmx, intheat, idt_therm, nodadt_therm)
Definition i23buce.F:46
i23main_tri
subroutine i23main_tri(timers, ipari, x, intbuf_tab, v, ms, nin, itask, mwag, weight, isendto, ircvfrom, retri, iad_elem, fr_elem, itab, kinet, nrtm_t, renum, nsnfiold, eshift, num_imp, ind_imp, nodnx_sms, h3d_data, multi_fvm, intheat, idt_therm, nodadt_therm)
Definition i23main_tri.F:59
i23trc
subroutine i23trc(nsn, i_stok, cand_n, cand_e, cand_p, cand_fx, cand_fy, cand_fz, cand_a, ifpen)
Definition i23trc.F:31
i7xsave
subroutine i7xsave(x, nsv, msr, nsn, nmn, itask, xsav, xmin, ymin, zmin, xmax, ymax, zmax, c_max, curv_max, icurv, irect, nrtm_t, sx, sy, sz, sx2, sy2, sz2, nmn_l)
Definition i7xsave.F:40
imp_rnumcd
subroutine imp_rnumcd(cand_n, nin, nsn, num_imp, index)
Definition imp_int_k.F:1542
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21
h3d_mod
Definition h3d_mod.F:308
message_mod
Definition message_mod.F:1249
tri7box::crvoxel
integer, dimension(0:lrvoxel, 0:lrvoxel) crvoxel
Definition tri7box.F:56
tri7box::lrvoxelp
integer lrvoxelp
Definition tri7box.F:522
tri7box::lrvoxel
integer lrvoxel
Definition tri7box.F:54
spmd_rnumcd
subroutine spmd_rnumcd(cand_n, renum, ii_stok, nin, nsn, nsnfiold, nsnrold)
Definition spmd_i7tool.F:162
spmd_tri7gat
subroutine spmd_tri7gat(result, nsn, cand_n, i_stok, nin, igap, nsnr, multimp, ity, intth, ilev, nsnfiold, ipari, h3d_data, intfric, multi_fvm, nodadt_therm)
Definition spmd_int.F:3002
spmd_tri7vox
subroutine spmd_tri7vox(nsv, nsn, x, v, ms, bminmal, weight, stifn, nin, isendto, ircvfrom, iad_elem, fr_elem, nsnr, igap, gap_s, itab, kinet, ifq, inacti, nsnfiold, intth, ielec, areas, temp, num_imp, nodnx_sms, gap_s_l, ityp, irtlm, i24_time_s, i24_frfi, i24_pene_old, i24_stif_old, nbinflg, ilev, i24_icont_i, intfric, ipartfrics, itied, ivis2, if_adh)
Definition spmd_int.F:220
spmd_tri23vox0
subroutine spmd_tri23vox0(x, bminmal, igap, nrtm, stf, tzinf, curv_max, gapmin, gapmax, gap_m, irect, gap, bgapsmx, msr)
Definition spmd_int.F:5391
ancmsg
subroutine ancmsg(msgid, msgtype, anmode, i1, i2, i3, i4, i5, i6, i7, i8, i9, i10, i11, i12, i13, i14, i15, i16, i17, i18, i19, i20, r1, r2, r3, r4, r5, r6, r7, r8, r9, c1, c2, c3, c4, c5, c6, c7, c8, c9, prmode)
Definition message.F:889
arret
subroutine arret(nn)
Definition arret.F:87
my_barrier
subroutine my_barrier
Definition machine.F:31
startime
subroutine startime(event, itask)
Definition timer.F:93
stoptime
subroutine stoptime(event, itask)
Definition timer.F:135
h3d_mod::h3d_database
Definition h3d_mod.F:435
upgrade_multimp
subroutine upgrade_multimp(ni, multimp_parameter, intbuf_tab)
Definition upgrade_multimp.F:48