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 (output, 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 760 of file i24main.F.

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

◆ i24mainf()

subroutine i24mainf ( type(output_), intent(inout) output,
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 )
Parameters
[in,out]outputoutput structure

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

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

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

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