OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
i24ke3.F File Reference
#include "implicit_f.inc"
#include "mvsiz_p.inc"
#include "com01_c.inc"
#include "com04_c.inc"
#include "com08_c.inc"
#include "param_c.inc"
#include "impl2_c.inc"
#include "impl1_c.inc"
#include "scr05_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine i24ke3 (a, v, ms, ipari, intbuf_tab, x, nin, iddl, k_diag, k_lt, iadk, jdik, gap_imp, lrem, intbuf_tab_imp)
subroutine i24keg3 (jlt, a, v, ms, fric, ix1, ix2, ix3, ix4, nsvg, stif, vxi, vyi, vzi, msi, n1, n2, n3, h1, h2, h3, h4, pene, stiglo, x, ki11, ki12, kj11, kj12, kk11, kk12, kl11, kl12, off, scalk, nin, lrem, stif_old, cand_n, igsti, pene_old, nm1, nm2, nm3)
subroutine i24kgeo3 (jlt, ix1, ix2, ix3, ix4, nsvg, stif, h1, h2, h3, h4, pene, stiglo, ki11, ki12, kj11, kj12, kk11, kk12, kl11, kl12, scalk, ll_s, ll_m, tag_s, tag_m, nsn)

Function/Subroutine Documentation

◆ i24ke3()

subroutine i24ke3 ( a,
v,
ms,
integer, dimension(npari,ninter) ipari,
type(intbuf_struct_) intbuf_tab,
x,
integer nin,
integer, dimension(*) iddl,
k_diag,
k_lt,
integer, dimension(*) iadk,
integer, dimension(*) jdik,
gap_imp,
integer lrem,
type(imp_intbuf_struct_) intbuf_tab_imp )

Definition at line 38 of file i24ke3.F.

