OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
i24main.F File Reference
#include "implicit_f.inc"
#include "comlock.inc"
#include "mvsiz_p.inc"
#include "com01_c.inc"
#include "com04_c.inc"
#include "com08_c.inc"
#include "param_c.inc"
#include "warn_c.inc"
#include "task_c.inc"
#include "parit_c.inc"
#include "timeri_c.inc"
#include "impl1_c.inc"
#include "macro.inc"
#include "lockon.inc"
#include "lockoff.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine i24mainf (timers, ipari, intbuf_tab, x, a, icodt, fsav, v, ms, dt2t, neltst, ityptst, itab, stifn, fskyi, isky, fcont, nin, lindmax, kinet, jtask, nb_jlt, nb_jlt_new, nb_stok_n, niskyfi, newfront, nstrf, secfcum, icontact, viscn, num_imp, ns_imp, ne_imp, ind_imp, fsavsub, nrtmdim, fsavbag, eminx, ixs, ixs16, ixs20, fncont, ftcont, iad_elem, fr_elem, rcontact, acontact, pcontact, temp, fthe, ftheskyi, pm, iparg, iad17, mskyi_sms, iskyi_sms, nodnx_sms, ms0, inod_pxfem, ms_ply, wagap, fbsav6, isensint, dimfb, h3d_data, intbuf_fric_tab, t2main_sms, forneqs, t2fac_sms, npc, tf, tagncont, kloadpinter, loadpinter, loadp_hyd_inter, dgaploadint, s_loadpinter, interefric, interfaces, nisubmax)
subroutine impl_sav (jlt, cand_n, cand_e, irtlm, stif, pene, subtria, ns_imp, ne_imp, ind_imp, num_imp, jlt_new, nsv, subtria_old, mseglo, nsn, nin, nrtm)
subroutine impl_sav0 (jlt, cand_n, subtria_old, irtlm, nsn, nin)
subroutine i24cdcor3 (jlt, index, cand_e, cand_n, cand_t, cand_e_n, cand_n_n, cand_t_n, iedge)
subroutine impl_sav1 (jlt, cand_n, cand_e, irtlm, stif, pene, subtria, ns_imp, ne_imp, ind_imp, ii_stok, n1, n2, n3, h1, h2, h3, h4, nj_imp, hj_imp, stif_imp, nin, nsn)

Function/Subroutine Documentation

◆ i24cdcor3()

subroutine i24cdcor3 ( integer jlt,
integer, dimension(*) index,
integer, dimension(*) cand_e,
integer, dimension(*) cand_n,
integer, dimension(*) cand_t,
integer, dimension(*) cand_e_n,
integer, dimension(*) cand_n_n,
integer, dimension(*) cand_t_n,
integer iedge )

Definition at line 759 of file i24main.F.

761C============================================================================
762C-----------------------------------------------
763C D u m m y A r g u m e n t s
764C-----------------------------------------------
765 INTEGER JLT, IEDGE,
766 . INDEX(*), CAND_E(*), CAND_N(*), CAND_T(*),
767 . CAND_E_N(*), CAND_N_N(*), CAND_T_N(*)
768C-----------------------------------------------
769C L o c a l V a r i a b l e s
770C-----------------------------------------------
771 INTEGER I
772C-----------------------------------------------
773C
774 DO i=1,jlt
775 cand_e_n(i) = cand_e(index(i))
776 cand_n_n(i) = cand_n(index(i))
777 ENDDO
778
779 IF(iedge/=0)THEN
780 DO i=1,jlt
781 cand_t_n(i) = cand_t(index(i))
782 ENDDO
783 ENDIF
784C
785 RETURN

◆ i24mainf()

subroutine i24mainf ( type(timer_) timers,
integer, dimension(npari,ninter) ipari,
type(intbuf_struct_) intbuf_tab,
x,
a,
integer, dimension(*) icodt,
fsav,
v,
ms,
dt2t,
integer neltst,
integer ityptst,
integer, dimension(*) itab,
stifn,
fskyi,
integer, dimension(*) isky,
fcont,
integer nin,
integer lindmax,
integer, dimension(*) kinet,
integer jtask,
integer nb_jlt,
integer nb_jlt_new,
integer nb_stok_n,
integer niskyfi,
integer newfront,
integer, dimension(*) nstrf,
secfcum,
integer, dimension(*) icontact,
viscn,
integer num_imp,
integer, dimension(*) ns_imp,
integer, dimension(*) ne_imp,
integer, dimension(*) ind_imp,
fsavsub,
integer nrtmdim,
fsavbag,
eminx,
integer, dimension(*) ixs,
integer, dimension(*) ixs16,
integer, dimension(*) ixs20,
fncont,
ftcont,
integer, dimension(2,*) iad_elem,
integer, dimension(*) fr_elem,
rcontact,
acontact,
pcontact,
temp,
fthe,
ftheskyi,
pm,
integer, dimension(nparg,*) iparg,
integer iad17,
mskyi_sms,
integer, dimension(*) iskyi_sms,
integer, dimension(*) nodnx_sms,
ms0,
integer, dimension(*) inod_pxfem,
ms_ply,
wagap,
double precision, dimension(12,6,dimfb) fbsav6,
integer, dimension(nisubmax+1) isensint,
integer dimfb,
type(h3d_database) h3d_data,
type(intbuf_fric_struct_), dimension(ninterfric), target intbuf_fric_tab,
integer, dimension(6,*) t2main_sms,
forneqs,
t2fac_sms,
integer, dimension(*) npc,
tf,
integer, dimension(nloadp_hyd_inter,numnod) tagncont,
integer, dimension(ninter+1), intent(in) kloadpinter,
integer, dimension(s_loadpinter), intent(in) loadpinter,
integer, dimension(nloadp_hyd), intent(in) loadp_hyd_inter,
dimension(s_loadpinter), intent(in) dgaploadint,
integer, intent(in) s_loadpinter,
integer, intent(in) interefric,
type (interfaces_), intent(in) interfaces,
integer nisubmax )

Definition at line 56 of file i24main.F.

