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"

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, NFT,
82 . NOINT, IBAG,
83 . IGAP, IFQ, MFROT, IGSTI, NISUB,
84 . INTTH,IFORM,INTKG,
85 . IDNJ,IDHJ
86 INTEGER IX1(MVSIZ), IX2(MVSIZ), IX3(MVSIZ), IX4(MVSIZ),
87 . NSVG(MVSIZ)
88C REAL
89 my_real
90 . startt, fric, gap, stopt,
91 . visc,viscf,stiglo,gapmin,
92 . kmin, kmax, gapmax,rstif,fheat,tint,eps
93C-----------------------------------------------
94C REAL
95 my_real
96 . xi(mvsiz), yi(mvsiz), zi(mvsiz), stif(mvsiz),
97 . vxi(mvsiz), vyi(mvsiz), vzi(mvsiz),
98 . n1(mvsiz), n2(mvsiz), n3(mvsiz), pene(mvsiz),
99 . h1(mvsiz), h2(mvsiz), h3(mvsiz), h4(mvsiz),
100 . nm1(mvsiz), nm2(mvsiz), nm3(mvsiz),
101 . msi(mvsiz),
102 . ki11(9,mvsiz),kj11(9,mvsiz),off(mvsiz),
103 . kk11(9,mvsiz),kl11(9,mvsiz),ki12(9,mvsiz),
104 . kj12(9,mvsiz),kk12(9,mvsiz),kl12(9,mvsiz)
105
106 INTEGER ICURV,INTKG1
107 INTEGER, DIMENSION(:),ALLOCATABLE :: TAG_S,TAG_M
108 INTEGER :: NSN, NMN
109C----------------------------------------------------
110C calculation of interface buffer addresses
111C the addresses of the j10-jfi and k10-kfi buffers
112C are systematically replaced by arrays
113C JD(i) et KD(i), en gardant les memes numeros d'indexes.
114C the old direct addresses jn, kn are modified
115C in the routine without the usual additional comments
116C----------------------------------------------------
117C
118 nsn =ipari(5,nin)
119 nmn = ipari(6,nin)
120 IF(ipari(33,nin)==1) RETURN
121 noint =ipari(15,nin)
122 igap =ipari(21,nin)
123 mfrot =ipari(30,nin)
124 ifq =ipari(31,nin)
125 ibag =ipari(32,nin)
126 igsti=ipari(34,nin)
127 nisub =ipari(36,nin)
128 icurv =ipari(39,nin)
129 intkg =ipari(65,nin)
130C adaptive meshing
131C IADM =IPARI(44,NIN)
132C NRADM=IPARI(49,NIN)
133C PADM =INTBUF_TAB%VARIABLES(24)
134C ANGLT=INTBUF_TAB%VARIABLES(25)
135C heat interface
136 intth = ipari(47,nin)
137 iform = ipari(48,nin)
138C
139 stiglo=-intbuf_tab%STFAC(1)
140 startt=intbuf_tab%VARIABLES(3)
141 stopt =intbuf_tab%VARIABLES(11)
142 IF(startt>tt) RETURN
143 IF(tt>stopt) RETURN
144C
145 fric =intbuf_tab%VARIABLES(1)
146 gap =intbuf_tab%VARIABLES(2)
147 gapmin=intbuf_tab%VARIABLES(13)
148 visc =intbuf_tab%VARIABLES(14)
149 viscf =intbuf_tab%VARIABLES(15)
150C
151 gapmax=intbuf_tab%VARIABLES(16)
152 kmin =intbuf_tab%VARIABLES(17)
153 kmax =intbuf_tab%VARIABLES(18)
154C
155 rstif = intbuf_tab%VARIABLES(20)
156 fheat = intbuf_tab%VARIABLES(21)
157 tint = intbuf_tab%VARIABLES(22)
158 eps = intbuf_tab%VARIABLES(39)
159C
160c----------------------------------------------------
161c Quadratic curvature Calculation of nodal normal
162c----------------------------------------------------
163 IF(icurv==3)THEN
164 endif!(ICURV==3)
165c----------------------------------------------------
166c curvature radius: calculation of nodal normals (normalized)
167C IADM!=0 + Icurv!=0 non available (starter error).
168c----------------------------------------------------
169c IF(IADM/=0)THEN
170c END IF!(IADM/=0)
171C----------------------------------------------------
172c------------------------------------------------
173 i_stok = intbuf_tab_imp%I_STOK(1)
174 IF(i_stok== 0) RETURN
175C-----------in SPMD, should do the comm or simplifying the values--
176 intkg1 = 0
177 IF (intkg>0.AND.iikgoff/=1) intkg1=1
178 IF(intkg1 > 0) THEN
179 ALLOCATE(tag_s(numnod),tag_m(numnod))
180 tag_s =0
181 tag_m =0
182 DO i=1,nsn
183 j=intbuf_tab%NSV(i)
184 tag_s(j) =i
185 END DO
186 DO i=1,nmn
187 j=intbuf_tab%MSR(i)
188 tag_m(j) =i
189 END DO
190 END IF !(intkg1 > 0) THEN
191C------------multi-contact spmd
192 CALL ffizero(i_stok ,nin ,nsn ,intbuf_tab_imp%CAND_N )
193C
194 DO nft = 0 , i_stok - 1 , nvsiz
195 jlt = min( nvsiz, i_stok - nft )
196 idnj = 3*nft + 1
197 idhj = 4*nft + 1
198 CALL i24corkm(
199 1 jlt ,x ,intbuf_tab%IRECTM,intbuf_tab%NSV,
200 + intbuf_tab_imp%CAND_E(nft+1) ,intbuf_tab_imp%CAND_N(nft+1),
201 2 stif ,intbuf_tab_imp%STIF(nft+1),
202 + xi ,yi ,zi ,
203 3 vxi ,vyi ,vzi ,ix1 ,
204 4 ix2 ,ix3 ,ix4 ,nsvg ,intbuf_tab%NVOISIN,
205 5 ms ,msi ,nsn ,v ,nin ,
206 6 n1 ,n2 ,n3 ,h1 ,h2 ,
207 7 h3 ,h4 ,intbuf_tab_imp%NJ(idnj),intbuf_tab_imp%HJ(idhj),
208 8 intbuf_tab_imp%INDSUBT(nft+1))
209 CALL i24keg3(jlt ,a ,v ,ms ,fric ,
210 1 ix1 ,ix2 ,ix3 ,ix4 ,nsvg ,
211 2 stif ,vxi ,vyi ,vzi ,msi ,
212 5 n1 ,n2 ,n3 ,h1 ,h2 ,
213 6 h3 ,h4 ,pene ,stiglo,x ,
214 3 ki11 ,ki12 ,kj11 ,kj12 ,kk11 ,
215 4 kk12 ,kl11 ,kl12 ,off ,sk_int,
216 5 nin ,lrem ,intbuf_tab%STIF_OLD ,
217 + intbuf_tab_imp%CAND_N(nft+1),
218 6 igsti ,intbuf_tab%PENE_OLD,nm1 ,nm2 ,
219 7 nm3 )
220 IF(intkg1 > 0) THEN
221 CALL i24kgeo3(jlt ,ix1 ,ix2 ,ix3 ,ix4 ,
222 1 nsvg ,stif ,h1 ,h2 ,h3 ,
223 2 h4 ,pene ,stiglo ,ki11 ,ki12 ,
224 3 kj11 ,kj12 ,kk11 ,kk12 ,kl11 ,
225 4 kl12 ,sk_int ,intbuf_tab%NOD_2RY_LGTH,
226 . intbuf_tab%NOD_MAS_LGTH,
227 5 tag_s ,tag_m ,nsn )
228 DEALLOCATE(tag_s,tag_m)
229 END IF
230
231 IF (nspmd > 1) THEN
232 lrem = lrem + jlt
233 CALL ass_spmd(3 ,nsvg ,ix1 ,ix2 ,ix3 ,
234 1 ix4 ,jlt ,iddl ,k_diag ,k_lt ,
235 2 iadk ,jdik ,ki11 ,ki12 ,kj11 ,
236 3 kj12 ,kk11 ,kk12 ,kl11 ,kl12 ,
237 4 off ,nin )
238 lrem = lrem - jlt
239 ENDIF
240C
241 CALL assem_int(3 ,nsvg ,ix1 ,ix2 ,ix3 ,
242 1 ix4 ,jlt ,iddl ,k_diag ,k_lt ,
243 2 iadk ,jdik ,ki11 ,ki12 ,kj11 ,
244 3 kj12 ,kk11 ,kk12 ,kl11 ,kl12 ,
245 4 off )
246 ENDDO
247
248 intbuf_tab_imp%I_STOK(1) = 0
249C
250 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:548
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:269
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 260 of file i24ke3.F.

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