42C-----------------------------------------------
43C M o d u l e s
44C-----------------------------------------------
45 USE intbufdef_mod
46 USE imp_intbufdef
47C-----------------------------------------------
48C I m p l i c i t T y p e s
49C-----------------------------------------------
50#include "implicit_f.inc"
51C-----------------------------------------------
52C G l o b a l P a r a m e t e r s
53C-----------------------------------------------
54#include "mvsiz_p.inc"
55C-----------------------------------------------
56C C o m m o n B l o c k s
57C-----------------------------------------------
58#include "com01_c.inc"
59#include "com04_c.inc"
60#include "com08_c.inc"
61#include "param_c.inc"
62#include "impl2_c.inc"
63#include "impl1_c.inc"
64C-----------------------------------------------
65C D u m m y A r g u m e n t s
66C-----------------------------------------------
67 INTEGER IPARI(NPARI,NINTER)
68 INTEGER NIN,IDDL(*),IADK(*) ,JDIK(*),LREM
69C REAL
70 my_real
71 . a(3,*), ms(*), v(3,*),x(*),k_diag(*),k_lt(*)
72 my_real
73 . gap_imp
74C REAL
75
76 TYPE(INTBUF_STRUCT_) INTBUF_TAB
77 TYPE(IMP_INTBUF_STRUCT_) INTBUF_TAB_IMP
78C-----------------------------------------------
79C L o c a l V a r i a b l e s
80C-----------------------------------------------
81 INTEGER I, J,I_STOK, JLT_NEW, JLT , NFT, IVIS2,
82 . IBC, NOINT, NSEG, ISECIN, IBAG, IADM,
83 . IGAP, INACTI, IFQ, MFROT, IGSTI, NISUB,
84 . NB_LOC, I_STOK_LOC,DEBUT,
85 . ILAGM, LENR, LENT, MAXCC,INTTH,IFORM,INTKG,
86 . IDNJ,IDHJ
87 INTEGER IX1(MVSIZ), IX2(MVSIZ), IX3(MVSIZ), IX4(MVSIZ),
88 . NSVG(MVSIZ),KINI(MVSIZ),IXX(MVSIZ,13),ITRIV(4,MVSIZ)
89C REAL
90 my_real
91 . startt, fric, gap, stopt,
92 . visc,viscf,stiglo,gapmin,
93 . kmin, kmax, gapmax,rstif,fheat,tint,rhoh,eps
94C-----------------------------------------------
95C REAL
96 my_real
97 . nx1(mvsiz), nx2(mvsiz), nx3(mvsiz), nx4(mvsiz),
98 . ny1(mvsiz), ny2(mvsiz), ny3(mvsiz), ny4(mvsiz),
99 . nz1(mvsiz), nz2(mvsiz), nz3(mvsiz), nz4(mvsiz),
100 . subtria(mvsiz),
101 . x1(mvsiz), x2(mvsiz), x3(mvsiz), x4(mvsiz),
102 . y1(mvsiz), y2(mvsiz), y3(mvsiz), y4(mvsiz),
103 . z1(mvsiz), z2(mvsiz), z3(mvsiz), z4(mvsiz),
104 . xi(mvsiz), yi(mvsiz), zi(mvsiz), stif(mvsiz),
105 . vx1(mvsiz), vx2(mvsiz), vx3(mvsiz), vx4(mvsiz),
106 . vy1(mvsiz), vy2(mvsiz), vy3(mvsiz), vy4(mvsiz),
107 . vz1(mvsiz), vz2(mvsiz), vz3(mvsiz), vz4(mvsiz),
108 . vxi(mvsiz), vyi(mvsiz), vzi(mvsiz),
109 . n1(mvsiz), n2(mvsiz), n3(mvsiz), pene(mvsiz),
110 . h1(mvsiz), h2(mvsiz), h3(mvsiz), h4(mvsiz),
111 . nm1(mvsiz), nm2(mvsiz), nm3(mvsiz),
112 . gapv(mvsiz),msi(mvsiz),gaps(mvsiz),
113 . ki11(9,mvsiz),kj11(9,mvsiz),off(mvsiz),
114 . kk11(9,mvsiz),kl11(9,mvsiz),ki12(9,mvsiz),
115 . kj12(9,mvsiz),kk12(9,mvsiz),kl12(9,mvsiz),
116 . ll_sl(mvsiz),ll_ml(mvsiz)
117 INTEGER NRTMFT, NRTMLT, NMNFT, NMNLT, NRADM
118 INTEGER ICURV,INTKG1
119 INTEGER, DIMENSION(:),ALLOCATABLE :: TAG_S,TAG_M
120 INTEGER :: NSN, NMN
121C----------------------------------------------------
122C Calcul des adresses des buffers d'interfaces.
123C Les adresses des buffers J10-JFI et K10-KFI
124C sont remplaces systematiquement par des tableaux
125C JD(i) et KD(i), en gardant les memes numeros d'indexes.
126C Les anciens adresses directs Jn, Kn sont modifies
127C dans la routine sans commentaires additionnels habituels
128C----------------------------------------------------
129C
130 nsn =ipari(5,nin)
131 nmn = ipari(6,nin)
132 IF(ipari(33,nin)==1) RETURN
133 noint =ipari(15,nin)
134 igap =ipari(21,nin)
135 mfrot =ipari(30,nin)
136 ifq =ipari(31,nin)
137 ibag =ipari(32,nin)
138 igsti=ipari(34,nin)
139 nisub =ipari(36,nin)
140 icurv =ipari(39,nin)
141 intkg =ipari(65,nin)
142C adaptive meshing
143C IADM =IPARI(44,NIN)
144C NRADM=IPARI(49,NIN)
145C PADM =INTBUF_TAB%VARIABLES(24)
146C ANGLT=INTBUF_TAB%VARIABLES(25)
147C heat interface
148 intth = ipari(47,nin)
149 iform = ipari(48,nin)
150C
151 stiglo=-intbuf_tab%STFAC(1)
152 startt=intbuf_tab%VARIABLES(3)
153 stopt =intbuf_tab%VARIABLES(11)
154 IF(startt>tt) RETURN
155 IF(tt>stopt) RETURN
156C
157 fric =intbuf_tab%VARIABLES(1)
158 gap =intbuf_tab%VARIABLES(2)
159 gapmin=intbuf_tab%VARIABLES(13)
160 visc =intbuf_tab%VARIABLES(14)
161 viscf =intbuf_tab%VARIABLES(15)
162C
163 gapmax=intbuf_tab%VARIABLES(16)
164 kmin =intbuf_tab%VARIABLES(17)
165 kmax =intbuf_tab%VARIABLES(18)
166C
167 rstif = intbuf_tab%VARIABLES(20)
168 fheat = intbuf_tab%VARIABLES(21)
169 tint = intbuf_tab%VARIABLES(22)
170 eps = intbuf_tab%VARIABLES(39)
171C
172c----------------------------------------------------
173c Courbure quadratique calcul des normales nodales
174c----------------------------------------------------
175 IF(icurv==3)THEN
176 endif!(ICURV==3)
177c----------------------------------------------------
178c Rayon de courbure : calcul des normales nodales (normees)
179C IADM!=0 + Icurv!=0 non available (starter error).
180c----------------------------------------------------
181c IF(IADM/=0)THEN
182c END IF!(IADM/=0)
183C----------------------------------------------------
184c------------------------------------------------
185 i_stok = intbuf_tab_imp%I_STOK(1)
186 IF(i_stok== 0) RETURN
187C-----------in SPMD, should do the comm or simplifying the values--
188 intkg1 = 0
189 IF (intkg>0.AND.iikgoff/=1) intkg1=1
190 IF(intkg1 > 0) THEN
191 ALLOCATE(tag_s(numnod),tag_m(numnod))
192 tag_s =0
193 tag_m =0
194 DO i=1,nsn
195 j=intbuf_tab%NSV(i)
196 tag_s(j) =i
197 END DO
198 DO i=1,nmn
199 j=intbuf_tab%MSR(i)
200 tag_m(j) =i
201 END DO
202 END IF !(INTKG1 > 0) THEN
203C------------multi-contact spmd
204 CALL ffizero(i_stok ,nin ,nsn ,intbuf_tab_imp%CAND_N )
205C
206 DO nft = 0 , i_stok - 1 , nvsiz
207 jlt = min( nvsiz, i_stok - nft )
208 idnj = 3*nft + 1
209 idhj = 4*nft + 1
210 CALL i24corkm(
211 1 jlt ,x ,intbuf_tab%IRECTM,intbuf_tab%NSV,
212 + intbuf_tab_imp%CAND_E(nft+1) ,intbuf_tab_imp%CAND_N(nft+1),
213 2 stif ,intbuf_tab_imp%STIF(nft+1),
214 + xi ,yi ,zi ,
215 3 vxi ,vyi ,vzi ,ix1 ,
216 4 ix2 ,ix3 ,ix4 ,nsvg ,intbuf_tab%NVOISIN,
217 5 ms ,msi ,nsn ,v ,nin ,
218 6 n1 ,n2 ,n3 ,h1 ,h2 ,
219 7 h3 ,h4 ,intbuf_tab_imp%NJ(idnj),intbuf_tab_imp%HJ(idhj),
220 8 intbuf_tab_imp%INDSUBT(nft+1))
221 CALL i24keg3(jlt ,a ,v ,ms ,fric ,
222 1 ix1 ,ix2 ,ix3 ,ix4 ,nsvg ,
223 2 stif ,vxi ,vyi ,vzi ,msi ,
224 5 n1 ,n2 ,n3 ,h1 ,h2 ,
225 6 h3 ,h4 ,pene ,stiglo,x ,
226 3 ki11 ,ki12 ,kj11 ,kj12 ,kk11 ,
227 4 kk12 ,kl11 ,kl12 ,off ,sk_int,
228 5 nin ,lrem ,intbuf_tab%STIF_OLD ,
229 + intbuf_tab_imp%CAND_N(nft+1),
230 6 igsti ,intbuf_tab%PENE_OLD,nm1 ,nm2 ,
231 7 nm3 )
232 IF(intkg1 > 0) THEN
233 CALL i24kgeo3(jlt ,ix1 ,ix2 ,ix3 ,ix4 ,
234 1 nsvg ,stif ,h1 ,h2 ,h3 ,
235 2 h4 ,pene ,stiglo ,ki11 ,ki12 ,
236 3 kj11 ,kj12 ,kk11 ,kk12 ,kl11 ,
237 4 kl12 ,sk_int ,intbuf_tab%NOD_2RY_LGTH,
238 . intbuf_tab%NOD_MAS_LGTH,
239 5 tag_s ,tag_m ,nsn )
240 DEALLOCATE(tag_s,tag_m)
241 END IF
242
243 IF (nspmd > 1) THEN
244 lrem = lrem + jlt
245 CALL ass_spmd(3 ,nsvg ,ix1 ,ix2 ,ix3 ,
246 1 ix4 ,jlt ,iddl ,k_diag ,k_lt ,
247 2 iadk ,jdik ,ki11 ,ki12 ,kj11 ,
248 3 kj12 ,kk11 ,kk12 ,kl11 ,kl12 ,
249 4 off ,nin )
250 lrem = lrem - jlt
251 ENDIF
252C
253 CALL assem_int(3 ,nsvg ,ix1 ,ix2 ,ix3 ,
254 1 ix4 ,jlt ,iddl ,k_diag ,k_lt ,
255 2 iadk ,jdik ,ki11 ,ki12 ,kj11 ,
256 3 kj12 ,kk11 ,kk12 ,kl11 ,kl12 ,
257 4 off )
258 ENDDO
259
260 intbuf_tab_imp%I_STOK(1) = 0
261C
262 RETURN
ass_spmd
subroutine ass_spmd(nd, ns, n1, n2, n3, n4, nel, iddl, k_diag, k_lt, iadk, jdik, ki11, ki12, kj11, kj12, kk11, kk12, kl11, kl12, off, nin)
Definition assem_int.F:98
assem_int
subroutine assem_int(nd, ns, n1, n2, n3, n4, nel, iddl, k_diag, k_lt, iadk, jdik, ki11, ki12, kj11, kj12, kk11, kk12, kl11, kl12, off)
Definition assem_int.F:39
my_real
#define my_real
Definition cppsort.cpp:32
i24corkm
subroutine i24corkm(jlt, x, irect, nsv, cand_e, cand_n, stif, stif_imp, xi, yi, zi, vxi, vyi, vzi, ix1, ix2, ix3, ix4, nsvg, nvoisin, ms, msi, nsn, v, nin, n1, n2, n3, h1, h2, h3, h4, nj_imp, hj_imp, subtria)
Definition i24cork3.F:592
i24kgeo3
subroutine i24kgeo3(jlt, ix1, ix2, ix3, ix4, nsvg, stif, h1, h2, h3, h4, pene, stiglo, ki11, ki12, kj11, kj12, kk11, kk12, kl11, kl12, scalk, ll_s, ll_m, tag_s, tag_m, nsn)
Definition i24ke3.F:564
i24keg3
subroutine i24keg3(jlt, a, v, ms, fric, ix1, ix2, ix3, ix4, nsvg, stif, vxi, vyi, vzi, msi, n1, n2, n3, h1, h2, h3, h4, pene, stiglo, x, ki11, ki12, kj11, kj12, kk11, kk12, kl11, kl12, off, scalk, nin, lrem, stif_old, cand_n, igsti, pene_old, nm1, nm2, nm3)
Definition i24ke3.F:281
ffizero
subroutine ffizero(jlt, nin, nsn, cand_n)
Definition i7ke3.F:756
min
#define min(a, b)
Definition macros.h:20