77C========================================================================
78C-----------------------------------------------
79C M o d u l e s
80C-----------------------------------------------
81 USE timer_mod
82 USE intbufdef_mod
83 USE imp_intbuf
84 USE h3d_mod
85 USE intbuf_fric_mod
86 USE message_mod
87 USE outputs_mod
88 USE interfaces_mod
89C-----------------------------------------------
90C I m p l i c i t T y p e s
91C-----------------------------------------------
92#include "implicit_f.inc"
93#include "comlock.inc"
94C-----------------------------------------------
95C G l o b a l P a r a m e t e r s
96C-----------------------------------------------
97#include "mvsiz_p.inc"
98C-----------------------------------------------
99C C o m m o n B l o c k s
100C-----------------------------------------------
101#include "com01_c.inc"
102#include "com04_c.inc"
103#include "com08_c.inc"
104#include "param_c.inc"
105#include "warn_c.inc"
106#include "task_c.inc"
107#include "parit_c.inc"
108#include "timeri_c.inc"
109#include "impl1_c.inc"
110#include "macro.inc"
111C-----------------------------------------------
112C D u m m y A r g u m e n t s
113C-----------------------------------------------
114 TYPE(TIMER_) :: TIMERS
115 INTEGER NISUBMAX ! Max number of SUB INTerfaces
116 INTEGER NELTST,ITYPTST,NIN,NEWFRONT,
117 . NSTRF(*),
118 . NRTMDIM, IAD17, IPARSENS
119 INTEGER IPARI(NPARI,NINTER), ICODT(*),ICONTACT(*),
120 . ITAB(*), ISKY(*), KINET(*),
121 . IPARG(NPARG,*),INOD_PXFEM(*),NPC(*),TAGNCONT(NLOADP_HYD_INTER,NUMNOD)
122 INTEGER , INTENT(IN) :: S_LOADPINTER
123 INTEGER , INTENT(IN) :: KLOADPINTER(NINTER+1),LOADPINTER(S_LOADPINTER),
124 . LOADP_HYD_INTER(NLOADP_HYD)
125 INTEGER NB_JLT,NB_JLT_NEW,NB_STOK_N,JTASK,
126 . NISKYFI, LINDMAX
127 INTEGER NUM_IMP,NS_IMP(*),NE_IMP(*),IND_IMP(*)
128 INTEGER IXS(*) ,IXS16(*) ,IXS20(*)
129 INTEGER IAD_ELEM(2,*),FR_ELEM(*),
130 . ISKYI_SMS(*), NODNX_SMS(*), ISENSINT(NISUBMAX+1),DIMFB,T2MAIN_SMS(6,*)
131 INTEGER , INTENT(IN) :: INTEREFRIC
132 my_real , INTENT(IN) :: dgaploadint(s_loadpinter)
133 my_real
134 . eminx(*)
135C REAL
136 my_real dt2t,
137 . x(*), a(3,*), fsav(*), v(3,*),fsavbag(*),
138 . ms(*),stifn(*),fskyi(lskyi,4),fcont(3,*),ms0(*),
139 . secfcum(7,numnod,nsect),viscn(*), fsavsub(*),
140 . fncont(3,*), ftcont(3,*), rcontact(*), acontact(*),
141 . pcontact(*),tf(*),
142 . temp(*),fthe(*),ftheskyi(lskyi),pm(npropm,*),
143 . mskyi_sms(*),ms_ply(*),wagap(*),forneqs(3,*),t2fac_sms(*)
144 DOUBLE PRECISION FBSAV6(12,6,DIMFB)
145 TYPE(INTBUF_STRUCT_) INTBUF_TAB
146 TYPE(H3D_DATABASE) :: H3D_DATA
147 TYPE(INTBUF_FRIC_STRUCT_), TARGET, DIMENSION(NINTERFRIC) :: INTBUF_FRIC_TAB
148 TYPE (INTERFACES_) ,INTENT(IN):: INTERFACES
149C-----------------------------------------------
150C L o c a l V a r i a b l e s
151C-----------------------------------------------
152 INTEGER JD(50),KD(50), JFI, KFI,IEDGE,
153 . I, J, H, I_STOK, JLT_NEW, JLT , NFT, IVIS2,
154 . IBC, NOINT, NSEG, ISECIN, IBAG, IADM,
155 . IGAP, INACTI, IFQ, MFROT, IGSTI, NISUB,
156 . NB_LOC, I_STOK_LOC,DEBUT, I_STOK_GLO,
157 . ILAGM, LENR, LENT, MAXCC,INTTH,IFORM,INTPLY,INTFRIC,
158 . NSETPRTS ,NPARTFRIC, IERROR, INTNITSCHE, IORTHFRIC,
159 . NFORTH ,NFISOT ,JJ ,ISTIF_MSDT, INTCAREA
160 INTEGER IX1(MVSIZ), IX2(MVSIZ), IX3(MVSIZ), IX4(MVSIZ),
161 . NSVG(MVSIZ), CN_LOC(MVSIZ),CE_LOC(MVSIZ),
162 . CAND_N_N(MVSIZ),CAND_E_N(MVSIZ),CAND_T_N(MVSIZ),
163 . KINI(MVSIZ),IKNON(MVSIZ),
164 . SUBTRIA_OLD(MVSIZ),
165c . INDEX2(LINDMAX),SUBTRIA_OLD(MVSIZ),
166 . ISDSIZ(NSPMD+1),IRCSIZ(NSPMD+1),
167 . IELECI(MVSIZ), NSMS(MVSIZ),IXX(MVSIZ,13),ITRIV(4,MVSIZ),
168 . IPLY(4,MVSIZ),ISPT2_LOC(MVSIZ),
169 . IPARTFRICSI(MVSIZ),IPARTFRICMI(MVSIZ),INDEXISOT(MVSIZ),
170 . INDEXORTH(MVSIZ),IREP_FRICMI(MVSIZ),IXX3(MVSIZ),IXX4(MVSIZ)
171 INTEGER, ALLOCATABLE, DIMENSION(:) :: INDEX2
172C REAL
173 my_real
174 . startt, fric, gap, stopt,pmax_gap,penref(mvsiz),
175 . visc,viscf,stiglo,gapmin,
176 . kmin, kmax, gapmax,rstif,fheat,tint,rhoh,eps
177 INTEGER :: IFRIC
178C-----------------------------------------------
179C REAL
180 my_real
181 . nx1(mvsiz), nx2(mvsiz), nx3(mvsiz), nx4(mvsiz),
182 . ny1(mvsiz), ny2(mvsiz), ny3(mvsiz), ny4(mvsiz),
183 . nz1(mvsiz), nz2(mvsiz), nz3(mvsiz), nz4(mvsiz),
184 . x1(mvsiz), x2(mvsiz), x3(mvsiz), x4(mvsiz),
185 . y1(mvsiz), y2(mvsiz), y3(mvsiz), y4(mvsiz),
186 . z1(mvsiz), z2(mvsiz), z3(mvsiz), z4(mvsiz),
187 . xi(mvsiz), yi(mvsiz), zi(mvsiz), stif(mvsiz),
188 . vx1(mvsiz), vx2(mvsiz), vx3(mvsiz), vx4(mvsiz),
189 . vy1(mvsiz), vy2(mvsiz), vy3(mvsiz), vy4(mvsiz),
190 . vz1(mvsiz), vz2(mvsiz), vz3(mvsiz), vz4(mvsiz),
191 . vxi(mvsiz), vyi(mvsiz), vzi(mvsiz),
192 . n1(mvsiz), n2(mvsiz), n3(mvsiz), pene(mvsiz),
193 . h1(mvsiz), h2(mvsiz), h3(mvsiz), h4(mvsiz),
194 . gapv(mvsiz),msi(mvsiz),
195 . nm1(mvsiz), nm2(mvsiz), nm3(mvsiz),
196 . tempi(mvsiz),phi(mvsiz),areasi(mvsiz),
197 . xx0(mvsiz,17),yy0(mvsiz,17),zz0(mvsiz,17),
198 . vx(mvsiz,17),vy(mvsiz,17),vz(mvsiz,17),
199 . gaps(mvsiz),forneqsi(mvsiz,3),dist(mvsiz)
200 INTEGER :: SUBTRIA(MVSIZ)
201
202 my_real
203 . , DIMENSION(:,:),ALLOCATABLE :: surf
204 my_real
205 . , DIMENSION(:), ALLOCATABLE :: pres
206 my_real
207 . , DIMENSION(:,:,:), ALLOCATABLE :: fsavparit
208 SAVE surf,pres
209 my_real
210 . rcurvi(mvsiz), anglmi(mvsiz), anglt, padm,penmin,marge
211 INTEGER NRTMFT, NRTMLT, NMNFT, NMNLT, NRADM,NCY_PFIT
212 my_real
213 . t_pfit,fa,fb,f_pfit,tncy,finc,dtstif
214 INTEGER ICURV,ILEV,NREBOU,NPT ,NRTSE,IEDG4,SFSAVPARIT,NINLOADP
215 my_real
216 . xfiltr_fric,fric_coefs(mvsiz,10),viscffric(mvsiz),fricc(mvsiz),
217 . fric_coefs2(mvsiz,10),viscffric2(mvsiz),fricc2(mvsiz),
218 . dir1(mvsiz,3),dir2(mvsiz,3),dir_fricmi(mvsiz,2),
219 . xx1(mvsiz), xx2(mvsiz), xx3(mvsiz), xx4(mvsiz),
220 . yy1(mvsiz), yy2(mvsiz), yy3(mvsiz), yy4(mvsiz),
221 . zz1(mvsiz), zz2(mvsiz), zz3(mvsiz), zz4(mvsiz)
222 INTEGER, DIMENSION(:) ,POINTER :: TABCOUPLEPARTS_FRIC
223 INTEGER, DIMENSION(:) ,POINTER :: TABPARTS_FRIC
224 INTEGER, DIMENSION(:) ,POINTER :: ADPARTS_FRIC
225 INTEGER, DIMENSION(:) ,POINTER :: IFRICORTH
226 my_real, DIMENSION(:) ,POINTER :: tabcoef_fric
227
228 INTEGER,TARGET, DIMENSION(1):: TABCOUPLEPARTS_FRIC_BID
229 INTEGER,TARGET, DIMENSION(1):: TABPARTS_FRIC_BID
230 INTEGER,TARGET, DIMENSION(1):: ADPARTS_FRIC_BID
231 INTEGER,TARGET, DIMENSION(1):: IFRICORTH_BID
232 my_real,TARGET, DIMENSION(1):: tabcoef_fric_bid
233 INTEGER :: NRTM, NSN, NTY, NSNE
234C
235C
236 nrtm =ipari(4,nin)
237 nsn =ipari(5,nin)
238 nty =ipari(7,nin)
239 ibc =ipari(11,nin)
240 ivis2 =ipari(14,nin)
241 IF(ipari(33,nin)==1) RETURN
242 noint =ipari(15,nin)
243 igap =ipari(21,nin)
244 inacti=ipari(22,nin)
245 isecin=ipari(28,nin)
246 mfrot =ipari(30,nin)
247 ifq =ipari(31,nin)
248 ibag =ipari(32,nin)
249 igsti=ipari(34,nin)
250 nisub =ipari(36,nin)
251 icurv =ipari(39,nin)
252 iedge = ipari(58,nin)
253
254C adaptive meshing
255 iadm =ipari(44,nin)
256 nradm=ipari(49,nin)
257 padm =intbuf_tab%VARIABLES(24)
258 anglt=intbuf_tab%VARIABLES(25)
259 marge=intbuf_tab%VARIABLES(25)
260C heat interface
261 intth = ipari(47,nin)
262 iform = ipari(48,nin)
263 intply = ipari(66,nin)
264C-----implicit IGSTI=6
265 nrebou=ipari(53,nin)
266 nsne = ipari(55,nin)
267 iedg4 = ipari(59,nin)
268C---- IEDG4 =1 (IEDGE=4) w/o coulage extension...; =2(IEDGE=5) w/ coulage;
269C
270 stiglo=-intbuf_tab%STFAC(1)
271 startt=intbuf_tab%VARIABLES(3)
272 stopt =intbuf_tab%VARIABLES(11)
273 IF(startt>tt) RETURN
274 IF(tt>stopt) RETURN
275C
276 fric =intbuf_tab%VARIABLES(1)
277 gap =intbuf_tab%VARIABLES(2)
278 gapmin=intbuf_tab%VARIABLES(13)
279 visc =intbuf_tab%VARIABLES(14)
280C VISCF =INTBUF_TAB%VARIABLES(15)
281 t_pfit = intbuf_tab%VARIABLES(15)
282 viscf = zero
283C
284 gapmax=intbuf_tab%VARIABLES(16)
285 kmin =intbuf_tab%VARIABLES(17)
286 kmax =intbuf_tab%VARIABLES(18)
287C
288
289 rstif = intbuf_tab%VARIABLES(20)
290 fheat = intbuf_tab%VARIABLES(21)
291 tint = intbuf_tab%VARIABLES(22)
292 penmin = intbuf_tab%VARIABLES(38)
293 eps = intbuf_tab%VARIABLES(39)
294 pmax_gap = zero
295 ilev = ipari(20,nin)
296 nrtse = ipari(52,nin)
297C
298 istif_msdt =ipari(97,nin)
299 dtstif = intbuf_tab%VARIABLES(48)
300C
301 intcarea = ipari(99,nin)
302C
303 ifric = 0
304C--- Corresponding Friction model
305 intfric=ipari(72,nin)
306 iorthfric = 0
307 nsetprts = 0
308 npartfric = 0
309 xfiltr_fric = zero
310 IF(intfric /= 0) THEN
311 tabcoupleparts_fric => intbuf_fric_tab(intfric)%TABCOUPLEPARTS_FRIC
312 tabcoef_fric => intbuf_fric_tab(intfric)%TABCOEF_FRIC
313 tabparts_fric => intbuf_fric_tab(intfric)%TABPARTS_FRIC
314 adparts_fric => intbuf_fric_tab(intfric)%ADPARTS_FRIC
315 xfiltr_fric = intbuf_fric_tab(intfric)%XFILTR_FRIC
316 nsetprts = intbuf_fric_tab(intfric)%NSETPRTS
317 npartfric = intbuf_fric_tab(intfric)%S_TABPARTS_FRIC
318 iorthfric = intbuf_fric_tab(intfric)%IORTHFRIC
319 ifricorth => intbuf_fric_tab(intfric)%IFRICORTH
320c MFROT = INTBUF_FRIC_TAB(INTFRIC)%FRICMOD ! These Flags are already put in Ipari
321c IFQ = INTBUF_FRIC_TAB(INTFRIC)%IFFILTER
322 ELSE
323 tabcoupleparts_fric => tabcoupleparts_fric_bid
324 tabparts_fric => tabparts_fric_bid
325 tabcoef_fric => tabcoef_fric_bid
326 adparts_fric => adparts_fric_bid
327 ifricorth => ifricorth_bid
328 IF (ifq/=0) xfiltr_fric = intbuf_tab%XFILTR(1)
329 ENDIF
330C--- NITSCHE METHOD
331 intnitsche=ipari(86,nin)
332C
333 ninloadp = ipari(95,nin) ! load pressure related to inter
334C
335C-----T_FIT .OR. NCY_PFIT
336 f_pfit = zero
337 IF (startt>zero.AND.t_pfit==zero) THEN
338 t_pfit=10000*dt12
339 intbuf_tab%VARIABLES(15) = t_pfit
340 END IF
341 IF (t_pfit>zero) THEN
342 IF (tt <=(startt+t_pfit)) THEN
343 tncy = (tt+em05-startt)/t_pfit
344 ELSE
345 ipari(40,nin)= 0
346 END IF
347 ELSE
348 ncy_pfit = ipari(40,nin)
349 IF (ncy_pfit >0 .AND. ncycle> ncy_pfit) ipari(40,nin) = 0
350 IF (ipari(40,nin)>0) THEN
351 finc= one/ipari(40,nin)
352 tncy = (ncycle+1)*finc
353 END IF
354 END IF
355 ALLOCATE(index2(lindmax))
356
357C ------ Move to another place ----
358CCC IF (IEDG4 >0) THEN
359CCC NPT = 3
360CCC IF (JTASK ==1 ) THEN
361CCC ALLOCATE(MSFIC(NSNE))
362CCC CALL I24FICS_INI(INTBUF_TAB%IRTSE ,NSNE ,INTBUF_TAB%IS2SE ,
363CCC 1 INTBUF_TAB%IS2PT ,NSN ,INTBUF_TAB%NSV ,
364CCC 2 MS ,MSFIC ,NPT )
365CCC END IF !(JTASK ==1 ) THEN
366CCC CALL MY_BARRIER()
367CCC END IF
368C
369c----------------------------------------------------
370c Courbure quadratique calcul des normales nodales
371c----------------------------------------------------
372 IF(icurv==3)THEN
373 endif!(ICURV==3)
374c----------------------------------------------------
375c Rayon de courbure : calcul des normales nodales (normees)
376C IADM!=0 + Icurv!=0 non available (starter error).
377c----------------------------------------------------
378 IF(iadm/=0)THEN
379 END if!(IADM/=0)
380C----------------------------------------------------
381C----------------------------------------------------
382C
383 i_stok_glo = intbuf_tab%I_STOK(1)
384C
385C decoupage statique
386
387 nb_loc = i_stok_glo / nthread
388 IF (jtask==nthread) THEN
389 i_stok_loc = i_stok_glo-nb_loc*(nthread-1)
390 ELSE
391 i_stok_loc = nb_loc
392 ENDIF
393 debut = (jtask-1)*nb_loc
394
395 i_stok = 0
396C
397C recalcul du istok
398C
399 DO i = jtask, i_stok_glo, nthread
400 IF(intbuf_tab%CAND_N(i)<0) THEN
401 i_stok = i_stok + 1
402 index2(i_stok) = i
403 intbuf_tab%CAND_N(i) = -intbuf_tab%CAND_N(i)
404 ENDIF
405 ENDDO
406C-----------------------------------------------------------------------
407 IF (impl_s==1) THEN
408 num_imp = 0
409 visc =zero
410 viscf =zero
411 ENDIF
412c------------------------------------------------
413C
414 sfsavparit = 0
415 DO i=1,nisub+1
416 IF(isensint(i)/=0) THEN
417 sfsavparit = sfsavparit + 1
418 ENDIF
419 ENDDO
420 IF (sfsavparit /= 0) THEN
421 ALLOCATE(fsavparit(nisub+1,11,i_stok),stat=ierror)
422 IF(ierror/=0) THEN
423 CALL ancmsg(msgid=19,anmode=aninfo,
424 . c1='(/INTER/TYPE7)')
425 CALL arret(2)
426 ENDIF
427 fsavparit(1:nisub+1,1:11,1:i_stok) = zero
428 ELSE
429 ALLOCATE(fsavparit(0,0,0),stat=ierror)
430 IF(ierror/=0) THEN
431 CALL ancmsg(msgid=19,anmode=aninfo,
432 . c1='(/INTER/TYPE24)')
433 CALL arret(2)
434 ENDIF
435
436 ENDIF
437c
438c------------------------------------------------
439 IF (debug(3)>=1) THEN
440 nb_jlt = nb_jlt + i_stok_loc
441 nb_stok_n = nb_stok_n + i_stok
442 ENDIF
443C
444 DO nft = 0 , i_stok - 1 , nvsiz
445 jlt = min( nvsiz, i_stok - nft )
446C preparation candidats retenus
447 iknon(1:jlt) = 0
448 CALL i24cdcor3(
449 1 jlt,index2(nft+1),intbuf_tab%CAND_E,intbuf_tab%CAND_N,intbuf_tab%CAND_T,
450 2 cand_e_n,cand_n_n,cand_t_n ,iedge )
451C cand_n et cand_e remplace par cand_n_n et cand_e_n
452C-------ISPT2 change dimension NSN, initialis au Starter
453 CALL i24cor3(
454 1 jlt ,x ,intbuf_tab%IRECTM,intbuf_tab%NSV ,cand_e_n ,
455 2 cand_n_n ,cand_t_n ,intbuf_tab%STFM ,intbuf_tab%STFNS,stif ,
456 3 xx0 ,yy0 ,zz0 ,vx ,vy ,
457 5 vz ,xi ,yi ,zi ,vxi ,
458 7 vyi ,vzi ,ixx ,nsvg ,intbuf_tab%NVOISIN,
459 9 ms,msi ,nsn ,v ,kinet ,
460 a kini ,nty ,nin ,igsti ,kmin ,
461 b kmax ,intbuf_tab%GAP_S,gaps ,nodnx_sms ,nsms ,
462 c itriv ,intbuf_tab%XFIC,intbuf_tab%VFIC ,intbuf_tab%MSFIC ,
463 d intbuf_tab%IRTSE ,intbuf_tab%IS2SE,intbuf_tab%IS2PT,intbuf_tab%ISEGPT,
464 e nsne ,intbuf_tab%IRTLM,npt ,nrtse ,iedg4,intbuf_tab%ISPT2,
465 f ispt2_loc ,intfric ,intbuf_tab%IPARTFRICS,ipartfricsi ,
466 g intbuf_tab%IPARTFRICM ,ipartfricmi,intnitsche,forneqs ,forneqsi ,
467 h iorthfric,intbuf_tab%IREP_FRICM,intbuf_tab%DIR_FRICM,irep_fricmi,dir_fricmi,
468 i ixx3 ,ixx4 , xx1 ,xx2 ,xx3 ,
469 3 xx4 ,yy1 ,yy2 ,yy3 ,yy4 ,
470 4 zz1 ,zz2 ,zz3 ,zz4 ,ninloadp ,
471 5 dist ,istif_msdt ,dtstif ,intbuf_tab%STIFMSDT_S,intbuf_tab%STIFMSDT_M,
472 6 nrtm ,interfaces%PARAMETERS)
473 CALL i_corpfit3(
474 1 jlt ,intbuf_tab%STFM ,intbuf_tab%STFNS,stif ,nsn ,
475 2 cand_e_n ,cand_n_n,nin ,igsti ,kmin ,
476 3 kmax ,inacti ,ipari(40,nin),tncy ,iknon )
477
478 jlt_new = 0
479 IF(impl_s > 0 ) THEN
480 CALL impl_sav0(
481 1 jlt ,cand_n_n ,subtria_old ,intbuf_tab%IRTLM,nsn ,nin )
482 END if!(IMPL_S > 0 ) THEN
483C
484 CALL i24dst3(
485 1 jlt ,cand_n_n ,cand_e_n ,cn_loc ,ce_loc ,
486 2 x1 ,x2 ,x3 ,x4 ,y1 ,
487 3 y2 ,y3 ,y4 ,z1 ,z2 ,
488 4 z3 ,z4 ,xi ,yi ,zi ,
489 5 vx1 ,vx2 ,vx3 ,vx4 ,vxi ,
490 6 vy1 ,vy2 ,vy3 ,vy4 ,vyi ,
491 7 vz1 ,vz2 ,vz3 ,vz4 ,vzi ,
492 8 n1 ,n2 ,n3 ,h1 ,h2 ,
493 9 h3 ,h4 ,nin ,nsn ,ix1 ,
494 a ix2 ,ix3 ,ix4 ,nsvg ,stif ,
495 b jlt_new ,inacti ,intbuf_tab%MSEGLO,gaps ,intbuf_tab%GAP_NM,
496 c kini ,intbuf_tab%IRECTM,intbuf_tab%IRTLM ,intbuf_tab%TIME_S,
497 . subtria,
498 d intth ,nsms ,pene ,xx0 ,yy0 ,
499 e zz0 ,vx ,vy ,vz ,ixx ,
500 f intbuf_tab%MVOISIN,pmax_gap,intbuf_tab%SECND_FR,intbuf_tab%GAP_M,
501 . intbuf_tab%PENE_OLD,
502 g intbuf_tab%STIF_OLD,itriv ,itab ,cand_t_n ,iedge ,
503 h nft ,penmin ,eps ,nm1 ,nm2 ,
504 i nm3 ,intply ,intbuf_tab%DGAP_NM ,intbuf_tab%ICONT_I,
505 j marge ,iedg4 ,ispt2_loc ,ipari(40,nin),iknon,penref )
506
507 IF(iedge/=0)CALL i24dst3e(
508 1 jlt ,a ,x ,cand_n_n ,cand_e_n ,
509 2 intbuf_tab%MBINFLG,intbuf_tab%ISEADD ,intbuf_tab%ISEDGE,nsvg,nin,
510 3 ixx ,stif ,
511 4 jlt_new ,inacti ,xi ,yi ,zi ,
512 5 xx0 ,yy0 ,zz0 ,pmax_gap ,
513 6 fskyi ,isky ,cand_t_n ,fcont ,h3d_data )
514
515 IF(impl_s > 0 ) THEN
516 CALL impl_sav(
517 1 jlt ,cand_n_n ,cand_e_n ,intbuf_tab%IRTLM,stif ,
518 2 pene ,subtria,ns_imp ,ne_imp ,ind_imp,
519 3 num_imp,jlt_new,intbuf_tab%NSV,subtria_old,
520 4 intbuf_tab%MSEGLO,nsn ,nin ,nrtm )
521 ELSE
522 DO i = 1 ,jlt
523 IF(pene(i)/=zero.AND.stif(i)/=zero)THEN
524 jlt_new = jlt_new + 1
525
526 END IF
527 ENDDO
528 ENDIF
529C
530 IF(ninloadp==0.AND.jlt_new == 0)cycle
531 ipari(29,nin) = 1
532C
533C auxiliaire compute for int + plxfem
534C
535 IF(intply > 0) THEN
536 CALL i24iply_pxfem(
537 1 jlt ,cand_e_n ,intbuf_tab%MSEGTYP24 ,ix1 ,ix2 ,
538 2 ix3 ,ix4 , pene, ms_ply ,inod_pxfem ,
539 3 iply ,itab )
540 ENDIF
541
542 IF (debug(3)>=1) nb_jlt_new = nb_jlt_new + jlt_new
543 IF (imonm > 0 .AND. jtask == 1) CALL startime(timers,20)
544
545C-------------------------------------------------------------------------------
546C Friction model : computation of friction coefficients based on Material of connected Parts
547C-------------------------------------------------------------------------------
548 IF(jtask==1) CALL startime(timers,macro_timer_fric)
549 jj = 0
550 IF(iorthfric > 0) THEN
551 CALL frictionparts_model_ortho(
552 1 intfric ,jlt ,ipartfricsi ,ipartfricmi ,adparts_fric ,
553 2 nsetprts ,tabcoupleparts_fric,npartfric,tabparts_fric,tabcoef_fric ,
554 3 fric ,viscf ,intbuf_tab%FRIC_P,fric_coefs, fricc ,
555 4 viscffric ,nty ,mfrot ,iorthfric , fric_coefs2 ,
556 5 fricc2 ,viscffric2 ,ifricorth ,nforth , nfisot ,
557 6 indexorth ,indexisot ,jj ,irep_fricmi ,dir_fricmi ,
558 7 ixx3 ,ixx4 ,xx1 ,yy1 , zz1 ,
559 8 xx2 ,yy2 ,zz2 ,xx3 , yy3 ,
560 9 zz3 ,xx4 ,yy4 ,zz4 ,ce_loc ,
561 a dir1 ,dir2 )
562 ELSE
563 nforth = 0
564 nfisot = 0
565 CALL frictionparts_model_isot(
566 1 intfric ,jlt ,ipartfricsi ,ipartfricmi ,adparts_fric ,
567 2 nsetprts ,tabcoupleparts_fric,npartfric,tabparts_fric,tabcoef_fric ,
568 3 fric ,viscf ,intbuf_tab%FRIC_P,fric_coefs, fricc ,
569 4 viscffric ,nty ,mfrot ,iorthfric ,ifric ,
570 5 jj , tint ,tempi ,npc ,tf ,
571 6 temp , h1 ,h2 ,h3 ,h4 ,
572 7 ix1 , ix2 ,ix3 ,ix4 ,iform )
573 ENDIF
574 IF(jtask==1) CALL stoptime(timers,macro_timer_fric)
575
576 CALL i24for3(
577 1 jlt ,a ,v ,ibc ,icodt ,
578 2 fsav ,gap ,fric ,ms ,visc ,
579 3 viscf ,noint ,intbuf_tab%STFNS,itab ,cn_loc ,
580 4 stiglo ,stifn ,stif ,fskyi ,isky ,
581 5 n1 ,n2 ,n3 ,h1 ,h2 ,
582 6 h3 ,h4 ,fcont ,pene ,
583 7 ix1 ,ix2 ,ix3 ,ix4 ,nsvg ,
584 8 ivis2 ,neltst ,ityptst ,dt2t ,subtria ,
585 9 gapv ,inacti ,index2(nft+1),niskyfi ,
586 a kinet ,newfront ,isecin ,nstrf ,secfcum ,
587 b x ,intbuf_tab%IRECTM,ce_loc ,mfrot ,ifq ,
588 c intbuf_tab%FRIC_P,intbuf_tab%SECND_FR,xfiltr_fric,
589 d ibag ,icontact ,intbuf_tab%IRTLM,
590 e viscn ,vxi ,vyi ,vzi ,msi ,
591 f kini ,nin ,nisub ,intbuf_tab%LISUB,intbuf_tab%ADDSUBS,
592 g intbuf_tab%ADDSUBM,intbuf_tab%LISUBS,intbuf_tab%LISUBM,fsavsub,
593 + intbuf_tab%CAND_N,
594 h ipari(33,nin),ipari(39,nin),fncont ,ftcont ,nsn ,
595 i x1 ,x2 ,x3 ,x4 ,y1 ,
596 j y2 ,y3 ,y4 ,z1 ,z2 ,
597 k z3 ,z4 ,xi ,yi ,zi ,
598 l iadm ,rcurvi ,rcontact ,acontact ,pcontact ,
599 m anglmi ,padm ,intth , phi , fthe ,
600 n ftheskyi ,temp , tempi ,rstif , iform ,
601 o mskyi_sms ,iskyi_sms ,nsms ,cand_n_n ,intbuf_tab%PENE_OLD,
602 p intbuf_tab%STIF_OLD,intbuf_tab%MBINFLG,ilev ,igsti ,kmin ,
603 q intply ,iply ,inod_pxfem,nm1 ,nm2 ,
604 r nm3 ,nrebou ,intbuf_tab%IRTSE ,nsne ,intbuf_tab%IS2SE ,
605 s intbuf_tab%IS2PT,intbuf_tab%MSEGTYP24,jtask ,isensint ,
606 u fsavparit ,nft ,h3d_data ,fricc ,viscffric ,
607 v fric_coefs ,t2main_sms ,intnitsche ,forneqsi ,iorthfric ,
608 w fric_coefs2 ,fricc2 ,viscffric2 ,nforth ,nfisot ,
609 x indexorth ,indexisot ,dir1 ,dir2 ,t2fac_sms ,f_pfit,
610 y tagncont ,kloadpinter ,loadpinter ,loadp_hyd_inter,
611 z intbuf_tab%TYPSUB,intbuf_tab%INFLG_SUBS,intbuf_tab%INFLG_SUBM,
612 . ninloadp,dgaploadint,
613 1 s_loadpinter, dist ,ixx ,interefric ,intcarea ,
614 2 interfaces%PARAMETERS ,penref ,kmax , intbuf_tab%S_ADDSUBM ,
615 3 intbuf_tab%S_LISUBM,intbuf_tab%S_TYPSUB,nisubmax,i_stok,nrtm,
616 4 nrtse ,ipari(24,nin))
617C
618 IF(impl_s > 0 )
619 + CALL impl_sav1(
620 1 jlt ,cand_n_n ,cand_e_n ,intbuf_tab%IRTLM,stif ,
621 2 pene ,subtria,intbuf_tab_imp(nin)%CAND_N,
622 + intbuf_tab_imp(nin)%CAND_E,intbuf_tab_imp(nin)%INDSUBT,
623 3 intbuf_tab_imp(nin)%I_STOK(1),
624 2 n1 ,n2 ,n3 ,h1 ,h2 ,h3 ,
625 4 h4 ,intbuf_tab_imp(nin)%NJ,intbuf_tab_imp(nin)%HJ ,
626 5 intbuf_tab_imp(nin)%STIF,nin ,nsn )
627 IF (imonm > 0 .AND. jtask == 1) CALL stoptime(timers,20)
628
629 ENDDO
630c
631 IF (sfsavparit /= 0)THEN
632 CALL sum_6_float_sens(fsavparit, nisub+1, 11, i_stok,1,i_stok,
633 . fbsav6, 12, 6, dimfb, isensint )
634 ENDIF
635 IF (ALLOCATED(fsavparit)) DEALLOCATE (fsavparit)
636c
637#include "lockon.inc"
638 intbuf_tab%VARIABLES(23) = max(pmax_gap,intbuf_tab%VARIABLES(23))
639#include "lockoff.inc"
640C
641 IF(intply > 0) THEN
642 CALL i24gap_pxfem(
643 1 nrtm ,intbuf_tab%IRECTM,intbuf_tab%IRTLM ,intbuf_tab%GAP_N0 ,
644 2 intbuf_tab%MVOISIN ,intbuf_tab%NVOISIN,intbuf_tab%MSEGTYP24 ,inod_pxfem ,
645 3 x ,ms_ply ,wagap ,itab ,
646 4 intbuf_tab%ISEG_PXFEM ,intbuf_tab%ISEG_PLY,intbuf_tab%STFM)
647 ENDIF !intply
648C
649
650ccc IF(NSNE > 0) CALL MY_BARRIER()
651 DEALLOCATE(index2)
652 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
if
if(complex_arithmetic) id
i_corpfit3
subroutine i_corpfit3(jlt, stf, stfn, stif, nsn, cand_e, cand_n, nin, igsti, kmin, kmax, inacti, ncfit, tncy, iknon)
Definition i24cor3.F:955
frictionparts_model_ortho
subroutine frictionparts_model_ortho(intfric, jlt, ipartfricsi, ipartfricmi, adparts_fric, nset, tabcoupleparts_fric, npartfric, tabparts_fric, tabcoef_fric, fric, viscf, frot_p, fric_coefs, fricc, viscffric, nty, mfrot, iorthfric, fric_coefs2, fricc2, viscffric2, ifricorth, nforth, nfisot, indexorth, indexisot, jlt_tied, irep_fricmi, dir_fricmi, ix3, ix4, x1, y1, z1, x2, y2, z2, x3, y3, z3, x4, y4, z4, ce_loc, dir1, dir2)
Definition frictionparts_model.F:43
frictionparts_model_isot
subroutine frictionparts_model_isot(intfric, jlt, ipartfricsi, ipartfricmi, adparts_fric, nset, tabcoupleparts_fric, npartfric, tabparts_fric, tabcoef_fric, fric, viscf, frot_p, fric_coefs, fricc, viscffric, nty, mfrot, iorthfric, ifric, jlt_tied, tint, tempi, npc, tf, temp, h1, h2, h3, h4, ix1, ix2, ix3, ix4, iform)
Definition frictionparts_model.F:350
i24dst3
subroutine i24dst3(jlt, cand_n, cand_e, cn_loc, ce_loc, x1, x2, x3, x4, y1, y2, y3, y4, z1, z2, z3, z4, xi, yi, zi, vx1, vx2, vx3, vx4, vxi, vy1, vy2, vy3, vy4, vyi, vz1, vz2, vz3, vz4, vzi, n1, n2, n3, h1, h2, h3, h4, nin, nsn, ix1, ix2, ix3, ix4, nsvg, stif, jlt_new, inacti, mseglo, gaps, gap_nm, kini, irect, irtlm, time_s, subtria, intth, nsms, pene, xx0, yy0, zz0, vx, vy, vz, ixx, mvoisin, pmax_gap, secnd_fr, gap_m, pene_old, stif_old, itriv, itab, cand_t, iedge, nft, penmin, eps0, nm1, nm2, nm3, intply, dgap_nm, icont_i, marge, nsne, ispt2, izero, iknon, penref)
Definition i24dst3.F:56
i24dst3e
subroutine i24dst3e(jlt, a, x, cand_n, cand_e, mbinflg, iseadd, isedge, nsvg, nin, ixx, stif, jlt_new, inacti, xi, yi, zi, xx, yy, zz, pmax_gap, fskyi, isky, cand_t, fcont, h3d_data)
Definition i24dst3e.F:40
i24for3
subroutine i24for3(jlt, a, v, ibcc, icodt, fsav, gap, fric, ms, visc, viscf, noint, stfn, itab, cn_loc, stiglo, stifn, stif, fskyi, isky, n1, n2, n3, h1, h2, h3, h4, fcont, pene, ix1, ix2, ix3, ix4, nsvg, ivis2, neltst, ityptst, dt2t, subtria, gapv, inacti, index, niskyfi, kinet, newfront, isecin, nstrf, secfcum, x, irect, ce_loc, mfrot, ifq, frot_p, secnd_fr, alpha0, ibag, icontact, irtlm, viscn, vxi, vyi, vzi, msi, kini, nin, nisub, lisub, addsubs, addsubm, lisubs, lisubm, fsavsub, cand_n, ilagm, icurv, fncont, ftcont, nsn, x1, x2, x3, x4, y1, y2, y3, y4, z1, z2, z3, z4, xi, yi, zi, iadm, rcurvi, rcontact, acontact, pcontact, anglmi, padm, intth, phi, fthe, ftheskyi, temp, tempi, rstif, iform, mskyi_sms, iskyi_sms, nsms, cand_n_n, pene_old, stif_old, mbinflg, ilev, igsti, kmin, intply, iply, inod_pxfem, nm1, nm2, nm3, nrebou, irtse, nsne, is2se, is2pt, msegtyp, jtask, isensint, fsavparit, nft, h3d_data, fricc, viscffric, fric_coefs, t2main_sms, intnitsche, forneqsi, iorthfric, fric_coefs2, fricc2, viscffric2, nforth, nfisot, indexorth, indexisot, dir1, dir2, t2fac_sms, f_pfit, tagncont, kloadpinter, loadpinter, loadp_hyd_inter, typsub, inflg_subs, inflg_subm, ninloadp, dgaploadint, s_loadpinter, dist, ixx, interefric, intcarea, parameters, penref, kmax, s_addsubm, s_lisubm, s_typsub, nisubmax, i_stok, nrtm, nrtse, nsnr)
Definition i24for3.F:83
i24gap_pxfem
subroutine i24gap_pxfem(nrtm, irect, cand_e, gap_nm, mvoisin, nvoisin, msegtyp, inod_pxfem, x, ms_ply, wagap, itab, iseg_pxfem, iseg_ply, stfm)
Definition i24gap_pxfem.F:36
i24iply_pxfem
subroutine i24iply_pxfem(jlt, cand_e, msegtyp, ix1, ix2, ix3, ix4, pene, ms_ply, inod_pxfem, iply, itab)
Definition i24iply_pxfem.F:35
impl_sav
subroutine impl_sav(jlt, cand_n, cand_e, irtlm, stif, pene, subtria, ns_imp, ne_imp, ind_imp, num_imp, jlt_new, nsv, subtria_old, mseglo, nsn, nin, nrtm)
Definition i24main.F:666
i24cdcor3
subroutine i24cdcor3(jlt, index, cand_e, cand_n, cand_t, cand_e_n, cand_n_n, cand_t_n, iedge)
Definition i24main.F:761
impl_sav0
subroutine impl_sav0(jlt, cand_n, subtria_old, irtlm, nsn, nin)
Definition i24main.F:724
impl_sav1
subroutine impl_sav1(jlt, cand_n, cand_e, irtlm, stif, pene, subtria, ns_imp, ne_imp, ind_imp, ii_stok, n1, n2, n3, h1, h2, h3, h4, nj_imp, hj_imp, stif_imp, nin, nsn)
Definition i24main.F:800
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
outputs_mod
Definition outputs_mod.F:59
sum_6_float_sens
subroutine sum_6_float_sens(f, a, b, c, jft, jlt, f6, d, e, g, isensint)
Definition parit.F:540
i24cor3
subroutine i24cor3(x, irect, nsv, cand_e, cand_n, stf, stfn, gapv, igap, gap, gap_s, gap_m)
Definition i24cor3.F:31
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
startime
subroutine startime(event, itask)
Definition timer.F:93
stoptime
subroutine stoptime(event, itask)
Definition timer.F:135

