OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
i24cor3.F File Reference
#include "implicit_f.inc"
#include "mvsiz_p.inc"
#include "sms_c.inc"
#include "com04_c.inc"

Go to the source code of this file.

Functions/Subroutines

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)
subroutine i24ini_ispt2 (jlt, nsv, cand_n, nsn, irtse, is2se, ispt2, isegpt, irtlm, nsne, nrtse, iedg4)
subroutine i24ispt2_ini (jlt, nsv, cand_n, nsn, irtse, is2se, ispt2, isegpt, irtlm, nsne, nrtse, iedg4, nin)
subroutine i24ispt2_ini_opttri (jft, jlt, nsv, cand_n, nsn, irtse, is2se, ispt2, isegpt, irtlm, nsne, nrtse, iedg4, nin)
subroutine i_corpfit3 (jlt, stf, stfn, stif, nsn, cand_e, cand_n, nin, igsti, kmin, kmax, inacti, ncfit, tncy, iknon)
subroutine i_cor_epfit3 (jlt, stfe, stif, cand_s, cand_m, nedge, nin, inacti, ncfit, tncy)

Function/Subroutine Documentation

◆ i24cor3()

subroutine i24cor3 ( integer jlt,
x,
integer, dimension(4,*) irect,
integer, dimension(*) nsv,
integer, dimension(*) cand_e,
integer, dimension(*) cand_n,
integer, dimension(*) cand_t,
stf,
stfn,
stif,
xx0,
yy0,
zz0,
vx,
vy,
vz,
xi,
yi,
zi,
vxi,
vyi,
vzi,
integer, dimension(mvsiz,13) ixx,
integer, dimension(mvsiz) nsvg,
integer, dimension(8,*) nvoisin,
ms,
msi,
integer nsn,
v,
integer, dimension(*) kinet,
integer, dimension(*) kini,
integer ity,
integer nin,
integer igsti,
kmin,
kmax,
gap_s,
gaps,
integer, dimension(*) nodnx_sms,
integer, dimension(mvsiz) nsms,
integer, dimension(4,mvsiz) itriv,
xfic,
vfic,
msf,
integer, dimension(5,*) irtse,
integer, dimension(2,*) is2se,
integer, dimension(*) is2pt,
integer, dimension(*) isegpt,
integer nsne,
integer, dimension(2,*) irtlm,
integer npt,
integer nrtse,
integer iedg4,
integer, dimension(nsn) ispt2,
integer, dimension(mvsiz) ispt2_loc,
integer intfric,
integer, dimension(*) ipartfrics,
integer, dimension(mvsiz) ipartfricsi,
integer, dimension(*) ipartfricm,
integer, dimension(mvsiz) ipartfricmi,
integer intnitsche,
forneqs,
forneqsi,
integer iorthfric,
integer, dimension(*) irep_fricm,
dir_fricm,
integer, dimension(mvsiz) irep_fricmi,
dir_fricmi,
integer, dimension(mvsiz) ixx3,
integer, dimension(mvsiz) ixx4,
xx1,
xx2,
xx3,
xx4,
yy1,
yy2,
yy3,
yy4,
zz1,
zz2,
zz3,
zz4,
integer, intent(in) ninloadp,
dimension(mvsiz), intent(inout) dist,
integer, intent(in) istif_msdt,
intent(in) dtstif,
dimension(nsn), intent(in) stifmsdt_s,
dimension(nrtm), intent(in) stifmsdt_m,
integer, intent(in) nrtm,
type (parameters_), intent(in) parameters )

Definition at line 34 of file i24cor3.F.

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
my_real
#define my_real
Definition cppsort.cpp:32
norm
norm(diag(diag(diag(inv(mat))) -id.SOL), 2) % destroy mumps instance id.JOB
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::forneqsfi
type(real_pointer2), dimension(:), allocatable forneqsfi
Definition tri7box.F:459
tri7box::vfi
type(real_pointer2), dimension(:), allocatable vfi
Definition tri7box.F:459
tri7box::stifi
type(real_pointer), dimension(:), allocatable stifi
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

◆ i24ini_ispt2()

subroutine i24ini_ispt2 ( integer jlt,
integer, dimension(*) nsv,
integer, dimension(*) cand_n,
integer nsn,
integer, dimension(5,*) irtse,
integer, dimension(2,*) is2se,
integer, dimension(*) ispt2,
integer, dimension(*) isegpt,
integer, dimension(2,*) irtlm,
integer nsne,
integer nrtse,
integer iedg4 )

Definition at line 724 of file i24cor3.F.

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

◆ i24ispt2_ini()

subroutine i24ispt2_ini ( integer jlt,
integer, dimension(*) nsv,
integer, dimension(*) cand_n,
integer nsn,
integer, dimension(5,*) irtse,
integer, dimension(2,*) is2se,
integer, dimension(*) ispt2,
integer, dimension(*) isegpt,
integer, dimension(2,*) irtlm,
integer nsne,
integer nrtse,
integer iedg4,
integer nin )

Definition at line 808 of file i24cor3.F.

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
tri7box::isegpt_fi
type(int_pointer), dimension(:), allocatable isegpt_fi
Definition tri7box.F:539
tri7box::irtlm_fi
type(int_pointer2), dimension(:), allocatable irtlm_fi
Definition tri7box.F:533

◆ i24ispt2_ini_opttri()

subroutine i24ispt2_ini_opttri ( integer jft,
integer jlt,
integer, dimension(*) nsv,
integer, dimension(*) cand_n,
integer nsn,
integer, dimension(5,*) irtse,
integer, dimension(2,*) is2se,
integer, dimension(*) ispt2,
integer, dimension(*) isegpt,
integer, dimension(2,*) irtlm,
integer nsne,
integer nrtse,
integer iedg4,
integer nin )

Definition at line 889 of file i24cor3.F.

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

◆ i_cor_epfit3()

subroutine i_cor_epfit3 ( integer jlt,
intent(in) stfe,
intent(inout) stif,
integer, dimension(mvsiz), intent(in) cand_s,
integer, dimension(mvsiz), intent(in) cand_m,
integer nedge,
integer nin,
integer inacti,
integer ncfit,
intent(in) tncy )

Definition at line 1056 of file i24cor3.F.

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
tri7box::stifie
type(real_pointer), dimension(:), allocatable stifie
Definition tri7box.F:449

◆ i_corpfit3()

subroutine i_corpfit3 ( integer jlt,
stf,
stfn,
stif,
integer nsn,
integer, dimension(*) cand_e,
integer, dimension(*) cand_n,
integer nin,
integer igsti,
kmin,
kmax,
integer inacti,
integer ncfit,
tncy,
integer, dimension(mvsiz), intent(inout) iknon )

Definition at line 951 of file i24cor3.F.

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