◆ i24keg3()

subroutine i24keg3 ( integer jlt,
a,
v,
ms,
fric,
integer, dimension(mvsiz) ix1,
integer, dimension(mvsiz) ix2,
integer, dimension(mvsiz) ix3,
integer, dimension(mvsiz) ix4,
integer, dimension(mvsiz) nsvg,
stif,
vxi,
vyi,
vzi,
msi,
n1,
n2,
n3,
h1,
h2,
h3,
h4,
pene,
stiglo,
x,
ki11,
ki12,
kj11,
kj12,
kk11,
kk12,
kl11,
kl12,
off,
scalk,
integer nin,
integer lrem,
stif_old,
integer, dimension(*) cand_n,
integer igsti,
pene_old,
nm1,
nm2,
nm3 )

Definition at line 272 of file i24ke3.F.

281C-----------------------------------------------
282C M o d u l e s
283C-----------------------------------------------
284 USE imp_intm
285 USE tri7box
286C-----------------------------------------------
287C I m p l i c i t T y p e s
288C-----------------------------------------------
289#include "implicit_f.inc"
290C-----------------------------------------------
291C G l o b a l P a r a m e t e r s
292C-----------------------------------------------
293#include "mvsiz_p.inc"
294C-----------------------------------------------
295C C o m m o n B l o c k s
296C-----------------------------------------------
297#include "scr05_c.inc"
298#include "com01_c.inc"
299#include "impl1_c.inc"
300C-----------------------------------------------
301C D u m m y A r g u m e n t s
302C-----------------------------------------------
303 INTEGER JLT, LREM,NIN,CAND_N(*),IGSTI
304 INTEGER IX1(MVSIZ), IX2(MVSIZ), IX3(MVSIZ), IX4(MVSIZ),
305 . NSVG(MVSIZ)
306 my_real
307 . a(3,*), ms(*), v(3,*),x(3,*),
308 . stiglo,fric,off(*),scalk,
309 . vxi(mvsiz),vyi(mvsiz),vzi(mvsiz),msi(mvsiz)
310 my_real
311 . n1(mvsiz), n2(mvsiz), n3(mvsiz), pene(mvsiz),
312 . h1(mvsiz), h2(mvsiz), h3(mvsiz), h4(mvsiz),
313 . nm1(mvsiz), nm2(mvsiz), nm3(mvsiz),
314 . stif(mvsiz),pene_old(5,*),stif_old(2,*),
315 . ki11(3,3,mvsiz),kj11(3,3,mvsiz),
316 . kk11(3,3,mvsiz),kl11(3,3,mvsiz),ki12(3,3,mvsiz),
317 . kj12(3,3,mvsiz),kk12(3,3,mvsiz),kl12(3,3,mvsiz)
318C-----------------------------------------------
319C L o c a l V a r i a b l e s
320C-----------------------------------------------
321 INTEGER I, J1, J, K,IG,ISF,NN,NS,JLTF,NE,JG,N,ip
322 my_real
323 . vx(mvsiz), vy(mvsiz), vz(mvsiz), vn(mvsiz),
324 . s2,fac,facf, h0, la1, la2, la3, la4,fact(mvsiz),
325 . d1,d2,d3,d4,a1,a2,a3,a4,kn(4,mvsiz),q(3,3,mvsiz)
326 my_real
327 . prec,q11,q12,q13,q22,q23,q33,h00,vtx,vty,vtz,vt,
328 . kt1,kt2,kt3,kt4,q1,q2,dpene(mvsiz),vnm(mvsiz)
329 INTEGER NA1,NA2
330 my_real
331 . a0x,a0y,a0z,rx,ry,rz,
332 . anx,any,anz,aan,aax,aay,aaz ,rr,rs,aaa ,tm,ts
333C-----------------------------------------------
334 IF (iresp==1) THEN
335 prec = fiveem4
336 ELSE
337 prec = em10
338 ENDIF
339C---------------------
340C COURBURE FIXE
341C---------------------
342C IF(ICURV(1)==1)THEN
343C ELSEIF(ICURV(1)==2)THEN
344C ELSEIF(ICURV(1) == 3)THEN
345C ENDIF
346 DO i=1,jlt
347 vx(i) = vxi(i) - h1(i)*v(1,ix1(i)) - h2(i)*v(1,ix2(i))
348 . - h3(i)*v(1,ix3(i)) - h4(i)*v(1,ix4(i))
349 vy(i) = vyi(i) - h1(i)*v(2,ix1(i)) - h2(i)*v(2,ix2(i))
350 . - h3(i)*v(2,ix3(i)) - h4(i)*v(2,ix4(i))
351 vz(i) = vzi(i) - h1(i)*v(3,ix1(i)) - h2(i)*v(3,ix2(i))
352 . - h3(i)*v(3,ix3(i)) - h4(i)*v(3,ix4(i))
353 vn(i) = n1(i)*vx(i) + n2(i)*vy(i) + n3(i)*vz(i)
354c VNM(I) = NM1(I)*VX(I) + NM2(I)*VY(I) + NM3(I)*VZ(I)
355 ENDDO
356C---------------------
357C PENE INITIALE
358C---------------------
359 ip=0
360 IF (igsti==6) THEN
361 IF (inconv < 0) THEN
362 DO i=1,jlt
363 jg = nsvg(i)
364 n = cand_n(i)
365 IF(jg > 0)THEN
366 stif(i) = stif_old(1,n)
367 ELSE
368 stif(i) = stif_oldfi(nin)%P(1,-jg)
369 END IF
370 END DO
371 END IF !(INCONV < 0 THEN
372 END IF !(IGSTI==6) THEN
373C---------------------------------
374C ----sans frottement d'abord---
375 DO i=1,jlt
376 vtx = vx(i) -vn(i)*n1(i)
377 vty = vy(i) -vn(i)*n2(i)
378 vtz = vz(i) -vn(i)*n3(i)
379 vt = vtx*vtx+vty*vty+vtz*vtz
380 IF (vt>em20) THEN
381 s2=one/sqrt(vt)
382 q(1,1,i)=vtx*s2
383 q(1,2,i)=vty*s2
384 q(1,3,i)=vtz*s2
385 q(3,1,i)=n1(i)
386 q(3,2,i)=n2(i)
387 q(3,3,i)=n3(i)
388 q(2,1,i)=q(3,2,i)*q(1,3,i)-q(3,3,i)*q(1,2,i)
389 q(2,2,i)=q(3,3,i)*q(1,1,i)-q(3,1,i)*q(1,3,i)
390 q(2,3,i)=q(3,1,i)*q(1,2,i)-q(3,2,i)*q(1,1,i)
391 fact(i)=fric
392 ELSE
393 fact(i)=zero
394 ENDIF
395 ENDDO
396 IF (scalk<0) THEN
397 isf=1
398 ELSE
399 isf=0
400 ENDIF
401 facf=abs(scalk)
402 IF (isf==1) THEN
403 DO i=1,jlt
404 IF (vn(i)>zero) THEN
405 fac=stif(i)/facf
406 ELSEIF (vn(i)<zero) THEN
407 fac=stif(i)*facf
408 ELSE
409 fac=stif(i)
410 ENDIF
411 kn(1,i)=fac*h1(i)
412 kn(2,i)=fac*h2(i)
413 kn(3,i)=fac*h3(i)
414 kn(4,i)=fac*h4(i)
415 fact(i)=fac*fact(i)
416 ENDDO
417 ELSE
418 DO i=1,jlt
419 fac=stif(i)*facf
420 kn(1,i)=fac*h1(i)
421 kn(2,i)=fac*h2(i)
422 kn(3,i)=fac*h3(i)
423 kn(4,i)=fac*h4(i)
424 fact(i)=fac*fact(i)
425 ENDDO
426 ENDIF
427 DO i=1,jlt
428 q11=n1(i)*n1(i)
429 q12=n1(i)*n2(i)
430 q13=n1(i)*n3(i)
431 q22=n2(i)*n2(i)
432 q23=n2(i)*n3(i)
433 q33=n3(i)*n3(i)
434 ki11(1,1,i)=kn(1,i)*q11
435 ki11(1,2,i)=kn(1,i)*q12
436 ki11(1,3,i)=kn(1,i)*q13
437 ki11(2,2,i)=kn(1,i)*q22
438 ki11(2,3,i)=kn(1,i)*q23
439 ki11(3,3,i)=kn(1,i)*q33
440 kj11(1,1,i)=kn(2,i)*q11
441 kj11(1,2,i)=kn(2,i)*q12
442 kj11(1,3,i)=kn(2,i)*q13
443 kj11(2,2,i)=kn(2,i)*q22
444 kj11(2,3,i)=kn(2,i)*q23
445 kj11(3,3,i)=kn(2,i)*q33
446 kk11(1,1,i)=kn(3,i)*q11
447 kk11(1,2,i)=kn(3,i)*q12
448 kk11(1,3,i)=kn(3,i)*q13
449 kk11(2,2,i)=kn(3,i)*q22
450 kk11(2,3,i)=kn(3,i)*q23
451 kk11(3,3,i)=kn(3,i)*q33
452 kl11(1,1,i)=kn(4,i)*q11
453 kl11(1,2,i)=kn(4,i)*q12
454 kl11(1,3,i)=kn(4,i)*q13
455 kl11(2,2,i)=kn(4,i)*q22
456 kl11(2,3,i)=kn(4,i)*q23
457 kl11(3,3,i)=kn(4,i)*q33
458 ENDDO
459C ----avec frottement ---
460 DO j=1,3
461 DO k=j,3
462 DO i=1,jlt
463 IF (fact(i)>zero) THEN
464 q1 =q(1,j,i)*q(1,k,i)
465 q2 =q(2,j,i)*q(2,k,i)
466 fac=fact(i)*(q1+q2)
467 kt1=fac*h1(i)
468 ki11(j,k,i)=ki11(j,k,i)+kt1
469 kt2=fac*h2(i)
470 kj11(j,k,i)=kj11(j,k,i)+kt2
471 kt3=fac*h3(i)
472 kk11(j,k,i)=kk11(j,k,i)+kt3
473 kt4=fac*h4(i)
474 kl11(j,k,i)=kl11(j,k,i)+kt4
475 ENDIF
476 ENDDO
477 ENDDO
478 ENDDO
479C
480 DO j=1,3
481 DO k=j,3
482 DO i=1,jlt
483 ki12(j,k,i)=-ki11(j,k,i)
484 kj12(j,k,i)=-kj11(j,k,i)
485 kk12(j,k,i)=-kk11(j,k,i)
486 kl12(j,k,i)=-kl11(j,k,i)
487 ENDDO
488 ENDDO
489 ENDDO
490 DO j=1,3
491 DO k=j+1,3
492 DO i=1,jlt
493 ki12(k,j,i)=-ki11(j,k,i)
494 kj12(k,j,i)=-kj11(j,k,i)
495 kk12(k,j,i)=-kk11(j,k,i)
496 kl12(k,j,i)=-kl11(j,k,i)
497 ENDDO
498 ENDDO
499 ENDDO
500C
501 DO i=1,jlt
502 off(i)=one
503 ENDDO
504C
505 IF (nspmd > 1) THEN
506C
507 IF (intp_d>0) THEN
508 DO i=1,jlt
509 IF(nsvg(i)<0) THEN
510 nn=-nsvg(i)
511 ns=ind_int(nin)%P(nn)
512C---------pour diag_ss---
513 ffi(1,ns)=zero
514 ffi(2,ns)=zero
515 ffi(3,ns)=zero
516 dfi(1,ns)=zero
517 dfi(2,ns)=zero
518 dfi(3,ns)=zero
519 ENDIF
520 ENDDO
521 ELSE
522C--- general case----
523 jltf = 0
524 DO i=1,jlt
525 IF(nsvg(i)<0) THEN
526 nn=-nsvg(i)
527 jltf = jltf + 1
528 ne=shf_int(nin) + jltf +lrem
529 ns=ind_int(nin)%P(nn)
530 stifs(ne)=stif(i)
531 h_e(1,ne)=h1(i)
532 h_e(2,ne)=h2(i)
533 h_e(3,ne)=h3(i)
534 h_e(4,ne)=h4(i)
535 n_e(1,ne)=n1(i)
536 n_e(2,ne)=n2(i)
537 n_e(3,ne)=n3(i)
538C----pour temporairement diag_ss---
539 ffi(1,ns)=zero
540 ffi(2,ns)=zero
541 ffi(3,ns)=zero
542 dfi(1,ns)=zero
543 dfi(2,ns)=zero
544 dfi(3,ns)=zero
545 ENDIF
546 ENDDO
547C
548 END IF !IF (INTP_D>0)
549 END IF
550C
551 RETURN
imp_intm
Definition imp_intm.F:118
imp_intm::shf_int
integer, dimension(:), allocatable shf_int
Definition imp_intm.F:136
imp_intm::intp_d
integer intp_d
Definition imp_intm.F:173
imp_intm::ind_int
type(int_pointer2), dimension(:), allocatable ind_int
Definition imp_intm.F:133
tri7box::stif_oldfi
type(real_pointer2), dimension(:), allocatable stif_oldfi
Definition tri7box.F:545

◆ i24kgeo3()

subroutine i24kgeo3 ( integer jlt,
integer, dimension(mvsiz) ix1,
integer, dimension(mvsiz) ix2,
integer, dimension(mvsiz) ix3,
integer, dimension(mvsiz) ix4,
integer, dimension(mvsiz) nsvg,
stif,
h1,
h2,
h3,
h4,
pene,
stiglo,
ki11,
ki12,
kj11,
kj12,
kk11,
kk12,
kl11,
kl12,
scalk,
ll_s,
ll_m,
integer, dimension(*) tag_s,
integer, dimension(*) tag_m,
integer nsn )

Definition at line 558 of file i24ke3.F.

564C-----------------------------------------------
565C I m p l i c i t T y p e s
566C-----------------------------------------------
567#include "implicit_f.inc"
568C-----------------------------------------------
569C G l o b a l P a r a m e t e r s
570C-----------------------------------------------
571#include "mvsiz_p.inc"
572C-----------------------------------------------
573C D u m m y A r g u m e n t s
574C-----------------------------------------------
575 INTEGER JLT
576 INTEGER IX1(MVSIZ), IX2(MVSIZ), IX3(MVSIZ), IX4(MVSIZ),
577 . NSVG(MVSIZ),TAG_S(*),TAG_M(*),NSN
578 my_real
579 . stiglo,scalk
580 my_real
581 . pene(mvsiz),
582 . h1(mvsiz), h2(mvsiz), h3(mvsiz), h4(mvsiz),
583 . stif(mvsiz),ll_s(*) ,ll_m(*),
584 . ki11(3,3,mvsiz),kj11(3,3,mvsiz),
585 . kk11(3,3,mvsiz),kl11(3,3,mvsiz),ki12(3,3,mvsiz),
586 . kj12(3,3,mvsiz),kk12(3,3,mvsiz),kl12(3,3,mvsiz)
587C-----------------------------------------------
588C L o c a l V a r i a b l e s
589C-----------------------------------------------
590 INTEGER I, J1, J, K,IG,ISF,NN,NS,JLTF,NE,NM
591 my_real
592 . s2,fac,facf, h0, la1, la2, la3, la4,
593 . d1,d2,d3,d4,a1,a2,a3,a4,kn(4,mvsiz),lns,lns1
594 my_real
595 . lmax,fni(mvsiz),al(4,mvsiz)
596C-----------------------------------------------
597 IF (nsn == 0) RETURN
598 DO i=1,jlt
599 IF(stiglo<=zero)THEN
600 stif(i) = half*stif(i)
601 ELSEIF(stif(i)/=zero)THEN
602 stif(i) = stiglo
603 ENDIF
604 fni(i)= -stif(i) * pene(i)
605 ENDDO
606C---------------------------------
607 lns1=half*(ll_s(1)+ll_s(nsn))
608 DO i=1,jlt
609 ns=nsvg(i)
610C-------in spmd LNS is simplified
611 IF (ns < 0) THEN
612 lns=lns1
613 ELSE
614 lns=ll_s(tag_s(ns))
615 END IF
616 nm=ix1(i)
617 al(1,i)=lns+ll_m(tag_m(nm))
618 nm=ix2(i)
619 al(2,i)=lns+ll_m(tag_m(nm))
620 nm=ix3(i)
621 al(3,i)=lns+ll_m(tag_m(nm))
622 nm=ix4(i)
623 al(4,i)=lns+ll_m(tag_m(nm))
624 lmax=onep01*pene(i)
625 DO j=1,4
626 al(j,i)=max(lmax,al(j,i))
627 END DO
628 ENDDO
629 facf=abs(scalk)
630 DO i=1,jlt
631 fac = facf*fni(i)
632 kn(1,i)=fac*h1(i)/al(1,i)
633 kn(2,i)=fac*h2(i)/al(2,i)
634 kn(3,i)=fac*h3(i)/al(3,i)
635 kn(4,i)=fac*h4(i)/al(4,i)
636c print *,'FACF,FNI(I),KN(1,I)=',FACF,FNI(I),KN(1,I)
637 ENDDO
638C
639 DO j=1,3
640 DO i=1,jlt
641 ki11(j,j,i) = ki11(j,j,i)+kn(1,i)
642 ki12(j,j,i) = ki12(j,j,i)-kn(1,i)
643 kj11(j,j,i) = kj11(j,j,i)+kn(2,i)
644 kj12(j,j,i) = kj12(j,j,i)-kn(2,i)
645 kk11(j,j,i) = kk11(j,j,i)+kn(3,i)
646 kk12(j,j,i) = kk12(j,j,i)-kn(3,i)
647 kl11(j,j,i) = kl11(j,j,i)+kn(4,i)
648 kl12(j,j,i) = kl12(j,j,i)-kn(4,i)
649 ENDDO
650 ENDDO
651C
652 RETURN
max
#define max(a, b)
Definition macros.h:21