◆ impl_sav()

subroutine impl_sav ( integer jlt,
integer, dimension(*) cand_n,
integer, dimension(*) cand_e,
integer, dimension(2,*) irtlm,
stif,
pene,
integer, dimension(*) subtria,
integer, dimension(*) ns_imp,
integer, dimension(*) ne_imp,
integer, dimension(*) ind_imp,
integer num_imp,
integer jlt_new,
integer, dimension(*) nsv,
integer, dimension(*) subtria_old,
integer, dimension(*) mseglo,
integer nsn,
integer nin,
integer nrtm )

Definition at line 661 of file i24main.F.

666C-----------------------------------------------
667C M o d u l e s
668C-----------------------------------------------
669 USE tri7box
670C-----------------------------------------------
671C I m p l i c i t T y p e s
672C-----------------------------------------------
673#include "implicit_f.inc"
674C-----------------------------------------------
675C C o m m o n B l o c k s
676C-----------------------------------------------
677#include "com08_c.inc"
678C-----------------------------------------------
679C D u m m y A r g u m e n t s
680C-----------------------------------------------
681 INTEGER JLT,JLT_NEW,NSV(*),SUBTRIA_OLD(*),NSN,NIN,NRTM
682 INTEGER NUM_IMP,NS_IMP(*),NE_IMP(*),IND_IMP(*),
683 . CAND_E(*),CAND_N(*),SUBTRIA(*),IRTLM(2,*),MSEGLO(*)
684C REAL
685 my_real
686 . stif(*), pene(*)
687C-----------------------------------------------
688C L o c a l V a r i a b l e s
689C-----------------------------------------------
690 INTEGER I,NS,NE,ITQ,NEG,J
691C----------------------------------------------------
692 DO i = 1 ,jlt
693 IF(pene(i)/=zero.AND.stif(i)/=zero)THEN
694 jlt_new = jlt_new + 1
695 ns=cand_n(i)
696 ne=cand_e(i)
697 itq=subtria_old(i)
698C---------due tiny penetration removed to Engine---
699 IF (tt==zero.AND.itq==0) itq=1
700C----sliding on the neibour : to verify if IRTLM_FI is updated already
701 IF (subtria(i)>4) THEN
702C-----------case sliding different to i24dist3
703 ne = -cand_e(i)
704 itq=subtria(i)
705 END IF
706 ns_imp(jlt_new+num_imp)=ns
707 ne_imp(jlt_new+num_imp)=ne
708 ind_imp(jlt_new+num_imp)=itq
709 END IF
710 ENDDO
711 num_imp=num_imp+jlt_new
712C
713 RETURN

