OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
i10main_tri.F File Reference
#include "implicit_f.inc"
#include "comlock.inc"
#include "com01_c.inc"
#include "com04_c.inc"
#include "com08_c.inc"
#include "timeri_c.inc"
#include "lockon.inc"
#include "lockoff.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine i10main_tri (timers, npari, ipari, x, v, ms, nin, itask, mwag, weight, isendto, ircvfrom, retri, iad_elem, fr_elem, nrtm_t, renum, nsnfiold, eshift, num_imp, ind_imp, nodnx_sms, itab, intbuf_tab, h3d_data, glob_therm)

Function/Subroutine Documentation

◆ i10main_tri()

subroutine i10main_tri ( type(timer_), intent(inout) timers,
integer, intent(in) npari,
integer, dimension(npari) ipari,
x,
v,
ms,
integer nin,
integer itask,
integer, dimension(*) mwag,
integer, dimension(*) weight,
integer, dimension(ninter+1,*) isendto,
integer, dimension(ninter+1,*) ircvfrom,
integer retri,
integer, dimension(2,*) iad_elem,
integer, dimension(*) fr_elem,
integer nrtm_t,
integer, dimension(numnod) renum,
integer, dimension(nspmd) nsnfiold,
integer eshift,
integer num_imp,
integer, dimension(*) ind_imp,
integer, dimension(*) nodnx_sms,
integer, dimension(*) itab,
type(intbuf_struct_) intbuf_tab,
type(h3d_database) h3d_data,
type(glob_therm_), intent(in) glob_therm )
Parameters
[in]nparidimension of ipari

Definition at line 52 of file i10main_tri.F.

