OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
i24cor3.F
Go to the documentation of this file.
1Copyright> OpenRadioss
2Copyright> Copyright (C) 1986-2025 Altair Engineering Inc.
3Copyright>
4Copyright> This program is free software: you can redistribute it and/or modify
5Copyright> it under the terms of the GNU Affero General Public License as published by
6Copyright> the Free Software Foundation, either version 3 of the License, or
7Copyright> (at your option) any later version.
8Copyright>
9Copyright> This program is distributed in the hope that it will be useful,
10Copyright> but WITHOUT ANY WARRANTY; without even the implied warranty of
11Copyright> MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12Copyright> GNU Affero General Public License for more details.
13Copyright>
14Copyright> You should have received a copy of the GNU Affero General Public License
15Copyright> along with this program. If not, see <https://www.gnu.org/licenses/>.
16Copyright>
17Copyright>
18Copyright> Commercial Alternative: Altair Radioss Software
19Copyright>
20Copyright> As an alternative to this open-source version, Altair also offers Altair Radioss
21Copyright> software under a commercial license. Contact Altair to discuss further if the
22Copyright> commercial version may interest you: https://www.altair.com/radioss/.
23!||====================================================================
24!|| i24cor3 ../engine/source/interfaces/int24/i24cor3.F
25!||--- called by ------------------------------------------------------
26!|| i24mainf ../engine/source/interfaces/int24/i24main.F
27!||--- calls -----------------------------------------------------
28!|| i24fic_getn ../engine/source/interfaces/int24/i24for3e.F
29!||--- uses -----------------------------------------------------
30!|| debug_mod ../engine/share/modules/debug_mod.F
31!|| parameters_mod ../common_source/modules/interfaces/parameters_mod.F
32!|| tri7box ../engine/share/modules/tri7box.F
33!||====================================================================
34 SUBROUTINE i24cor3(
35 1 JLT ,X ,IRECT ,NSV ,CAND_E ,
36 2 CAND_N ,CAND_T ,STF ,STFN ,STIF ,
37 3 XX0 ,YY0 ,ZZ0 ,VX ,VY ,
38 5 VZ ,XI ,YI ,ZI ,VXI ,
39 7 VYI ,VZI ,IXX ,NSVG ,NVOISIN ,
40 9 MS ,MSI ,NSN ,V ,KINET ,
41 A KINI ,ITY ,NIN ,IGSTI ,KMIN ,
42 B KMAX ,GAP_S ,GAPS ,NODNX_SMS,NSMS ,
43 C ITRIV ,XFIC ,VFIC ,MSF ,IRTSE ,
44 D IS2SE ,IS2PT ,ISEGPT ,NSNE ,
45 E IRTLM ,NPT ,NRTSE ,IEDG4 ,ISPT2 ,
46 F ISPT2_LOC,INTFRIC ,IPARTFRICS,IPARTFRICSI,
47 G IPARTFRICM,IPARTFRICMI,INTNITSCHE,FORNEQS,FORNEQSI,
48 H IORTHFRIC,IREP_FRICM,DIR_FRICM,IREP_FRICMI,DIR_FRICMI,
49 I IXX3 ,IXX4 , XX1 ,XX2 ,XX3 ,
50 3 XX4 ,YY1 ,YY2 ,YY3 ,YY4 ,
51 4 ZZ1 ,ZZ2 ,ZZ3 ,ZZ4 ,NINLOADP ,
52 5 DIST ,ISTIF_MSDT,DTSTIF ,STIFMSDT_S,STIFMSDT_M,
53 6 NRTM ,PARAMETERS)
54C-----------------------------------------------
55C M o d u l e s
56C-----------------------------------------------
57 USE tri7box
58 USE debug_mod
59 USE parameters_mod
60C-----------------------------------------------
61C I m p l i c i t T y p e s
62C-----------------------------------------------
63#include "implicit_f.inc"
64C-----------------------------------------------
65C G l o b a l P a r a m e t e r s
66C-----------------------------------------------
67#include "mvsiz_p.inc"
68C-----------------------------------------------
69C C o m m o n B l o c k s
70C-----------------------------------------------
71#include "sms_c.inc"
72#include "com04_c.inc"
73C-----------------------------------------------
74C D u m m y A r g u m e n t s
75C-----------------------------------------------
76 INTEGER IRECT(4,*), NSV(*), CAND_E(*), CAND_N(*),KINET(*),KINI(*),
77 . jlt,idt, noint ,nddim, nsn, ity, nin, igsti,nrtse,
78 . nvoisin(8,*), nodnx_sms(*), cand_t(*),irtlm(2,*),npt,
79 . iedg4,intfric,intnitsche ,iorthfric
80 INTEGER IXX(MVSIZ,13), NSVG(MVSIZ), NSMS(MVSIZ),ITRIV(4,MVSIZ),
81 . IRTSE(5,*),IS2SE(2,*),IS2PT(*),ISEGPT(*),NSNE,ISPT2(NSN),
82 * ISPT2_LOC(MVSIZ),IPARTFRICS(*),IPARTFRICSI(MVSIZ),IPARTFRICM(*),
83 . IPARTFRICMI(MVSIZ),IREP_FRICM(*),IREP_FRICMI(MVSIZ),
84 . IXX3(MVSIZ),IXX4(MVSIZ)
85 INTEGER , INTENT(IN) :: NINLOADP
86 INTEGER , INTENT(IN) :: ISTIF_MSDT
87 INTEGER , INTENT(IN) :: NRTM
88C REAL
89 my_real
90 . X(3,*), STF(*), STFN(*),
91 . MS(*), V(3,*),GAPS(MVSIZ),GAP_S(*)
92C REAL
93 my_real
94 . XI(MVSIZ), YI(MVSIZ), ZI(MVSIZ), STIF(MVSIZ),
95 . xx0(mvsiz,17),yy0(mvsiz,17),zz0(mvsiz,17),
96 . vx(mvsiz,17),vy(mvsiz,17),vz(mvsiz,17),
97 . vxi(mvsiz), vyi(mvsiz), vzi(mvsiz), msi(mvsiz),
98 . kmin, kmax,xfic(3,*),vfic(3,*),msf(*), forneqs(3,*),forneqsi(mvsiz,3),
99 . dir_fricm(2,*) ,dir_fricmi(mvsiz,2) ,
100 . xx1(mvsiz), xx2(mvsiz), xx3(mvsiz), xx4(mvsiz),
101 . yy1(mvsiz), yy2(mvsiz), yy3(mvsiz), yy4(mvsiz),
102 . zz1(mvsiz), zz2(mvsiz), zz3(mvsiz), zz4(mvsiz),
103 . stif_msdt(mvsiz)
104 my_real , INTENT(INOUT) :: dist(mvsiz)
105 my_real , INTENT(IN) :: dtstif
106 my_real , INTENT(IN) :: stifmsdt_s(nsn) ,stifmsdt_m(nrtm)
107 TYPE (PARAMETERS_) ,INTENT(IN):: PARAMETERS
108C-----------------------------------------------
109C L o c a l V a r i a b l e s
110C-----------------------------------------------
111 INTEGER I ,J ,IL, L, NN, IG,JFT, IX, NI,IGF,IPT,IE,NS1,NS2,
112 . icont1,icont2,nsi,ipt2,ns
113 my_real
114 . sx1, sy1, sz1, sx2, sy2, sz2, norm, dts
115C-----------------------------------------------
116C initiailisation
117 DO i=1,jlt
118 DO j=1,13
119 ixx(i,j) = 0
120 ENDDO
121 ENDDO
122C-initialize ISPT2_LOC (local or Remote)
123 IF (iedg4 > 0) THEN
124 DO i=1,jlt
125 ni = cand_n(i)
126 IF(ni<=nsn)THEN
127 ispt2_loc(i) = ispt2(ni)
128 ELSE
129 nn = ni - nsn
130 ispt2_loc(i) = ispt2_fi(nin)%P(nn)
131 ENDIF
132 ENDDO
133 ELSE
134 DO i=1,jlt
135 ispt2_loc(i) = 0
136 ENDDO
137
138 END IF !(IEDGE4 > 0) THEN
139C
140 DO i=1,jlt
141 ni = cand_n(i)
142 l = cand_e(i)
143 IF(ni<=nsn)THEN
144 ig = nsv(ni)
145 nsvg(i) = ig
146C---------------voir KINET(IG) est initi quand
147 IF (ig <= numnod) THEN
148 kini(i) = kinet(ig)
149 xi(i) = x(1,ig)
150 yi(i) = x(2,ig)
151 zi(i) = x(3,ig)
152 vxi(i) = v(1,ig)
153 vyi(i) = v(2,ig)
154 vzi(i) = v(3,ig)
155 msi(i)= ms(ig)
156 ELSE
157 igf = ig-numnod
158C--------KINI isn't used
159C KINI(I) = KINETF(IGF)
160 xi(i) = xfic(1,igf)
161 yi(i) = xfic(2,igf)
162 zi(i) = xfic(3,igf)
163 vxi(i) = vfic(1,igf)
164 vyi(i) = vfic(2,igf)
165 vzi(i) = vfic(3,igf)
166 msi(i)= msf(igf)
167 END IF !(IG <= NUMNOD)
168 gaps(i) = gap_s(ni)
169 ELSE
170 nn = ni - nsn
171 nsvg(i) = -nn
172 kini(i) = kinfi(nin)%P(nn)
173 xi(i) = xfi(nin)%P(1,nn)
174 yi(i) = xfi(nin)%P(2,nn)
175 zi(i) = xfi(nin)%P(3,nn)
176 vxi(i)= vfi(nin)%P(1,nn)
177 vyi(i)= vfi(nin)%P(2,nn)
178 vzi(i)= vfi(nin)%P(3,nn)
179 msi(i)= msfi(nin)%P(nn)
180 gaps(i) = gapfi(nin)%P(nn)
181 END IF
182C
183 ix=irect(1,l)
184 ixx(i,1)=ix
185 xx0(i,1)=x(1,ix)
186 yy0(i,1)=x(2,ix)
187 zz0(i,1)=x(3,ix)
188 vx(i,1)=v(1,ix)
189 vy(i,1)=v(2,ix)
190 vz(i,1)=v(3,ix)
191C
192 ix=irect(2,l)
193 ixx(i,2)=ix
194 xx0(i,2)=x(1,ix)
195 yy0(i,2)=x(2,ix)
196 zz0(i,2)=x(3,ix)
197 vx(i,2)=v(1,ix)
198 vy(i,2)=v(2,ix)
199 vz(i,2)=v(3,ix)
200C
201 ix=irect(3,l)
202 ixx(i,3)=ix
203 xx0(i,3)=x(1,ix)
204 yy0(i,3)=x(2,ix)
205 zz0(i,3)=x(3,ix)
206 vx(i,3)=v(1,ix)
207 vy(i,3)=v(2,ix)
208 vz(i,3)=v(3,ix)
209C
210 ix=irect(4,l)
211 ixx(i,4)=ix
212 xx0(i,4)=x(1,ix)
213 yy0(i,4)=x(2,ix)
214 zz0(i,4)=x(3,ix)
215 vx(i,4)=v(1,ix)
216 vy(i,4)=v(2,ix)
217 vz(i,4)=v(3,ix)
218C
219 IF(ixx(i,3) /= ixx(i,4))THEN
220 xx0(i,5) = fourth*(xx0(i,1)+xx0(i,2)+xx0(i,3)+xx0(i,4))
221 yy0(i,5) = fourth*(yy0(i,1)+yy0(i,2)+yy0(i,3)+yy0(i,4))
222 zz0(i,5) = fourth*(zz0(i,1)+zz0(i,2)+zz0(i,3)+zz0(i,4))
223 vx(i,5) = fourth*(vx(i,1)+vx(i,2)+vx(i,3)+vx(i,4))
224 vy(i,5) = fourth*(vy(i,1)+vy(i,2)+vy(i,3)+vy(i,4))
225 vz(i,5) = fourth*(vz(i,1)+vz(i,2)+vz(i,3)+vz(i,4))
226 ELSE
227 xx0(i,5) = xx0(i,3)
228 yy0(i,5) = yy0(i,3)
229 zz0(i,5) = zz0(i,3)
230 vx(i,5) = vx(i,3)
231 vy(i,5) = vy(i,3)
232 vz(i,5) = vz(i,3)
233 ENDIF
234
235 ix=iabs(nvoisin(1,l))
236 ixx(i,6)=ix
237 IF(ix /= 0)THEN
238 xx0(i,6)=x(1,ix)
239 yy0(i,6)=x(2,ix)
240 zz0(i,6)=x(3,ix)
241 vx(i,6) =v(1,ix)
242 vy(i,6) =v(2,ix)
243 vz(i,6) =v(3,ix)
244 ELSE
245 xx0(i,6)=xx0(i,1)
246 yy0(i,6)=yy0(i,1)
247 zz0(i,6)=zz0(i,1)
248 vx(i,6) =vx(i,1)
249 vy(i,6) =vy(i,1)
250 vz(i,6) =vz(i,1)
251 ENDIF
252
253 IF(nvoisin(2,l)/=0)ix=iabs(nvoisin(2,l))
254 ixx(i,7)=ix
255 IF(ix /= 0)THEN
256 xx0(i,7)=x(1,ix)
257 yy0(i,7)=x(2,ix)
258 zz0(i,7)=x(3,ix)
259 vx(i,7)=v(1,ix)
260 vy(i,7)=v(2,ix)
261 vz(i,7)=v(3,ix)
262 ELSE
263 xx0(i,7)=xx0(i,2)
264 yy0(i,7)=yy0(i,2)
265 zz0(i,7)=zz0(i,2)
266 vx(i,7) =vx(i,2)
267 vy(i,7) =vy(i,2)
268 vz(i,7) =vz(i,2)
269 ENDIF
270
271 IF(nvoisin(1,l)<0)THEN
272 IF(nvoisin(2,l)<0)THEN
273 itriv(1,i)=4
274 ELSE
275 itriv(1,i)=2
276 ENDIF
277 ELSEIF(nvoisin(2,l)<0)THEN
278 itriv(1,i)=3
279 ELSE
280 itriv(1,i)=1
281 ENDIF
282
283 ix=iabs(nvoisin(3,l))
284 ixx(i,8)=ix
285 IF(ix /= 0)THEN
286 xx0(i,8)=x(1,ix)
287 yy0(i,8)=x(2,ix)
288 zz0(i,8)=x(3,ix)
289 vx(i,8)=v(1,ix)
290 vy(i,8)=v(2,ix)
291 vz(i,8)=v(3,ix)
292 ELSE
293 xx0(i,8)=xx0(i,2)
294 yy0(i,8)=yy0(i,2)
295 zz0(i,8)=zz0(i,2)
296 vx(i,8) =vx(i,2)
297 vy(i,8) =vy(i,2)
298 vz(i,8) =vz(i,2)
299 ENDIF
300
301 IF(nvoisin(4,l)/=0)ix=iabs(nvoisin(4,l))
302 ixx(i,9)=ix
303 IF(ix /= 0)THEN
304 xx0(i,9)=x(1,ix)
305 yy0(i,9)=x(2,ix)
306 zz0(i,9)=x(3,ix)
307 vx(i,9)=v(1,ix)
308 vy(i,9)=v(2,ix)
309 vz(i,9)=v(3,ix)
310 ELSE
311 xx0(i,9)=xx0(i,3)
312 yy0(i,9)=yy0(i,3)
313 zz0(i,9)=zz0(i,3)
314 vx(i,9) =vx(i,3)
315 vy(i,9) =vy(i,3)
316 vz(i,9) =vz(i,3)
317 ENDIF
318
319 IF(nvoisin(3,l)<0)THEN
320 IF(nvoisin(4,l)<0)THEN
321 itriv(2,i)=4
322 ELSE
323 itriv(2,i)=2
324 ENDIF
325 ELSEIF(nvoisin(4,l)<0)THEN
326 itriv(2,i)=3
327 ELSE
328 itriv(2,i)=1
329 ENDIF
330
331
332 ix=iabs(nvoisin(5,l))
333 ixx(i,10)=ix
334 IF(ix /= 0)THEN
335 xx0(i,10)=x(1,ix)
336 yy0(i,10)=x(2,ix)
337 zz0(i,10)=x(3,ix)
338 vx(i,10)=v(1,ix)
339 vy(i,10)=v(2,ix)
340 vz(i,10)=v(3,ix)
341 ELSE
342 xx0(i,10)=xx0(i,3)
343 yy0(i,10)=yy0(i,3)
344 zz0(i,10)=zz0(i,3)
345 vx(i,10) =vx(i,3)
346 vy(i,10) =vy(i,3)
347 vz(i,10) =vz(i,3)
348 ENDIF
349
350 IF(nvoisin(6,l)/=0)ix=iabs(nvoisin(6,l))
351 ixx(i,11)=ix
352 IF(ix /= 0)THEN
353 xx0(i,11)=x(1,ix)
354 yy0(i,11)=x(2,ix)
355 zz0(i,11)=x(3,ix)
356 vx(i,11)=v(1,ix)
357 vy(i,11)=v(2,ix)
358 vz(i,11)=v(3,ix)
359 ELSE
360 xx0(i,11)=xx0(i,4)
361 yy0(i,11)=yy0(i,4)
362 zz0(i,11)=zz0(i,4)
363 vx(i,11) =vx(i,4)
364 vy(i,11) =vy(i,4)
365 vz(i,11) =vz(i,4)
366 ENDIF
367
368
369 IF(nvoisin(5,l)<0)THEN
370 IF(nvoisin(6,l)<0)THEN
371 itriv(3,i)=4
372 ELSE
373 itriv(3,i)=2
374 ENDIF
375 ELSEIF(nvoisin(6,l)<0)THEN
376 itriv(3,i)=3
377 ELSE
378 itriv(3,i)=1
379 ENDIF
380
381 ix=iabs(nvoisin(7,l))
382 ixx(i,12)=ix
383 IF(ix /= 0)THEN
384 xx0(i,12)=x(1,ix)
385 yy0(i,12)=x(2,ix)
386 zz0(i,12)=x(3,ix)
387 vx(i,12)=v(1,ix)
388 vy(i,12)=v(2,ix)
389 vz(i,12)=v(3,ix)
390 ELSE
391 xx0(i,12)=xx0(i,4)
392 yy0(i,12)=yy0(i,4)
393 zz0(i,12)=zz0(i,4)
394 vx(i,12) =vx(i,4)
395 vy(i,12) =vy(i,4)
396 vz(i,12) =vz(i,4)
397 ENDIF
398
399 IF(nvoisin(8,l)/=0)ix=iabs(nvoisin(8,l))
400 ixx(i,13)=ix
401 IF(ix /= 0)THEN
402 xx0(i,13)=x(1,ix)
403 yy0(i,13)=x(2,ix)
404 zz0(i,13)=x(3,ix)
405 vx(i,13)=v(1,ix)
406 vy(i,13)=v(2,ix)
407 vz(i,13)=v(3,ix)
408 ELSE
409 xx0(i,13)=xx0(i,1)
410 yy0(i,13)=yy0(i,1)
411 zz0(i,13)=zz0(i,1)
412 vx(i,13) =vx(i,1)
413 vy(i,13) =vy(i,1)
414 vz(i,13) =vz(i,1)
415 ENDIF
416
417 IF(nvoisin(7,l)<0)THEN
418 IF(nvoisin(8,l)<0)THEN
419 itriv(4,i)=4
420 ELSE
421 itriv(4,i)=2
422 ENDIF
423 ELSEIF(nvoisin(8,l)<0)THEN
424 itriv(4,i)=3
425 ELSE
426 itriv(4,i)=1
427 ENDIF
428
429 IF(ixx(i,6)==ixx(i,7))THEN
430 xx0(i,14) = xx0(i,6)
431 yy0(i,14) = yy0(i,6)
432 zz0(i,14) = zz0(i,6)
433 vx(i,14) = vx(i,6)
434 vy(i,14) = vy(i,6)
435 vz(i,14) = vz(i,6)
436 ELSE
437 xx0(i,14) = fourth*(xx0(i,2)+xx0(i,1)+xx0(i,6)+xx0(i,7))
438 yy0(i,14) = fourth*(yy0(i,2)+yy0(i,1)+yy0(i,6)+yy0(i,7))
439 zz0(i,14) = fourth*(zz0(i,2)+zz0(i,1)+zz0(i,6)+zz0(i,7))
440 vx(i,14) = fourth*(vx(i,2)+vx(i,1)+vx(i,6)+vx(i,7))
441 vy(i,14) = fourth*(vy(i,2)+vy(i,1)+vy(i,6)+vy(i,7))
442 vz(i,14) = fourth*(vz(i,2)+vz(i,1)+vz(i,6)+vz(i,7))
443 ENDIF
444 IF(ixx(i, 8)==ixx(i, 9))THEN
445 xx0(i,15) = xx0(i,8)
446 yy0(i,15) = yy0(i,8)
447 zz0(i,15) = zz0(i,8)
448 vx(i,15) = vx(i,8)
449 vy(i,15) = vy(i,8)
450 vz(i,15) = vz(i,8)
451 ELSE
452 xx0(i,15) = fourth*(xx0(i,3)+xx0(i,2)+xx0(i,8)+xx0(i,9))
453 yy0(i,15) = fourth*(yy0(i,3)+yy0(i,2)+yy0(i,8)+yy0(i,9))
454 zz0(i,15) = fourth*(zz0(i,3)+zz0(i,2)+zz0(i,8)+zz0(i,9))
455 vx(i,15) = fourth*(vx(i,3)+vx(i,2)+vx(i,8)+vx(i,9))
456 vy(i,15) = fourth*(vy(i,3)+vy(i,2)+vy(i,8)+vy(i,9))
457 vz(i,15) = fourth*(vz(i,3)+vz(i,2)+vz(i,8)+vz(i,9))
458 ENDIF
459 IF(ixx(i,10)==ixx(i,11))THEN
460 xx0(i,16) = xx0(i,10)
461 yy0(i,16) = yy0(i,10)
462 zz0(i,16) = zz0(i,10)
463 vx(i,16) = vx(i,10)
464 vy(i,16) = vy(i,10)
465 vz(i,16) = vz(i,10)
466 ELSE
467 xx0(i,16) = fourth*(xx0(i,4)+xx0(i,3)+xx0(i,10)+xx0(i,11))
468 yy0(i,16) = fourth*(yy0(i,4)+yy0(i,3)+yy0(i,10)+yy0(i,11))
469 zz0(i,16) = fourth*(zz0(i,4)+zz0(i,3)+zz0(i,10)+zz0(i,11))
470 vx(i,16) = fourth*(vx(i,4)+vx(i,3)+vx(i,10)+vx(i,11))
471 vy(i,16) = fourth*(vy(i,4)+vy(i,3)+vy(i,10)+vy(i,11))
472 vz(i,16) = fourth*(vz(i,4)+vz(i,3)+vz(i,10)+vz(i,11))
473 ENDIF
474 IF(ixx(i,12)==ixx(i,13))THEN
475 xx0(i,17) = xx0(i,12)
476 yy0(i,17) = yy0(i,12)
477 zz0(i,17) = zz0(i,12)
478 vx(i,17) = vx(i,12)
479 vy(i,17) = vy(i,12)
480 vz(i,17) = vz(i,12)
481 ELSE
482 xx0(i,17) = fourth*(xx0(i,1)+xx0(i,4)+xx0(i,12)+xx0(i,13))
483 yy0(i,17) = fourth*(yy0(i,1)+yy0(i,4)+yy0(i,12)+yy0(i,13))
484 zz0(i,17) = fourth*(zz0(i,1)+zz0(i,4)+zz0(i,12)+zz0(i,13))
485 vx(i,17) = fourth*(vx(i,1)+vx(i,4)+vx(i,12)+vx(i,13))
486 vy(i,17) = fourth*(vy(i,1)+vy(i,4)+vy(i,12)+vy(i,13))
487 vz(i,17) = fourth*(vz(i,1)+vz(i,4)+vz(i,12)+vz(i,13))
488 ENDIF
489
490 END DO
491C
492 IF(igsti<=1)THEN
493 DO i=1,jlt
494 l = cand_e(i)
495 ni = cand_n(i)
496 IF(ni<=nsn)THEN
497 stif(i)=stf(l)*abs(stfn(ni))
498 ELSE
499 nn = ni - nsn
500 stif(i)=stf(l)*abs(stifi(nin)%P(nn))
501 END IF
502 ENDDO
503 ELSEIF(igsti==2)THEN
504 DO i=1,jlt
505 l = cand_e(i)
506 ni = cand_n(i)
507 IF(ni<=nsn)THEN
508 stif(i)=abs(stfn(ni))
509 ELSE
510 nn = ni - nsn
511 stif(i)=abs(stifi(nin)%P(nn))
512 END IF
513 stif(i)=half*(stf(l)+stif(i))
514c STIF(I)=MAX(KMIN,MIN(STIF(I),KMAX))
515 ENDDO
516 ELSEIF(igsti==3)THEN
517 DO i=1,jlt
518 l = cand_e(i)
519 ni = cand_n(i)
520 IF(ni<=nsn)THEN
521 stif(i)=abs(stfn(ni))
522 ELSE
523 nn = ni - nsn
524 stif(i)=abs(stifi(nin)%P(nn))
525 END IF
526 stif(i)=max(stf(l),stif(i))
527c STIF(I)=MAX(KMIN,MIN(STIF(I),KMAX))
528 ENDDO
529 ELSEIF(igsti==4.OR.igsti==6)THEN
530 DO i=1,jlt
531 l = cand_e(i)
532 ni = cand_n(i)
533 IF(ni<=nsn)THEN
534 stif(i)=abs(stfn(ni))
535 ELSE
536 nn = ni - nsn
537 stif(i)=abs(stifi(nin)%P(nn))
538 END IF
539 stif(i)=min(stf(l),stif(i))
540c STIF(I)=MAX(KMIN,MIN(STIF(I),KMAX))
541 ENDDO
542 ELSEIF(igsti==5)THEN
543 DO i=1,jlt
544 l = cand_e(i)
545 ni = cand_n(i)
546 IF(ni<=nsn)THEN
547 stif(i)=abs(stfn(ni))
548 ELSE
549 nn = ni - nsn
550 stif(i)=abs(stifi(nin)%P(nn))
551 END IF
552 stif(i)=stf(l)*stif(i)/
553 . max(em30,(stf(l)+stif(i)))
554c STIF(I)=MAX(KMIN,MIN(STIF(I),KMAX))
555 ENDDO
556 ELSEIF(igsti==7)THEN
557 DO i=1,jlt
558 stif(i)=zero
559 ENDDO
560 ENDIF
561c DO I=1,JLT
562c IF(NSVG(I)>NUMNOD)THEN
563c NI = CAND_N(I)
564c IF (ISEGPT(NI)>0) THEN
565c STIF(I) = (ONE/NPT)*STIF(I)
566c ELSE
567c STIF(I) = ZEP3*STIF(I)
568c END IF
569c END IF
570c END DO !I=1,JLT
571
572
573C------------------------------------------
574C Stiffness based on mass and time step
575C------------------------------------------
576
577 IF(istif_msdt > 0) THEN
578 IF(dtstif > zero) THEN
579 dts = dtstif
580 ELSE
581 dts = parameters%DT_STIFINT
582 ENDIF
583 DO i=1,jlt
584 l = cand_e(i)
585 ni = cand_n(i)
586 IF(ni<=nsn)THEN
587 stif_msdt(i) = stifmsdt_s(ni)
588 ELSE
589 nn = ni - nsn
590 stif_msdt(i) = abs(stif_msdt_fi(nin)%P(nn))
591 ENDIF
592 stif_msdt(i) = stifmsdt_m(l)*stif_msdt(i)/(stifmsdt_m(l)+stif_msdt(i))
593 stif_msdt(i) = stif_msdt(i)/(dts*dts)
594 stif(i)=max(stif(i),stif_msdt(i))
595 ENDDO
596 ENDIF
597C
598 DO i=1,jlt
599 stif(i)=max(kmin,min(stif(i),kmax))
600 ENDDO
601C----------
602
603
604
605C----------
606 IF(idtmins==2)THEN
607 DO i=1,jlt
608 IF(nsvg(i)>0)THEN
609 IF (nsvg(i) <= numnod) THEN
610 nn = nodnx_sms(nsvg(i))
611 ELSE
612 nn = nsvg(i)-numnod
613 CALL i24fic_getn(nn ,irtse ,is2se ,ie ,ns1 ,
614 + ns2 )
615 nn = max(nodnx_sms(ns1),nodnx_sms(ns2))
616 END IF
617 nsms(i)= nn
618 . +nodnx_sms(ixx(i,1))+nodnx_sms(ixx(i,2))
619 . +nodnx_sms(ixx(i,3))+nodnx_sms(ixx(i,4))
620 ELSE
621 nn=-nsvg(i)
622 nsms(i)=nodnxfi(nin)%P(nn)
623 . +nodnx_sms(ixx(i,1))+nodnx_sms(ixx(i,2))
624 . +nodnx_sms(ixx(i,3))+nodnx_sms(ixx(i,4))
625 END IF
626 ENDDO
627 IF(idtmins_int/=0)THEN
628 DO i=1,jlt
629 IF(nsms(i)==0)nsms(i)=-1
630 ENDDO
631 END IF
632 ELSEIF(idtmins_int/=0)THEN
633 DO i=1,jlt
634 nsms(i)=-1
635 ENDDO
636 ENDIF
637
638C----Friction model : secnd part IDs---------
639 IF(intfric > 0) THEN
640 DO i=1,jlt
641 ni = cand_n(i)
642 l = cand_e(i)
643 IF(ni<=nsn)THEN
644 ipartfricsi(i)= ipartfrics(ni)
645 ELSE
646 nn = ni - nsn
647 ipartfricsi(i)= ipartfricsfi(nin)%P(nn)
648 END IF
649C
650 ipartfricmi(i) = ipartfricm(l)
651
652 IF(iorthfric > 0) THEN
653 irep_fricmi(i) =irep_fricm(l)
654 dir_fricmi(i,1:2)=dir_fricm(1:2,l)
655 ixx3(i) = ixx(i,3)
656 ixx4(i) = ixx(i,4)
657 xx1(i) = xx0(i,1)
658 xx2(i) = xx0(i,2)
659 xx3(i) = xx0(i,3)
660 xx4(i) = xx0(i,4)
661 yy1(i) = yy0(i,1)
662 yy2(i) = yy0(i,2)
663 yy3(i) = yy0(i,3)
664 yy4(i) = yy0(i,4)
665 zz1(i) = zz0(i,1)
666 zz2(i) = zz0(i,2)
667 zz3(i) = zz0(i,3)
668 zz4(i) = zz0(i,4)
669 ENDIF
670 ENDDO
671 ENDIF
672C
673C----Friction model : secnd part IDs---------
674 IF(intnitsche > 0) THEN
675 DO i=1,jlt
676 ni = cand_n(i)
677 IF(ni<=nsn)THEN
678 ig = nsvg(i)
679 forneqsi(i,1)= forneqs(1,ig)
680 forneqsi(i,2)= forneqs(2,ig)
681 forneqsi(i,3)= forneqs(3,ig)
682 ELSE
683 nn = ni - nsn
684 forneqsi(i,1)= forneqsfi(nin)%P(1,nn)
685 forneqsi(i,2)= forneqsfi(nin)%P(2,nn)
686 forneqsi(i,3)= forneqsfi(nin)%P(3,nn)
687 END IF
688 ENDDO
689 ENDIF
690C
691 IF(ninloadp > 0) THEN
692C-----------------------------------------------
693C Distance between secnd node
694C and main segment
695C-----------------------------------------------
696 DO i=1,jlt
697C
698 sx1=(yy0(i,1)-yy0(i,3))*(zz0(i,2)-zz0(i,4)) - (zz0(i,1)-zz0(i,3))*(yy0(i,2)-yy0(i,4))
699 sy1=(zz0(i,1)-zz0(i,3))*(xx0(i,2)-xx0(i,4)) - (xx0(i,1)-xx0(i,3))*(zz0(i,2)-zz0(i,4))
700 sz1=(xx0(i,1)-xx0(i,3))*(yy0(i,2)-yy0(i,4)) - (yy0(i,1)-yy0(i,3))*(xx0(i,2)-xx0(i,4))
701C
702 norm = sqrt(sx1**2 + sy1**2 + sz1**2)
703C
704 IF(ixx(i,4)/=ixx(i,3))THEN
705 sx2 = fourth*(xx0(i,1) + xx0(i,2) + xx0(i,3) + xx0(i,4)) - xi(i)
706 sy2 = fourth*(yy0(i,1) + yy0(i,2) + yy0(i,3) + yy0(i,4)) - yi(i)
707 sz2 = fourth*(zz0(i,1) + zz0(i,2) + zz0(i,3) + zz0(i,4)) - zi(i)
708 ELSE
709 sx2 = third*(xx0(i,1) + xx0(i,2) + xx0(i,3)) - xi(i)
710 sy2 = third*(yy0(i,1) + yy0(i,2) + yy0(i,3)) - yi(i)
711 sz2 = third*(zz0(i,1) + zz0(i,2) + zz0(i,3)) - zi(i)
712 END IF
713 dist(i) = (sx2*sx1+sy2*sy1+sz2*sz1) / max(em15,norm)
714 dist(i) = abs(dist(i))
715
716 ENDDO
717C
718 ENDIF
719 RETURN
720 END
721!||====================================================================
722!|| i24ini_ispt2 ../engine/source/interfaces/int24/i24cor3.F
723!||====================================================================
724 SUBROUTINE i24ini_ispt2(
725 1 JLT ,NSV ,CAND_N ,NSN ,IRTSE ,
726 2 IS2SE ,ISPT2 ,ISEGPT ,IRTLM ,NSNE ,
727 3 NRTSE ,IEDG4 )
728C============================================================================
729C I m p l i c i t T y p e s
730C-----------------------------------------------
731#include "implicit_f.inc"
732C-----------------------------------------------
733C C o m m o n B l o c k s
734C-----------------------------------------------
735#include "com04_c.inc"
736C-----------------------------------------------
737C D u m m y A r g u m e n t s
738C-----------------------------------------------
739 INTEGER IRTSE(5,*) ,IS2SE(2,*),JLT ,NSV(*),CAND_N(*) ,NSN ,
740 + ispt2(*) ,isegpt(*),irtlm(2,*),nsne , nrtse,
741 + iedg4
742C-----------------------------------------------
743C L o c a l V a r i a b l e s
744C-----------------------------------------------
745C----- get edge NS1,NS2 and--Secnd seg id :IE-
746 INTEGER ITAG(NRTSE),IE1,IE2
747 INTEGER I ,J ,IL, L, NN, IG,JFT, IX, NI,IGF,IPT,IE,NS1,NS2,
748 . ICONT1,ICONT2,NSI,IPT2,NS,ip
749C=======================================================================
750C----IRTSE(5,*) -> id of edge
751C=======================================================================
752C----ISEGPT(NI) : ISEGPT(NI)<0 internal node; ISEGPT(NI)=NI fic nodes on edge
753C--- ISEGPT(NI)>0 (NI<=NSN0) : exatrem nodes on edge
754C initiailisation
755 IF (IEDG4==1) return
756 itag(1:nrtse)=0
757 DO i=1,jlt
758 ni = cand_n(i)
759 nsi = -isegpt(ni)
760C-----internal nodes-----
761 IF (nsi >0) THEN
762 ns=nsv(nsi)-numnod
763 ie = is2se(1,ns)
764 itag(ie) = nsi
765 END IF
766 END DO
767C-initialize ISPT2(takes nodal normal or not),
768C---not set ISPT2=0 : when only one internal point is on contact
769 DO i=1,jlt
770 ni = cand_n(i)
771 nsi = isegpt(ni)
772 IF (nsi >0) THEN
773 ns = nsv(nsi)-numnod
774 icont1 = 0
775 icont2 = 0
776 ie1 = is2se(1,ns)
777C-----------one internal point could be IE2>0,IE1=0
778 IF (ie1>0) THEN
779 nn = itag(ie1)
780 IF (nn > 0) icont1 = irtlm(1,nn)
781 END IF
782C-----------second internal point (if exist)
783 ie2 = is2se(2,ns)
784 IF (ie2>0) THEN
785 nn = itag(ie2)
786 IF (nn > 0) icont2 = irtlm(1,nn)
787 END IF
788 IF ((icont1 /=0.AND.icont2 ==0).OR.
789 + (icont2 /=0.AND.icont1 ==0)) THEN
790 ispt2(i) = 0
791 ELSE
792 ispt2(i) = nsi
793 END IF
794C---------interal nodes
795 ELSEIF (nsi <0) THEN
796 ispt2(i) = nsi
797 END IF
798 END DO
799C
800C-----------
801 RETURN
802 END
803!||====================================================================
804!|| i24ispt2_ini ../engine/source/interfaces/int24/i24cor3.f
805!||--- uses -----------------------------------------------------
806!|| tri7box ../engine/share/modules/tri7box.F
807!||====================================================================
808 SUBROUTINE i24ispt2_ini(
809 1 JLT ,NSV ,CAND_N ,NSN ,IRTSE ,
810 2 IS2SE ,ISPT2 ,ISEGPT ,IRTLM ,NSNE ,
811 3 NRTSE ,IEDG4 ,NIN)
812C============================================================================
813C I m p l i c i t T y p e s
814C-----------------------------------------------
815 USE tri7box
816#include "implicit_f.inc"
817C-----------------------------------------------
818C C o m m o n B l o c k s
819C-----------------------------------------------
820#include "com04_c.inc"
821C-----------------------------------------------
822C D u m m y A r g u m e n t s
823C-----------------------------------------------
824 INTEGER IRTSE(5,*) ,IS2SE(2,*),JLT ,NSV(*),CAND_N(*) ,NSN ,
825 + ISPT2(*) ,ISEGPT(*),IRTLM(2,*),NSNE , NRTSE,
826 + iedg4,nin
827C-----------------------------------------------
828C L o c a l V a r i a b l e s
829C-----------------------------------------------
830C----- get edge NS1,NS2 and--Secnd seg id :IE-
831 INTEGER IE1,IE2
832 INTEGER I ,J ,IL, L, NN, IG,JFT, IX, NI,IGF,IPT,IE,NS1,NS2,
833 . icont1,icont2,nsi,ipt2,ns,ip
834C=======================================================================
835C----IRTSE(5,*) -> id of edge
836C=======================================================================
837C----ISEGPT(NI) : ISEGPT(NI)<0 internal node; ISEGPT(NI)=NI fic nodes on edge
838C--- ISEGPT(NI)>0 (NI<=NSN0) : exatrem nodes on edge
839C initiailisation
840 IF (iedg4==1) RETURN
841C-initialize ISPT2(takes nodal normal or not),
842C---not set ISPT2=0 : when only one internal point is on contact
843 DO i=1,jlt
844 ni = cand_n(i)
845 IF(ni <= nsn)THEN
846 nsi = isegpt(ni)
847 IF (nsi >0) THEN
848 ns = nsv(nsi)-numnod
849 icont1 = 0
850C-----------one internal point for SPMD reason ----
851 nn = nsi
852 icont1 = irtlm(1,nn)
853 IF (icont1 /=0) THEN
854 ispt2(i) = 0
855 ELSE
856 ispt2(i) = nsi
857 END IF
858C---------interal nodes
859 ELSEIF (nsi <0) THEN
860 ispt2(i) = nsi
861 END IF
862 ELSE
863 nsi=isegpt_fi(nin)%P(ni-nsn)
864 IF (nsi >0) THEN
865 icont1 = irtlm_fi(nin)%P(1,nsi)
866 IF (icont1 /=0) THEN
867 ispt2(i) = 0
868 ELSE
869 ispt2(i) = nsi
870 ENDIF
871 ELSE
872 ispt2(i) = nsi
873 ENDIF
874 ENDIF
875 END DO
876C
877C-----------
878 RETURN
879 END
880C
881!||====================================================================
882!|| i24ispt2_ini_opttri ../engine/source/interfaces/int24/i24cor3.F
883!||--- called by ------------------------------------------------------
884!|| i24optcd ../engine/source/interfaces/intsort/i24optcd.F
885!||--- uses -----------------------------------------------------
886!|| debug_mod ../engine/share/modules/debug_mod.F
887!|| tri7box ../engine/share/modules/tri7box.F
888!||====================================================================
889 SUBROUTINE i24ispt2_ini_opttri(
890 1 JFT,JLT ,NSV ,CAND_N ,NSN ,IRTSE ,
891 2 IS2SE ,ISPT2 ,ISEGPT ,IRTLM ,NSNE ,
892 3 NRTSE ,IEDG4 ,NIN)
893C============================================================================
894C I m p l i c i t T y p e s
895C-----------------------------------------------
896 USE tri7box
897 USE debug_mod
898#include "implicit_f.inc"
899C-----------------------------------------------
900C D u m m y A r g u m e n t s
901C-----------------------------------------------
902 INTEGER IRTSE(5,*) ,IS2SE(2,*),JLT ,NSV(*),CAND_N(*) ,NSN ,
903 + ispt2(*) ,isegpt(*),irtlm(2,*),nsne , nrtse,
904 + iedg4,nin
905C-----------------------------------------------
906C L o c a l V a r i a b l e s
907C-----------------------------------------------
908C----- get edge NS1,NS2 and--Secnd seg id :IE-
909 INTEGER IE1,IE2
910 INTEGER I ,J ,IL, L, IG,JFT, IX, NI,IGF,IPT,IE,NS1,NS2,
911 . ICONT1,ICONT2,NSI,IPT2,ip,SN
912C=======================================================================
913C----IRTSE(5,*) -> id of edge
914C=======================================================================
915C----ISEGPT(NI) : ISEGPT(NI)<0 internal node; ISEGPT(NI)=NI fic nodes on edge
916C--- ISEGPT(NI)>0 (NI<=NSN0) : exatrem nodes on edge
917C initiailisation
918 IF (iedg4==1) RETURN
919C-initialize ISPT2(takes nodal normal or not),
920C---not set ISPT2=0 : when only one internal point is on contact
921 DO ni=jft,jlt
922 nsi = isegpt(ni)
923 sn = nsv(ni)
924 IF (nsi >0) THEN
925 icont1 = 0
926C-----------one internal point for SPMD reason ----
927 icont1 = irtlm(1,nsi)
928 IF (icont1 /=0) THEN
929 ispt2(ni) = 0
930 ELSE
931 ispt2(ni) = 1
932 END IF
933C---------interal nodes
934 ELSEIF (nsi <0) THEN
935 ispt2(ni) = 1
936 END IF
937 END DO
938C
939C-----------
940 RETURN
941 END
942C
943!||====================================================================
944!|| i_corpfit3 ../engine/source/interfaces/int24/i24cor3.F
945!||--- called by ------------------------------------------------------
946!|| i24mainf ../engine/source/interfaces/int24/i24main.F
947!|| i25mainf ../engine/source/interfaces/int25/i25mainf.F
948!||--- uses -----------------------------------------------------
949!|| tri7box ../engine/share/modules/tri7box.F
950!||====================================================================
951 SUBROUTINE i_corpfit3(
952 1 JLT ,STF ,STFN ,STIF ,NSN ,
953 2 CAND_E ,CAND_N ,NIN ,IGSTI ,KMIN ,
954 3 KMAX ,INACTI ,NCFIT ,TNCY ,IKNON )
955C-----------------------------------------------
956C M o d u l e s
957C-----------------------------------------------
958 USE tri7box
959C-----------------------------------------------
960C I m p l i c i t T y p e s
961C-----------------------------------------------
962#include "implicit_f.inc"
963C-----------------------------------------------
964C G l o b a l P a r a m e t e r s
965C-----------------------------------------------
966#include "mvsiz_p.inc"
967C-----------------------------------------------
968C D u m m y A r g u m e n t s
969C-----------------------------------------------
970 INTEGER CAND_E(*), CAND_N(*),JLT,NSN, NIN, IGSTI,NCFIT,INACTI
971C REAL
972 my_real
973 . stf(*), stfn(*),stif(*),kmin,kmax,tncy
974 INTEGER, DIMENSION(MVSIZ), INTENT(INOUT) :: IKNON
975C REAL
976C-----------------------------------------------
977C L o c a l V a r i a b l e s
978C-----------------------------------------------
979 INTEGER I ,J ,L, NN, IG,JFT, IX, NI
980 my_real
981 . STIF_S,STIF_R(MVSIZ),F_PFIT,FA,FB,FAB
982C-----------------------------------------------
983C--- fixing min(stif) with Inacti=-1
984 IF (inacti==-1)THEN
985 DO i=1,jlt
986 l = cand_e(i)
987 ni = cand_n(i)
988 IF(ni<=nsn)THEN
989 stif_s =abs(stfn(ni))
990 ELSE
991 nn = ni - nsn
992 stif_s =abs(stifi(nin)%P(nn))
993 END IF
994 stif(i) = min(stif_s,stf(l))
995 stif_r(i) = stif(i)/max(stif_s,stf(l))
996 IF(igsti==2) stif(i) = half*(stif_s+stf(l)) !option Inacti=-2
997 ENDDO
998 ELSEIF (igsti==-1)THEN
999 DO i=1,jlt
1000 l = cand_e(i)
1001 ni = cand_n(i)
1002 IF(ni<=nsn)THEN
1003 stif_s =abs(stfn(ni))
1004 ELSE
1005 nn = ni - nsn
1006 stif_s =abs(stifi(nin)%P(nn))
1007 END IF
1008 stif(i) = min(stif_s,stf(l))
1009 stif_r(i) = stif(i)/max(stif_s,stf(l))
1010 ENDDO
1011 END IF
1012 IF(ncfit>0)THEN
1013 fa = min(one,three*tncy)
1014 fab= max(zero,three*tncy-one)
1015 fb = max(zero,three*tncy-two)
1016 f_pfit = em04*(fa+fab)+fb
1017 DO i=1,jlt
1018 IF (stif_r(i)>zep05) THEN
1019 stif(i)=twenty*f_pfit*stif(i)
1020 ELSE
1021 stif(i)=f_pfit*stif(i)
1022 END IF
1023 ENDDO
1024 IF (fb >zero.AND.igsti/=2) THEN
1025 DO i=1,jlt
1026 IF (stif_r(i)<zep05) iknon(i) = 1
1027 ENDDO
1028 ELSEIF (fab >zero.AND.igsti/=2) THEN
1029 iknon(1:jlt) = -1 ! special quadratic
1030 END IF
1031 ELSEIF (inacti==-1.AND.igsti/=2)THEN
1032 DO i=1,jlt
1033 IF (stif_r(i)<zep05) iknon(i) = 1
1034 ENDDO
1035 ELSEIF (igsti ==-1)THEN
1036 DO i=1,jlt
1037 IF (stif_r(i) > 0.9 ) THEN
1038 iknon(i) = 1
1039 ELSEIF (stif_r(i) < em03) THEN
1040 iknon(i) = 3
1041 ELSE
1042 iknon(i) = 2
1043 END IF
1044 ENDDO
1045 END IF
1046C
1047 RETURN
1048 END
1049!||====================================================================
1050!|| i_cor_epfit3 ../engine/source/interfaces/int24/i24cor3.F
1051!||--- called by ------------------------------------------------------
1052!|| i25mainf ../engine/source/interfaces/int25/i25mainf.F
1053!||--- uses -----------------------------------------------------
1054!|| tri7box ../engine/share/modules/tri7box.F
1055!||====================================================================
1056 SUBROUTINE i_cor_epfit3(
1057 1 JLT ,STFE ,STIF ,CAND_S ,CAND_M ,
1058 3 NEDGE ,NIN ,INACTI ,NCFIT ,TNCY)
1059C-----------------------------------------------
1060C M o d u l e s
1061C-----------------------------------------------
1062 USE tri7box
1063C-----------------------------------------------
1064C I m p l i c i t T y p e s
1065C-----------------------------------------------
1066#include "implicit_f.inc"
1067C-----------------------------------------------
1068C G l o b a l P a r a m e t e r s
1069C-----------------------------------------------
1070#include "mvsiz_p.inc"
1071C-----------------------------------------------
1072C D u m m y A r g u m e n t s
1073C-----------------------------------------------
1074 INTEGER, DIMENSION(MVSIZ),INTENT(IN):: CAND_S, CAND_M
1075 INTEGER JLT,NIN,NCFIT,INACTI,NEDGE
1076C REAL
1077 my_real, DIMENSION(MVSIZ), INTENT(INOUT) :: stif
1078 my_real, DIMENSION(NEDGE), INTENT(IN) :: stfe
1079 my_real, INTENT(IN) :: tncy
1080C REAL
1081C-----------------------------------------------
1082C L o c a l V a r i a b l e s
1083C-----------------------------------------------
1084 INTEGER I ,J ,EM,ES, NN, IG,JFT, IX, NI
1085 my_real
1086 . STIF_S,STIF_R(MVSIZ),F_PFIT,FA,FB,FAB
1087C-----------------------------------------------
1088C--- fixing min(stif) with Inacti=-1
1089 IF (inacti==-1)THEN
1090 DO i=1,jlt
1091 em = cand_m(i)
1092 ni = cand_s(i)
1093 IF(ni<=nedge)THEN
1094 es =ni
1095 stif_s =stfe(es)
1096 ELSE
1097 nn = ni - nedge
1098 stif_s =stifie(nin)%P(nn)
1099 END IF
1100c STIF_R(I) = MIN(STIF_S,STFE(EM))/MAX(EM20,STIF(I))
1101 stif(i) = min(stif_s,stfe(em))
1102 ENDDO
1103 END IF
1104 IF(ncfit>0)THEN
1105 fa = min(one,three*tncy)
1106 fab= max(zero,three*tncy-one)
1107 fb = max(zero,three*tncy-two)
1108 f_pfit = em04*(fa+fab)+fb
1109 stif(1:jlt)=f_pfit*stif(1:jlt)
1110 END IF
1111C
1112 RETURN
1113 END
my_real
#define my_real
Definition cppsort.cpp:32
norm
norm(diag(diag(diag(inv(mat))) -id.SOL), 2) % destroy mumps instance id.JOB
i24cor3
subroutine i24cor3(jlt, x, irect, nsv, cand_e, cand_n, cand_t, stf, stfn, stif, xx0, yy0, zz0, vx, vy, vz, xi, yi, zi, vxi, vyi, vzi, ixx, nsvg, nvoisin, ms, msi, nsn, v, kinet, kini, ity, nin, igsti, kmin, kmax, gap_s, gaps, nodnx_sms, nsms, itriv, xfic, vfic, msf, irtse, is2se, is2pt, isegpt, nsne, irtlm, npt, nrtse, iedg4, ispt2, ispt2_loc, intfric, ipartfrics, ipartfricsi, ipartfricm, ipartfricmi, intnitsche, forneqs, forneqsi, iorthfric, irep_fricm, dir_fricm, irep_fricmi, dir_fricmi, ixx3, ixx4, xx1, xx2, xx3, xx4, yy1, yy2, yy3, yy4, zz1, zz2, zz3, zz4, ninloadp, dist, istif_msdt, dtstif, stifmsdt_s, stifmsdt_m, nrtm, parameters)
Definition i24cor3.F:54
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
i24ispt2_ini
subroutine i24ispt2_ini(jlt, nsv, cand_n, nsn, irtse, is2se, ispt2, isegpt, irtlm, nsne, nrtse, iedg4, nin)
Definition i24cor3.F:812
i24ispt2_ini_opttri
subroutine i24ispt2_ini_opttri(jft, jlt, nsv, cand_n, nsn, irtse, is2se, ispt2, isegpt, irtlm, nsne, nrtse, iedg4, nin)
Definition i24cor3.F:893
i_cor_epfit3
subroutine i_cor_epfit3(jlt, stfe, stif, cand_s, cand_m, nedge, nin, inacti, ncfit, tncy)
Definition i24cor3.F:1059
i24ini_ispt2
subroutine i24ini_ispt2(jlt, nsv, cand_n, nsn, irtse, is2se, ispt2, isegpt, irtlm, nsne, nrtse, iedg4)
Definition i24cor3.F:728
i24fic_getn
subroutine i24fic_getn(ns, irtse, is2se, ie, ns1, ns2)
Definition i24surfi.F:1921
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21
debug_mod
Definition debug_mod.F:45
parameters_mod
Definition parameters_mod.F:49
tri7box::ispt2_fi
type(int_pointer), dimension(:), allocatable ispt2_fi
Definition tri7box.F:538
tri7box::stif_msdt_fi
type(real_pointer), dimension(:), allocatable stif_msdt_fi
Definition tri7box.F:552
tri7box::isegpt_fi
type(int_pointer), dimension(:), allocatable isegpt_fi
Definition tri7box.F:539
tri7box::forneqsfi
type(real_pointer2), dimension(:), allocatable forneqsfi
Definition tri7box.F:459
tri7box::vfi
type(real_pointer2), dimension(:), allocatable vfi
Definition tri7box.F:459
tri7box::irtlm_fi
type(int_pointer2), dimension(:), allocatable irtlm_fi
Definition tri7box.F:533
tri7box::stifi
type(real_pointer), dimension(:), allocatable stifi
Definition tri7box.F:449
tri7box::stifie
type(real_pointer), dimension(:), allocatable stifie
Definition tri7box.F:449
tri7box::gapfi
type(real_pointer), dimension(:), allocatable gapfi
Definition tri7box.F:449
tri7box::nodnxfi
type(int_pointer), dimension(:), allocatable nodnxfi
Definition tri7box.F:440
tri7box::msfi
type(real_pointer), dimension(:), allocatable msfi
Definition tri7box.F:449
tri7box::ipartfricsfi
type(int_pointer), dimension(:), allocatable ipartfricsfi
Definition tri7box.F:440
tri7box::xfi
type(real_pointer2), dimension(:), allocatable xfi
Definition tri7box.F:459
tri7box::kinfi
type(int_pointer), dimension(:), allocatable kinfi
Definition tri7box.F:440