◆ impl_sav0()

subroutine impl_sav0 ( integer jlt,
integer, dimension(*) cand_n,
integer, dimension(*) subtria_old,
integer, dimension(2,*) irtlm,
integer nsn,
integer nin )

Definition at line 722 of file i24main.F.

724C-----------------------------------------------
725C M o d u l e s
726C-----------------------------------------------
727 USE tri7box
728C-----------------------------------------------
729C I m p l i c i t T y p e s
730C-----------------------------------------------
731#include "implicit_f.inc"
732C-----------------------------------------------
733C D u m m y A r g u m e n t s
734C-----------------------------------------------
735 INTEGER JLT,NSN,NIN
736 INTEGER CAND_N(*),SUBTRIA_OLD(*),IRTLM(2,*)
737C REAL
738C-----------------------------------------------
739C L o c a l V a r i a b l e s
740C-----------------------------------------------
741 INTEGER I,NS,NE,ITQ
742C----------------------------------------------------
743 DO i = 1 ,jlt
744 ns=cand_n(i)
745 IF(ns <= nsn)THEN
746 subtria_old(i)=irtlm(2,ns)
747 ELSE
748 subtria_old(i)=irtlm_fi(nin)%P(2,ns-nsn)
749 ENDIF
750 ENDDO
751C
752 RETURN
tri7box::irtlm_fi
type(int_pointer2), dimension(:), allocatable irtlm_fi
Definition tri7box.F:533