59C============================================================================
60C-----------------------------------------------
61C M o d u l e s
62C-----------------------------------------------
63 USE timer_mod
64 USE message_mod
65 USE intbufdef_mod
66 USE h3d_mod
67 use check_sorting_criteria_mod , only : check_sorting_criteria
68 use glob_therm_mod
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 "timeri_c.inc"
81 COMMON /i10mainc/bminma,result,nsnr,nsnrold,i_memg
82 INTEGER RESULT,NSNR,NSNROLD,I_MEMG
83 my_real
84 . bminma(6)
85C-----------------------------------------------
86C D u m m y A r g u m e n t s
87C-----------------------------------------------
88 TYPE(TIMER_), intent(inout) :: TIMERS
89 integer, intent(in) :: npari !< dimension of ipari
90 INTEGER ITASK, NIN, RETRI, NRTM_T, ESHIFT,
91 . NUM_IMP ,IND_IMP(*),
92 . IPARI(npari), MWAG(*), ITAB(*),
93 . ISENDTO(NINTER+1,*),IRCVFROM(NINTER+1,*),
94 . WEIGHT(*), IAD_ELEM(2,*) ,FR_ELEM(*),
95 . RENUM(NUMNOD), NSNFIOLD(NSPMD), NODNX_SMS(*)
96 my_real
97 . x(*), v(3,*), ms(*)
98
99 TYPE(INTBUF_STRUCT_) INTBUF_TAB
100 TYPE(H3D_DATABASE) :: H3D_DATA
101 TYPE(glob_therm_),INTENT(IN) :: GLOB_THERM
102C-----------------------------------------------
103C L o c a l V a r i a b l e s
104C-----------------------------------------------
105 INTEGER NB_N_B,
106 . I, K11_T, IP0, IP1, IP2, IP3, JLT , NFT, J17_T,
107 . I_SK_OLD, I_STOK1, ITIED,
108 . ADD1, ILD, NOINT, MULTIMP, ITYP, NCONT, NCONTACT,
109 . IBID,I_MEM,CAND_N_OLD
110C REAL
111 my_real
112 . gap, maxbox, minbox, tzinf,dist1,
113 . xmaxl, ymaxl, zmaxl, xminl, yminl, zminl, gapmin, gapmax
114 INTEGER :: NMN, NSN,NRTM,NTY
115 logical :: need_computation
116C-----------------------------------------------
117
118 ! --------------
119 ! check if the current interface needs to be sorted
120 call check_sorting_criteria( need_computation,nin,npari,nspmd,
121 . itask,ipari,tt,intbuf_tab )
122 if( .not.need_computation ) return
123 ! --------------
124
125 i_mem = 0
126 i_memg = 0
127
128 nrtm =ipari(4)
129 nsn =ipari(5)
130 nmn =ipari(6)
131 nty =ipari(7)
132 noint =ipari(15)
133 multimp=ipari(23)
134 ncont =ipari(18)
135 itied = ipari(85)
136 ncontact=multimp*ncont
137 nsnrold = ipari(24)
138
139 gap =intbuf_tab%VARIABLES(2)
140 gapmin=intbuf_tab%VARIABLES(13)
141 gapmax=intbuf_tab%VARIABLES(16)
142C
143C -------------------------------------------------------------
144C
145 retri=1
146C -------------------------------------------------------------
147C
148 maxbox = intbuf_tab%VARIABLES(9)
149 minbox = intbuf_tab%VARIABLES(12)
150 tzinf = intbuf_tab%VARIABLES(8)
151 bminma(1)=-ep30
152 bminma(2)=-ep30
153 bminma(3)=-ep30
154 bminma(4)=ep30
155 bminma(5)=ep30
156 bminma(6)=ep30
157C -------------------------------------------------------------
158C TRI SUR N DES ANCIENS CANDIDATS
159C -------------------------------------------------------------
160C
161 CALL my_barrier
162 IF(itask==0)THEN
163 ip0 = 1
164 ip1 = ip0 + nsn + nsnrold + 3
165 i_sk_old = intbuf_tab%I_STOK(1)
166 CALL i10trc(
167 1 nsn+nsnrold ,i_sk_old ,intbuf_tab%CAND_N,intbuf_tab%CAND_E,
168 2 intbuf_tab%CAND_F,mwag(ip0),num_imp ,ind_imp )
169 intbuf_tab%I_STOK(1)=i_sk_old
170 ENDIF
171C -------------------------------------------------------------
172C CALCUL BORNE DOMAINE REMONTE DANS I7XSAVE
173C -------------------------------------------------------------
174C sauvegarde de XSAV (tableau BUFIN(JD(19)))
175 CALL i10xsave(
176 1 x ,intbuf_tab%NSV,intbuf_tab%MSR,nsn ,nmn ,
177 2 itask ,intbuf_tab%XSAV,xminl ,yminl ,zminl ,
178 3 xmaxl ,ymaxl ,zmaxl )
179#include "lockon.inc"
180 bminma(1) = max(bminma(1),xmaxl)
181 bminma(2) = max(bminma(2),ymaxl)
182 bminma(3) = max(bminma(3),zmaxl)
183 bminma(4) = min(bminma(4),xminl)
184 bminma(5) = min(bminma(5),yminl)
185 bminma(6) = min(bminma(6),zminl)
186#include "lockoff.inc"
187 result = 0
188C BARRIER II_STOK et RESULT
189 CALL my_barrier
190C -------------------------------------------------------------
191 IF(itask==0)THEN
192 IF(abs(bminma(6)-bminma(3))>2*ep30.OR.
193 + abs(bminma(5)-bminma(2))>2*ep30.OR.
194 + abs(bminma(4)-bminma(1))>2*ep30)THEN
195 CALL ancmsg(msgid=87,anmode=aninfo,
196 . i1=noint)
197 CALL arret(2)
198 END IF
199C
200 bminma(1)=bminma(1)+tzinf
201 bminma(2)=bminma(2)+tzinf
202 bminma(3)=bminma(3)+tzinf
203 bminma(4)=bminma(4)-tzinf
204 bminma(5)=bminma(5)-tzinf
205 bminma(6)=bminma(6)-tzinf
206C
207C recuperation des noeuds remote NSNR stockes dans XREM
208C
209 nsnr = 0
210 IF(nspmd>1) THEN
211 CALL spmd_tri10box(
212 1 intbuf_tab%NSV,nsn ,x ,v ,ms ,
213 2 bminma ,weight ,intbuf_tab%STFNS,nin ,isendto ,
214 3 ircvfrom ,iad_elem,fr_elem ,nsnr ,ipari(21),
215 4 intbuf_tab%GAP_S,nsnfiold,nodnx_sms ,itab ,itied)
216C
217C renumerotation locale des anciens candidats
218C
219
220 CALL spmd_rnumcd10(
221 1 intbuf_tab%CAND_N,renum ,intbuf_tab%I_STOK(1), nin, nsn,
222 2 nsnfiold ,nsnrold)
223 END IF
224 END IF
225C
226 cand_n_old = intbuf_tab%I_STOK(1)
227 40 CONTINUE
228C eshift : decalage sur cand_e
229 ild = 0
230 nb_n_b = 1
231C
232C Barrier comm spmd_tri10box + BMINMA + Retour I10BUCE
233C
234 50 CALL my_barrier
235C
236 IF (imonm > 0) CALL startime(timers,30)
237C
238 IF(nrtm_t/=0)
239 . CALL i10buce(
240 1 x ,intbuf_tab%IRECTM(1+4*eshift),intbuf_tab%NSV,nmn ,nrtm_t ,
241 2 nsn ,ncont ,intbuf_tab%CAND_E,intbuf_tab%CAND_N,gap ,
242 3 noint ,intbuf_tab%I_STOK(1),tzinf ,maxbox ,minbox ,
243 4 nb_n_b ,eshift ,bminma ,mwag ,ild ,
244 7 ncontact ,nsnrold ,intbuf_tab%STFNS,nin ,ipari(21) ,
245 8 intbuf_tab%GAP_S,nsnr ,renum ,intbuf_tab%STFM(1+eshift),intbuf_tab%GAP_M,
246 9 gapmin ,gapmax ,i_mem,glob_therm%INTHEAT, glob_therm%IDT_THERM, glob_therm%NODADT_THERM)
247C
248C Upgrade MultiMP
249 IF (i_mem == 2)THEN
250#include "lockon.inc"
251 i_memg = i_mem
252#include "lockoff.inc"
253 ENDIF
254
255C New barrier needed for Dynamic MultiMP
256 CALL my_barrier
257
258 IF(i_memg /=0)THEN
259C CARE : JINBUF & JBUFIN array are reallocated in
260C UPGRADE_MULTIMP routine !!!!
261!$OMP SINGLE
262 multimp = ipari(23) + 4
263 CALL upgrade_multimp(nin,multimp,intbuf_tab)
264!$OMP END SINGLE
265 i_mem = 0
266 i_memg = 0
267 intbuf_tab%I_STOK(1)=cand_n_old
268 multimp=ipari(23)
269 ncontact=multimp*ncont
270 GOTO 40
271 ENDIF
272 IF (imonm > 0) CALL stoptime(timers,30)
273C
274#include "lockon.inc"
275 intbuf_tab%VARIABLES(9) = min(maxbox,intbuf_tab%VARIABLES(9))
276 intbuf_tab%VARIABLES(12)= min(minbox,intbuf_tab%VARIABLES(12))
277 intbuf_tab%VARIABLES(8) = min(tzinf,intbuf_tab%VARIABLES(8))
278C TZINF mis a jour a ce niveau
279 intbuf_tab%VARIABLES(5) = intbuf_tab%VARIABLES(8)-gap
280 result = result + ild
281#include "lockoff.inc"
282C--------------------------------------------------------------
283C--------------------------------------------------------------
284 CALL my_barrier
285 IF (result/=0) THEN
286 CALL my_barrier
287 IF (itask==0) THEN
288 intbuf_tab%I_STOK(1) = i_sk_old
289 result = 0
290 ENDIF
291 CALL my_barrier
292 ild = 0
293 maxbox = intbuf_tab%VARIABLES(9)
294 minbox = intbuf_tab%VARIABLES(12)
295 tzinf = intbuf_tab%VARIABLES(8)
296 GOTO 50
297 ENDIF
298C mise a - de dist temporairement pour reperage dans partie frontiere
299 IF(nspmd>1)THEN
300
301C mono tache
302!$OMP SINGLE
303
304 IF (imonm > 0) CALL startime(timers,26)
305
306 intbuf_tab%VARIABLES(5) = -intbuf_tab%VARIABLES(5)
307 ibid = 0
308c CALL SPMD_TRI10GAT(
309c 1 RESULT ,NSN ,INBUF(KD(15)),INBUF(KD(1)),NIN,
310c 2 IPARI(21),NSNR,MULTIMP ,NTY,IBID)
311 CALL spmd_tri10gat(
312 1 result ,nsn ,intbuf_tab%CAND_N,intbuf_tab%I_STOK(1),nin,
313 2 ipari(21),nsnr,multimp ,nty,ibid,h3d_data)
314C sauvegarde des candidats additionnels dans IPARI(24)
315 ipari(24) = nsnr
316 IF (num_imp>0)
317 . CALL imp_rnumcd(intbuf_tab%CAND_N,nin,nsn,num_imp,ind_imp )
318
319 IF (imonm > 0) CALL stoptime(timers,26)
320
321!$OMP END SINGLE
322
323 ENDIF
324C
325 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
i10buce
subroutine i10buce(x, irect, nsv, nmn, nrtm, nsn, ncont, cand_e, cand_n, gap, noint, ii_stok, tzinf, maxbox, minbox, nb_n_b, eshift, bminma, mwag, ild, ncontact, nsnrold, stfn, nin, igap, gap_s, nsnr, renum, stf, gap_m, gapmin, gapmax, i_mem, intheat, idt_therm, nodadt_therm)
Definition i10buce.F:42
i10trc
subroutine i10trc(nsn, i_stok, cand_n, cand_e, cand_f, cand_a, num_imp, ind_imp)
Definition i10trc.F:31
i10xsave
subroutine i10xsave(x, nsv, msr, nsn, nmn, itask, xsav, xmin, ymin, zmin, xmax, ymax, zmax)
Definition i10xsave.F:34
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
spmd_rnumcd10
subroutine spmd_rnumcd10(cand_n, renum, ii_stok, nin, nsn, nsnfiold, nsnrold)
Definition spmd_i7tool.F:239
spmd_tri10gat
subroutine spmd_tri10gat(result, nsn, cand_n, i_stok, nin, igap, nsnr, multimp, ity, intth, h3d_data)
Definition spmd_int.F:3929
spmd_tri10box
subroutine spmd_tri10box(nsv, nsn, x, v, ms, bminmal, weight, stifn, nin, isendto, ircvfrom, iad_elem, fr_elem, nsnr, igap, gap_s, nsnfiold, nodnx_sms, itab, itied)
Definition spmd_int.F:3552
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
upgrade_multimp
subroutine upgrade_multimp(ni, multimp_parameter, intbuf_tab)
Definition upgrade_multimp.F:48