548C-----------------------------------------------
549C I m p l i c i t T y p e s
550C-----------------------------------------------
551#include "implicit_f.inc"
552C-----------------------------------------------
553C G l o b a l P a r a m e t e r s
554C-----------------------------------------------
555#include "mvsiz_p.inc"
556C-----------------------------------------------
557C D u m m y A r g u m e n t s
558C-----------------------------------------------
559 INTEGER JLT
560 INTEGER IX1(MVSIZ), IX2(MVSIZ), IX3(MVSIZ), IX4(MVSIZ),
561 . NSVG(MVSIZ),TAG_S(*),TAG_M(*),NSN
562 my_real
563 . stiglo,scalk
564 my_real
565 . pene(mvsiz),
566 . h1(mvsiz), h2(mvsiz), h3(mvsiz), h4(mvsiz),
567 . stif(mvsiz),ll_s(*) ,ll_m(*),
568 . ki11(3,3,mvsiz),kj11(3,3,mvsiz),
569 . kk11(3,3,mvsiz),kl11(3,3,mvsiz),ki12(3,3,mvsiz),
570 . kj12(3,3,mvsiz),kk12(3,3,mvsiz),kl12(3,3,mvsiz)
571C-----------------------------------------------
572C L o c a l V a r i a b l e s
573C-----------------------------------------------
574 INTEGER I, J, NS, NM
575 my_real
576 . fac,facf,
577 . kn(4,mvsiz),lns,lns1
578 my_real
579 . lmax,fni(mvsiz),al(4,mvsiz)
580C-----------------------------------------------
581 IF (nsn == 0) RETURN
582 DO i=1,jlt
583 IF(stiglo<=zero)THEN
584 stif(i) = half*stif(i)
585 ELSEIF(stif(i)/=zero)THEN
586 stif(i) = stiglo
587 ENDIF
588 fni(i)= -stif(i) * pene(i)
589 ENDDO
590C---------------------------------
591 lns1=half*(ll_s(1)+ll_s(nsn))
592 DO i=1,jlt
593 ns=nsvg(i)
594C-------in spmd LNS is simplified
595 IF (ns < 0) THEN
596 lns=lns1
597 ELSE
598 lns=ll_s(tag_s(ns))
599 END IF
600 nm=ix1(i)
601 al(1,i)=lns+ll_m(tag_m(nm))
602 nm=ix2(i)
603 al(2,i)=lns+ll_m(tag_m(nm))
604 nm=ix3(i)
605 al(3,i)=lns+ll_m(tag_m(nm))
606 nm=ix4(i)
607 al(4,i)=lns+ll_m(tag_m(nm))
608 lmax=onep01*pene(i)
609 DO j=1,4
610 al(j,i)=max(lmax,al(j,i))
611 END DO
612 ENDDO
613 facf=abs(scalk)
614 DO i=1,jlt
615 fac = facf*fni(i)
616 kn(1,i)=fac*h1(i)/al(1,i)
617 kn(2,i)=fac*h2(i)/al(2,i)
618 kn(3,i)=fac*h3(i)/al(3,i)
619 kn(4,i)=fac*h4(i)/al(4,i)
620c print *,'FACF,FNI(I),KN(1,I)=',FACF,FNI(I),KN(1,I)
621 ENDDO
622C
623 DO j=1,3
624 DO i=1,jlt
625 ki11(j,j,i) = ki11(j,j,i)+kn(1,i)
626 ki12(j,j,i) = ki12(j,j,i)-kn(1,i)
627 kj11(j,j,i) = kj11(j,j,i)+kn(2,i)
628 kj12(j,j,i) = kj12(j,j,i)-kn(2,i)
629 kk11(j,j,i) = kk11(j,j,i)+kn(3,i)
630 kk12(j,j,i) = kk12(j,j,i)-kn(3,i)
631 kl11(j,j,i) = kl11(j,j,i)+kn(4,i)
632 kl12(j,j,i) = kl12(j,j,i)-kn(4,i)
633 ENDDO
634 ENDDO
635C
636 RETURN
max
#define max(a, b)
Definition macros.h:21