◆ impl_sav1()

subroutine impl_sav1 ( integer jlt,
integer, dimension(*) cand_n,
integer, dimension(*) cand_e,
integer, dimension(2,*) irtlm,
stif,
pene,
integer, dimension(*) subtria,
integer, dimension(*) ns_imp,
integer, dimension(*) ne_imp,
integer, dimension(*) ind_imp,
integer ii_stok,
n1,
n2,
n3,
h1,
h2,
h3,
h4,
nj_imp,
hj_imp,
stif_imp,
integer nin,
integer nsn )

Definition at line 794 of file i24main.F.

800C-----------------------------------------------
801C M o d u l e s
802C-----------------------------------------------
803 USE tri7box
804C-----------------------------------------------
805C I m p l i c i t T y p e s
806C-----------------------------------------------
807#include "implicit_f.inc"
808#include "comlock.inc"
809C-----------------------------------------------
810C C o m m o n B l o c k s
811C-----------------------------------------------
812#include "com08_c.inc"
813C-----------------------------------------------
814C D u m m y A r g u m e n t s
815C-----------------------------------------------
816 INTEGER JLT,II_STOK,NIN ,NSN
817 INTEGER NUM_IMP,NS_IMP(*),NE_IMP(*),IND_IMP(*),
818 . CAND_E(*),CAND_N(*),SUBTRIA(*),IRTLM(2,*)
819C REAL
820 my_real
821 . stif(*), pene(*),n1(*),n2(*),n3(*),h1(*),h2(*),h3(*),
822 . h4(*),stif_imp(*), nj_imp(3,*),hj_imp(4,*)
823C-----------------------------------------------
824C L o c a l V a r i a b l e s
825C-----------------------------------------------
826 INTEGER I,NS,NE,ITQ,NEG,J,K_STOK,J_STOK,IC(4,4)
827 DATA ic /
828 1 3, 4, 1, 2,
829 2 4, 1, 2, 3,
830 3 1, 2, 3, 4,
831 4 2, 3, 4, 1/
832C----------------------------------------------------
833 k_stok = 0
834 DO i=1,jlt
835 IF(pene(i)/=zero.AND.stif(i)/=zero) k_stok = k_stok + 1
836 ENDDO
837 IF(k_stok==0)RETURN
838C
839#include "lockon.inc"
840 j_stok = ii_stok
841 ii_stok = j_stok + k_stok
842#include "lockoff.inc"
843 DO i = 1 ,jlt
844 IF(pene(i)/=zero.AND.stif(i)/=zero)THEN
845 j_stok = j_stok + 1
846 ns=cand_n(i)
847 ne=cand_e(i)
848 itq=subtria(i)
849C---------due tiny penetration removed to Engine---
850 IF (tt==zero.AND.itq==0) itq=1
851C----sliding on the neibour : to verify if necessary
852 IF (itq>4) ne = -cand_e(i)
853 ns_imp(j_stok)=ns
854 ne_imp(j_stok)=ne
855 ind_imp(j_stok)=itq
856 nj_imp(1,j_stok) = n1(i)
857 nj_imp(2,j_stok) = n2(i)
858 nj_imp(3,j_stok) = n3(i)
859 stif_imp(j_stok) =stif(i)
860C-------order of HJ should be consisting w/ IXj------
861 IF (itq>4) THEN
862 hj_imp(1,j_stok) = h1(i)
863 hj_imp(2,j_stok) = h2(i)
864 hj_imp(3,j_stok) = h3(i)
865 hj_imp(4,j_stok) = h4(i)
866 ELSE
867 hj_imp(ic(1,itq),j_stok) = h1(i)
868 hj_imp(ic(2,itq),j_stok) = h2(i)
869 hj_imp(ic(3,itq),j_stok) = h3(i)
870 hj_imp(ic(4,itq),j_stok) = h4(i)
871 ENDIF
872 END IF
873 ENDDO
874C
875 RETURN