OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
i20sti3.F File Reference
#include "implicit_f.inc"
#include "param_c.inc"
#include "com01_c.inc"
#include "com04_c.inc"
#include "scr05_c.inc"
#include "scr08_c.inc"
#include "units_c.inc"
#include "scr23_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine i20sti3 (pm, geo, x, ms, ixs, ixc, ixtg, ixt, ixp, wa, nint, nty, noint, nrt, nsn, irect, nsv, inacti, gap, igap, gap_s, gap_m, gapmin, gapinf, gapmax, stfac, stf, stfn, knod2els, knod2elc, knod2eltg, nod2els, nod2elc, nod2eltg, igrsurf1, ifs2, igrsurf2, intth, ieles, ielec, areas, ipartc, iparttg, thk, thk_part, gap_sh, xanew, gapshmax, nbinflg, mbinflg, nln, nlg, gapsol, ixs10, ixs16, ixs20, id, titr, igeo, pm_stack, iworksh)
subroutine i20sti3e (x, ixlin, stf, ixs, pm, geo, nrt, ixc, nintr, slsfac, nty, gapmax, noint, gap_sm, ms, ixtg, ixt, ixp, ixr, igap, gapmin, gap0, gapinf, nsne, ipartc, iparttg, thk, thk_part, ixs10, id, titr, kxx, ixx, igeo, nod2el1d, knod2el1d, knod2els, knod2elc, knod2eltg, nod2els, nod2elc, nod2eltg, lelx, pm_stack, iworksh)
subroutine i20nlg (nln, nrtm, nsn, nlins, nlinm, nlg, irect, nsv, ixlins, ixlinm, nmn, nsne, nmne, msr, nsve, msre, stfa, dxanc, xanew, x, penia, alphak)

Function/Subroutine Documentation

◆ i20nlg()

subroutine i20nlg ( integer nln,
integer nrtm,
integer nsn,
integer nlins,
integer nlinm,
integer, dimension(nln) nlg,
integer, dimension(4,nrtm) irect,
integer, dimension(nsn) nsv,
integer, dimension(2,nlins) ixlins,
integer, dimension(2,nlinm) ixlinm,
integer nmn,
integer nsne,
integer nmne,
integer, dimension(nmn) msr,
integer, dimension(nsne) nsve,
integer, dimension(nmne) msre,
stfa,
dxanc,
xanew,
x,
penia,
alphak )

Definition at line 1365 of file i20sti3.F.

1370C-----------------------------------------------
1371C I m p l i c i t T y p e s
1372C-----------------------------------------------
1373#include "implicit_f.inc"
1374C-----------------------------------------------
1375C C o m m o n B l o c k s
1376C-----------------------------------------------
1377#include "com04_c.inc"
1378C-----------------------------------------------
1379C D u m m y A r g u m e n t s
1380C-----------------------------------------------
1381 INTEGER NLN,NRTM, NSN,NLINS ,NLINM ,NMN ,NSNE ,NMNE
1382 INTEGER IRECT(4,NRTM), NSV(NSN),IXLINS(2,NLINS),IXLINM(2,NLINM),
1383 . MSR(NMN),NSVE(NSNE),MSRE(NMNE),NLG(NLN)
1384 my_real
1385 . stfa(*),dxanc(3,*),xanew(3,*),x(3,*),penia(5,*),alphak(3,*)
1386C-----------------------------------------------
1387C L o c a l V a r i a b l e s
1388C-----------------------------------------------
1389 INTEGER I,J,K
1390 INTEGER TAG(NUMNOD)
1391 my_real
1392 . aaa,stif(nln)
1393
1394 DO i=1,nln
1395 j = nlg(i)
1396 tag(j)=i
1397 ENDDO
1398
1399 DO k=1,nsn
1400 nsv(k)=tag(nsv(k))
1401 ENDDO
1402 DO k=1,nmn
1403 msr(k)=tag(msr(k))
1404 ENDDO
1405 DO k=1,nsne
1406 nsve(k)=tag(nsve(k))
1407 ENDDO
1408 DO k=1,nmne
1409 msre(k)=tag(msre(k))
1410 ENDDO
1411
1412 DO k=1,nrtm
1413 irect(1,k)=tag(irect(1,k))
1414 irect(2,k)=tag(irect(2,k))
1415 irect(3,k)=tag(irect(3,k))
1416 irect(4,k)=tag(irect(4,k))
1417 ENDDO
1418 DO k=1,nlins
1419 ixlins(1,k)=tag(ixlins(1,k))
1420 ixlins(2,k)=tag(ixlins(2,k))
1421 ENDDO
1422 DO k=1,nlinm
1423 ixlinm(1,k)=tag(ixlinm(1,k))
1424 ixlinm(2,k)=tag(ixlinm(2,k))
1425 ENDDO
1426
1427 DO i=1,nln
1428 stif(i) = one
1429 alphak(1,i) = one
1430 alphak(2,i) = one
1431 alphak(3,i) = one
1432 ENDDO
1433
1434 DO i=1,nsn
1435c In input stfa (1: nln) is STFN (1: nsn) Possibly put to zero if pene initial
1436 j = nsv(i)
1437 stif(j) = stfa(i)
1438 ENDDO
1439
1440 DO i=1,nln
1441 stfa(i) = stif(i)
1442 ENDDO
1443
1444c STFA sera recalcule in I20STIFN /inter3d1/i20stifn.F
1445 DO i=1,nln
1446 dxanc(1,i) = xanew(1,nlg(i))-x(1,nlg(i))
1447 dxanc(2,i) = xanew(2,nlg(i))-x(2,nlg(i))
1448 dxanc(3,i) = xanew(3,nlg(i))-x(3,nlg(i))
1449 penia(4,i) = sqrt(dxanc(1,i)*dxanc(1,i)
1450 + +dxanc(2,i)*dxanc(2,i)
1451 + +dxanc(3,i)*dxanc(3,i))
1452 penia(5,i) = penia(4,i)
1453 aaa = one/max(penia(4,i),em20)
1454 penia(1,i) = dxanc(1,i)*aaa
1455 penia(2,i) = dxanc(2,i)*aaa
1456 penia(3,i) = dxanc(3,i)*aaa
1457 ENDDO
1458
1459 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
max
#define max(a, b)
Definition macros.h:21

◆ i20sti3()

subroutine i20sti3 ( pm,
geo,
x,
ms,
integer, dimension(nixs,*) ixs,
integer, dimension(nixc,*) ixc,
integer, dimension(nixtg,*) ixtg,
integer, dimension(nixt,*) ixt,
integer, dimension(nixp,*) ixp,
wa,
integer nint,
integer nty,
integer noint,
integer nrt,
integer nsn,
integer, dimension(4,*) irect,
integer, dimension(*) nsv,
integer inacti,
gap,
integer igap,
gap_s,
gap_m,
gapmin,
gapinf,
gapmax,
stfac,
stf,
stfn,
integer, dimension(*) knod2els,
integer, dimension(*) knod2elc,
integer, dimension(*) knod2eltg,
integer, dimension(*) nod2els,
integer, dimension(*) nod2elc,
integer, dimension(*) nod2eltg,
type (surf_) igrsurf1,
integer ifs2,
type (surf_) igrsurf2,
integer intth,
integer, dimension(*) ieles,
integer, dimension(*) ielec,
areas,
integer, dimension(*) ipartc,
integer, dimension(*) iparttg,
thk,
thk_part,
gap_sh,
xanew,
gapshmax,
integer, dimension(*) nbinflg,
integer, dimension(*) mbinflg,
integer nln,
integer, dimension(*) nlg,
gapsol,
integer, dimension(6,*) ixs10,
integer, dimension(*) ixs16,
integer, dimension(*) ixs20,
integer id,
character(len=nchartitle) titr,
integer, dimension(npropgi,*) igeo,
pm_stack,
integer, dimension(3,*) iworksh )

Definition at line 41 of file i20sti3.F.

58C-----------------------------------------------
59C M o d u l e s
60C-----------------------------------------------
61 USE groupdef_mod
62 USE message_mod
63 USE names_and_titles_mod , ONLY : nchartitle
64 use element_mod , only : nixs,nixc,nixtg,nixt,nixp
65C-----------------------------------------------
66C I m p l i c i t T y p e s
67C-----------------------------------------------
68#include "implicit_f.inc"
69C-----------------------------------------------
70C C o m m o n B l o c k s
71C-----------------------------------------------
72#include "param_c.inc"
73#include "com01_c.inc"
74#include "com04_c.inc"
75#include "scr05_c.inc"
76#include "scr08_c.inc"
77C-----------------------------------------------
78C D u m m y A r g u m e n t s
79C-----------------------------------------------
80 INTEGER NRT, NINT, NTY, NOINT,NSN,IGAP,
81 . INACTI,IFS2,NLN
82 INTEGER IRECT(4,*), IXS(NIXS,*), IXC(NIXC,*),
83 . NSV(*), IXTG(NIXTG,*), IXT(NIXT,*), IXP(NIXP,*),
84 . KNOD2ELS(*), KNOD2ELC(*), KNOD2ELTG(*), NOD2ELS(*), NOD2ELC(*),
85 . NOD2ELTG(*),IELES(*),INTTH,IELEC(*),
86 . IPARTC(*), IPARTTG(*),NBINFLG(*),MBINFLG(*),NLG(*) ,
87 . IXS10(6,*), IXS16(*), IXS20(*), IGEO(NPROPGI,*),IWORKSH(3,*)
88C REAL
89 my_real
90 . stfac, gap,gapmin,gapinf, gapmax,gapshmax,gapsolidmax,gapsol
91C REAL
92 my_real
93 . x(3,*), stf(*), pm(npropm,*), geo(npropg,*), stfn(*),
94 . ms(*),wa(*),gap_s(*),gap_m(*),gap_sh(*),areas(*),
95 . thk(*),thk_part(*),xanew(3,*),pm_stack(20,*)
96 INTEGER ID
97 CHARACTER(LEN=NCHARTITLE) :: TITR
98 TYPE (SURF_) :: IGRSURF1
99 TYPE (SURF_) :: IGRSURF2
100C-----------------------------------------------
101C L o c a l V a r i a b l e s
102C-----------------------------------------------
103 INTEGER NDX, I, J, INRT, NELS, MT, JJ, JJJ, NELC,
104 . MG, L, NELTG,IE,IP,NM1,
105 . IGTYP,IPGMAT,IGMAT,ISUBSTACK
106C REAL
107 my_real
108 . dxm, gapmx, gapmn, area, vol, dx,gaps1,gaps2, gapm,
109 . gaptmp, gapscale,sx1,sy1,sz1,sx2,sy2,sz2,sx3,sy3,sz3,
110 . slsfac,gapinfs,gapinfm,gapsups,gapsupm,st
111 INTEGER TAG(NUMNOD)
112 INTEGER BITUNSET,BITGET,BITSET
113 EXTERNAL bitunset,bitget,bitset
114C--------------------------------------------------------------
115C CALCULATION OF SEGMENT STIFFNESSES
116C V16 : IN THE CASE WHERE ONE SEGMENT BELONGS BOTH
117C TO A BRICK AND A SHELL, THE SHELL STIFFNESS IS CHOSEN
118C OF THE SHELL UNLESS THE SHELL MATERIAL IS NULL.
119C---------------------------------------------------------------
120
121C---------------------------------------------------------------
122 slsfac = one
123C---------------------------------------------------------------
124 ipgmat = 700
125 igmat = 0
126 DO i=1,numnod
127 xanew(1,i)=x(1,i)
128 xanew(2,i)=x(2,i)
129 xanew(3,i)=x(3,i)
130 tag(i)=0
131 ENDDO
132 dxm=0.
133 ndx=0
134 gapsolidmax=ep30
135 gapmx=ep30
136 gapmn=ep30
137 gaps1=zero
138 gaps2=zero
139 IF(igap==2)THEN
140 igap = 1
141 gapscale = gapmin
142 gapmin = zero
143 ELSE
144 gapscale = one
145 ENDIF
146C------------------------------------
147C GAP NODES SECONDS
148C------------------------------------
149 IF(igap>=1)THEN
150 DO i=1,numnod
151 wa(i)=zero
152 ENDDO
153 DO i=1,numelc
154 mg=ixc(6,i)
155 igtyp = igeo(11,mg)
156 ip = ipartc(i)
157 IF ( thk_part(ip) /= zero .AND. iintthick == 0) THEN
158 dx=half*thk_part(ip)
159 ELSEIF ( thk(i) /= zero .AND. iintthick == 0) THEN
160 dx=half*thk(i)
161 ELSEIF(igtyp == 17 .OR. igtyp == 51 .OR.igtyp == 52)THEN
162 dx=half*thk(i)
163 ELSE
164 dx=half*geo(1,mg)
165 ENDIF
166 wa(ixc(2,i))=max(wa(ixc(2,i)),dx)
167 wa(ixc(3,i))=max(wa(ixc(3,i)),dx)
168 wa(ixc(4,i))=max(wa(ixc(4,i)),dx)
169 wa(ixc(5,i))=max(wa(ixc(5,i)),dx)
170 ENDDO
171 DO i=1,numeltg
172 mg=ixtg(5,i)
173 igtyp = igeo(11,mg)
174 ip = iparttg(i)
175 IF ( thk_part(ip) /= zero .AND. iintthick == 0) THEN
176 dx=half*thk_part(ip)
177 ELSEIF (thk(numelc+i)/=zero .AND. iintthick==0) THEN
178 dx=half*thk(numelc+i)
179 ELSEIF(igtyp == 17 .OR. igtyp == 51 .OR. igtyp == 52) THEN
180 dx=half*thk(numelc+i)
181 ELSE
182 dx=half*geo(1,mg)
183 ENDIF
184 wa(ixtg(2,i))=max(wa(ixtg(2,i)),dx)
185 wa(ixtg(3,i))=max(wa(ixtg(3,i)),dx)
186 wa(ixtg(4,i))=max(wa(ixtg(4,i)),dx)
187 ENDDO
188 DO i=1,numelt
189 mg=ixt(4,i)
190 dx=half*sqrt(geo(1,mg))
191 wa(ixt(2,i))=max(wa(ixt(2,i)),dx)
192 wa(ixt(3,i))=max(wa(ixt(3,i)),dx)
193 ENDDO
194 DO i=1,numelp
195 mg=ixp(5,i)
196 dx=0.5*sqrt(geo(1,mg))
197 wa(ixp(2,i))=max(wa(ixp(2,i)),dx)
198 wa(ixp(3,i))=max(wa(ixp(3,i)),dx)
199 ENDDO
200 DO i=1,nsn
201 gap_s(i)=gapscale * wa(nsv(i))
202 gaps1=max(gaps1,gap_s(i))
203 ENDDO
204 ENDIF
205C
206C calculation of the second surface. ---
207 IF(intth > 0 ) THEN
208 DO i = 1,nsn
209 areas(i) = zero
210 DO j= knod2elc(nsv(i))+1,knod2elc(nsv(i)+1)
211 ie = nod2elc(j)
212 sx1 = x(1,ixc(4,ie)) - x(1,ixc(2,ie))
213 sy1 = x(2,ixc(4,ie)) - x(2,ixc(2,ie))
214 sz1 = x(3,ixc(4,ie)) - x(3,ixc(2,ie))
215 sx2 = x(1,ixc(5,ie)) - x(1,ixc(3,ie))
216 sy2 = x(2,ixc(5,ie)) - x(2,ixc(3,ie))
217 sz2 = x(3,ixc(5,ie)) - x(3,ixc(3,ie))
218 sx3 = sy1*sz2 - sz1*sy2
219 sy3 = sz1*sx2 - sx1*sz2
220 sz3 = sx1*sy2 - sy1*sx2
221 areas(i) = areas(i) + one_over_8*sqrt(sx3*sx3+sy3*sy3+sz3*sz3)
222 ENDDO
223 ielec(i) = ixc(1,ie)
224 ENDDO
225 ENDIF
226C
227C------------------------------------
228C STIF NODES SECONDS
229C------------------------------------
230 IF(slsfac >= zero)THEN
231 DO i=1,numelc
232 mg=ixc(6,i)
233 igtyp = igeo(11,mg)
234 ip = ipartc(i)
235 IF ( thk_part(ip) /= zero .AND. iintthick == 0) THEN
236 dx=half*thk_part(ip)
237 ELSEIF ( thk(i) /= zero .AND. iintthick == 0) THEN
238 dx=half*thk(i)
239 ELSEIF(igtyp == 17 .OR. igtyp == 51 .OR. igtyp == 52)THEN
240 dx=half*thk(i)
241 ELSE
242 dx=half*geo(1,mg)
243 ENDIF
244 wa(ixc(2,i))=max(wa(ixc(2,i)),dx)
245 wa(ixc(3,i))=max(wa(ixc(3,i)),dx)
246 wa(ixc(4,i))=max(wa(ixc(4,i)),dx)
247 wa(ixc(5,i))=max(wa(ixc(5,i)),dx)
248 ENDDO
249 DO i=1,numeltg
250 mg=ixtg(5,i)
251 igtyp = igeo(11,mg)
252 ip = iparttg(i)
253 IF ( thk_part(ip) /= zero .AND. iintthick == 0) THEN
254 dx=half*thk_part(ip)
255 ELSEIF (thk(numelc+i)/=zero .AND. iintthick==0) THEN
256 dx=half*thk(numelc+i)
257 ELSEIF(igtyp == 17 .OR. igtyp == 51 .OR. igtyp == 52)THEN
258 dx=half*thk(numelc+i)
259 ELSE
260 dx=half*geo(1,mg)
261 ENDIF
262 wa(ixtg(2,i))=max(wa(ixtg(2,i)),dx)
263 wa(ixtg(3,i))=max(wa(ixtg(3,i)),dx)
264 wa(ixtg(4,i))=max(wa(ixtg(4,i)),dx)
265 ENDDO
266 DO i=1,numelt
267 mg=ixt(4,i)
268 dx=half*sqrt(geo(1,mg))
269 wa(ixt(2,i))=max(wa(ixt(2,i)),dx)
270 wa(ixt(3,i))=max(wa(ixt(3,i)),dx)
271 ENDDO
272 DO i=1,numelp
273 mg=ixp(5,i)
274 dx=0.5*sqrt(geo(1,mg))
275 wa(ixp(2,i))=max(wa(ixp(2,i)),dx)
276 wa(ixp(3,i))=max(wa(ixp(3,i)),dx)
277 ENDDO
278 ! new interface buffer development : GAP_S not sized when IGAP=0 (cf bufintr)
279
280c DO I=1,NSN
281c GAP_S(I)=GAPSCALE * WA(NSV(I))
282c GAPS1=MAX(GAPS1,GAP_S(I))
283c ENDDO
284 ENDIF
285
286C------------------------------------
287C SHELL OR SOLID SURFACE
288C------------------------------------
289C------------------------------------
290C STIF FACES MAIN
291C------------------------------------
292
293 DO 500 i=1,nrt
294 stf(i)=zero
295 IF(intth > 0 ) ieles(i) = 0
296 IF(slsfac<zero)THEN
297 stf(i)=slsfac
298 ENDIF
299 gap_sh(i)=zero
300 gapm =zero
301 inrt=i
302 CALL i4gmx3(x,irect,inrt,gapmx)
303C----------------------
304 nm1=igrsurf1%NSEG
305 IF(inrt <= nm1)THEN
306 CALL i20nelts(x ,irect(1,inrt),ixs ,nint,nels ,
307 . inrt ,area ,noint,0 ,igrsurf1%ELTYP,
308 . igrsurf1%ELEM)
309 ELSE
310 CALL i20nelts(x ,irect(1,inrt),ixs ,nint,nels ,
311 . inrt-nm1 ,area ,noint,0 ,igrsurf2%ELTYP,
312 . igrsurf2%ELEM)
313 ENDIF
314 IF(nels /= 0)THEN
315 mt=ixs(1,nels)
316 IF(mt>0)THEN
317 DO jj=1,8
318 jjj=ixs(jj+1,nels)
319 xc(jj)=x(1,jjj)
320 yc(jj)=x(2,jjj)
321 zc(jj)=x(3,jjj)
322 END DO
323 CALL volint(vol)
324 stf(i)=slsfac*area*area*pm(100,mt)/vol
325 ELSE
326 IF(nint>=0) THEN
327 CALL ancmsg(msgid=95,
328 . msgtype=msgwarning,
329 . anmode=aninfo_blind_2,
330 . i1=id,
331 . c1=titr,
332 . i2=ixs(nixs,nels),
333 . c2='SOLID',
334 . i3=i)
335 ENDIF
336 IF(nint<0) THEN
337 CALL ancmsg(msgid=96,
338 . msgtype=msgwarning,
339 . anmode=aninfo_blind_2,
340 . i1=id,
341 . c1=titr,
342 . i2=ixs(nixs,nels),
343 . c2='SOLID',
344 . i3=i)
345 ENDIF
346 ENDIF
347 IF(igap/=0)THEN
348 gap_sh(i)=min(vol/area,sqrt(area))/six
349 gapsolidmax = min(gapsolidmax,vol/(area*four))
350 gapmn=min(gapmn,half*gap_sh(i))
351 gap_m(i)=zero
352 tag(irect(1,inrt)) = 1
353 tag(irect(2,inrt)) = 1
354 tag(irect(3,inrt)) = 1
355 tag(irect(4,inrt)) = 1
356c NBINFLG(IRECT(1,INRT))=BITUNSET(NBINFLG(IRECT(1,INRT)),7)
357c NBINFLG(IRECT(2,INRT))=BITUNSET(NBINFLG(IRECT(2,INRT)),7)
358c NBINFLG(IRECT(3,INRT))=BITUNSET(NBINFLG(IRECT(3,INRT)),7)
359c NBINFLG(IRECT(4,INRT))=BITUNSET(NBINFLG(IRECT(4,INRT)),7)
360 ENDIF
361 mbinflg(i)=bitset(mbinflg(i),8)
362 GO TO 500
363 ELSE
364 IF(inrt <= nm1)THEN
365 CALL ineltc(nelc ,neltg ,inrt ,igrsurf1%ELTYP,igrsurf1%ELEM)
366 ELSE
367 CALL ineltc(nelc ,neltg ,inrt-nm1,igrsurf2%ELTYP,igrsurf2%ELEM)
368 ENDIF
369 IF(neltg/=0) THEN
370 mt=ixtg(1,neltg)
371 mg=ixtg(5,neltg)
372 igtyp = igeo(11,mg)
373 ip = iparttg(neltg)
374 IF ( thk_part(ip) /= zero .AND. iintthick == 0) THEN
375 dx=thk_part(ip)*gapscale
376 ELSEIF(thk(numelc+neltg)/=zero.AND.iintthick==0)THEN
377 dx=thk(numelc+neltg)*gapscale
378 ELSEIF(igtyp == 17 .OR. igtyp == 51 .OR. igtyp == 52)THEN
379 dx=thk(numelc+neltg)*gapscale
380 ELSE
381 dx=geo(1,mg)*gapscale
382 ENDIF
383 gapm=half*dx
384 gaps2=max(gaps2,gapm)
385 gapmn = min(gapmn,dx)
386 dxm=dxm+dx
387 ndx=ndx+1
388 igmat = igeo(98,mg)
389 IF(mt>0)THEN
390 IF(igtyp == 11 .AND. igmat > 0) THEN
391 IF ( thk(numelc+neltg) /=zero.AND.iintthick==0)THEN
392 stf(i)=slsfac*thk(numelc+neltg)*geo(ipgmat + 2 ,mg)
393 ELSE
394 stf(i)=slsfac*geo(1,mg)*geo(ipgmat + 2 ,mg)
395 ENDIF
396 ELSEIF(igtyp == 52 .OR.
397 . ((igtyp == 17 .OR. igtyp == 51) .AND. igmat > 0))THEN
398 isubstack = iworksh(3,numelc+neltg)
399 st=pm_stack(2,isubstack)
400 stf(i)=slsfac*thk(numelc+neltg)*st
401 ELSE
402 IF ( thk(numelc+neltg) /=zero.AND.iintthick==0)THEN
403 stf(i)=slsfac*thk(numelc+neltg)*pm(20,mt)
404 ELSEIF(igtyp == 17 .OR. igtyp == 51) THEN
405 stf(i)=slsfac*thk(numelc+neltg)*pm(20,mt)
406 ELSE
407 stf(i)=slsfac*geo(1,mg)*pm(20,mt)
408 ENDIF
409 ENDIF
410 ELSE
411 IF(nint>=0) THEN
412 CALL ancmsg(msgid=95,
413 . msgtype=msgwarning,
414 . anmode=aninfo_blind_2,
415 . i1=id,
416 . c1=titr,
417 . i2=ixtg(nixtg,neltg),
418 . c2='SHELL',
419 . i3=i)
420 END IF
421 IF(nint<0) THEN
422 CALL ancmsg(msgid=96,
423 . msgtype=msgwarning,
424 . anmode=aninfo_blind_2,
425 . i1=id,
426 . c1=titr,
427 . i2=ixtg(nixtg,neltg),
428 . c2='SHELL',
429 . i3=i)
430 END IF
431 END IF
432 IF(igap/=0) gap_m(i)=gapm
433 mbinflg(i)=bitset(mbinflg(i),3)
434 GO TO 500
435 ELSEIF(nelc/=0) THEN
436 mt=ixc(1,nelc)
437 mg=ixc(6,nelc)
438 igtyp = igeo(11,mg)
439 ip = ipartc(nelc)
440 igmat = igeo(99,mg)
441 IF ( thk_part(ip) /= zero .AND. iintthick == 0) THEN
442 dx=thk_part(ip)*gapscale
443 ELSEIF ( thk(nelc) /= zero .AND. iintthick == 0) THEN
444 dx=thk(nelc)*gapscale
445 ELSEIF(igtyp == 17 .OR. igtyp == 51 .OR. igtyp == 52) THEN
446 dx=thk(nelc)*gapscale
447 ELSE
448 dx=geo(1,mg)*gapscale
449 ENDIF
450 gapm=half*dx
451 gaps2=max(gaps2,gapm)
452 gapmn = min(gapmn,dx)
453 dxm=dxm+dx
454 ndx=ndx+1
455 IF(mt>0)THEN
456 IF(igtyp == 11 .AND. igmat > 0) THEN
457 IF ( thk(nelc) /= zero .AND. iintthick == 0) THEN
458 stf(i)=slsfac*thk(nelc)*geo(ipgmat + 2 ,mg)
459 ELSE
460 stf(i)=slsfac*geo(1,mg)*geo(ipgmat + 2 ,mg)
461 ENDIF
462 ELSEIF(igtyp==52 .OR.
463 . ((igtyp == 17 .OR. igtyp == 51) .AND. igmat > 0))THEN
464 isubstack = iworksh(3,nelc)
465 st=pm_stack(2,isubstack)
466 stf(i)=slsfac*thk(nelc)*st
467 ELSE
468 IF ( thk(nelc) /= zero .AND. iintthick == 0) THEN
469 stf(i)=slsfac*thk(nelc)*pm(20,mt)
470 ELSEIF(igtyp == 17) THEN
471 stf(i)=slsfac*thk(nelc)*pm(20,mt)
472 ELSE
473 stf(i)=slsfac*geo(1,mg)*pm(20,mt)
474 ENDIF
475 ENDIF
476 ELSE
477 IF(nint>=0) THEN
478 CALL ancmsg(msgid=95,
479 . msgtype=msgwarning,
480 . anmode=aninfo_blind_2,
481 . i1=id,
482 . c1=titr,
483 . i2=ixc(nixc,nelc),
484 . c2='SHELL',
485 . i3=i)
486 END IF
487 IF(nint<0) THEN
488 CALL ancmsg(msgid=96,
489 . msgtype=msgwarning,
490 . anmode=aninfo_blind_2,
491 . i1=id,
492 . c1=titr,
493 . i2=ixc(nixc,nelc),
494 . c2='SHELL',
495 . i3=i)
496 END IF
497 END IF
498 IF(igap/=0) gap_m(i)=gapm
499 mbinflg(i)=bitset(mbinflg(i),4)
500 GO TO 500
501 END IF
502 END IF
503C----------------------
504C SEGMENT SURFACE
505C----------------------
506C----------------------
507C ELEMENTS SOLIDES
508C----------------------
509 CALL insol3(x,irect,ixs,nint,nels,inrt,
510 . area,noint,knod2els ,nod2els ,0,ixs10,
511 . ixs16,ixs20)
512 IF(nels/=0) THEN
513 gapm=zero
514 mt=ixs(1,nels)
515 IF(intth > 0 ) ieles(i) = nels
516 IF(mt>0)THEN
517 DO 100 jj=1,8
518 jjj=ixs(jj+1,nels)
519 xc(jj)=x(1,jjj)
520 yc(jj)=x(2,jjj)
521 zc(jj)=x(3,jjj)
522 100 CONTINUE
523 CALL volint(vol)
524 stf(i)=slsfac*area*area*pm(100,mt)/vol
525 ELSE
526 IF(nint>=0) THEN
527 CALL ancmsg(msgid=95,
528 . msgtype=msgwarning,
529 . anmode=aninfo_blind_2,
530 . i1=id,
531 . c1=titr,
532 . i2=ixs(nixs,nels),
533 . c2='SOLID',
534 . i3=i)
535 ENDIF
536 IF(nint<0) THEN
537 CALL ancmsg(msgid=96,
538 . msgtype=msgwarning,
539 . anmode=aninfo_blind_2,
540 . i1=id,
541 . c1=titr,
542 . i2=ixs(nixs,nels),
543 . c2='SOLID',
544 . i3=i)
545 ENDIF
546 ENDIF
547 IF(igap/=0)THEN
548 gap_sh(i)=min(vol/area,sqrt(area))/six
549 gapsolidmax = min(gapsolidmax,vol/(area*four))
550 gapmn=min(gapmn,half*gap_sh(i))
551 gap_m(i)=zero
552 tag(irect(1,inrt)) = 1
553 tag(irect(2,inrt)) = 1
554 tag(irect(3,inrt)) = 1
555 tag(irect(4,inrt)) = 1
556c NBINFLG(IRECT(1,INRT))=BITUNSET(NBINFLG(IRECT(1,INRT)),7)
557c NBINFLG(IRECT(2,INRT))=BITUNSET(NBINFLG(IRECT(2,INRT)),7)
558c NBINFLG(IRECT(3,INRT))=BITUNSET(NBINFLG(IRECT(3,INRT)),7)
559c NBINFLG(IRECT(4,INRT))=BITUNSET(NBINFLG(IRECT(4,INRT)),7)
560 ENDIF
561 mbinflg(i)=bitset(mbinflg(i),8)
562 ENDIF
563C---------------------
564C ELEMENTS COQUES
565C---------------------
566 CALL incoq3(irect,ixc ,ixtg ,nint ,nelc ,
567 . neltg,inrt,geo ,pm ,knod2elc ,
568 . knod2eltg ,nod2elc ,nod2eltg,thk,nty,igeo,
569 . pm_stack , iworksh)
570 IF(neltg/=0) THEN
571C
572 mt=ixtg(1,neltg)
573 mg=ixtg(5,neltg)
574 igtyp = igeo(11,mg)
575 ip = iparttg(neltg)
576 IF ( thk_part(ip) /= zero .AND. iintthick == 0) THEN
577 dx=thk_part(ip)*gapscale
578 ELSEIF ( thk(numelc+neltg) /= zero .AND. iintthick == 0)THEN
579 dx=thk(numelc+neltg)*gapscale
580 ELSEIF(igtyp ==17) THEN
581 dx=thk(numelc+neltg)*gapscale
582 ELSE
583 dx=geo(1,mg)*gapscale
584 ENDIF
585 gapm=half*dx
586 gaps2=max(gaps2,gapm)
587 gapmn = min(gapmn,dx)
588 dxm=dxm+dx
589 ndx=ndx+1
590 igmat = igeo(98,mg)
591 IF(mt>0)THEN
592 IF(igtyp == 11 .AND. igmat > 0) THEN
593 IF ( thk(numelc+neltg) /= zero .AND. iintthick == 0) THEN
594 stf(i)=slsfac*thk(numelc+neltg)*geo(ipgmat + 2 ,mg)
595 ELSE
596 stf(i)=slsfac*geo(1,mg)*geo(ipgmat + 2 ,mg)
597 ENDIF
598 ELSEIF(igtyp==52 .OR.
599 . ((igtyp == 17 .OR. igtyp == 51) .AND. igmat > 0))THEN
600 isubstack = iworksh(3,numelc+neltg)
601 st=pm_stack(2,isubstack)
602 stf(i)=slsfac*thk(numelc+neltg)*st
603 ELSE
604 IF ( thk(numelc+neltg) /= zero .AND. iintthick == 0) THEN
605 stf(i)=slsfac*thk(numelc+neltg)*pm(20,mt)
606 ELSEIF(igtyp == 17) THEN
607 stf(i)=slsfac*thk(numelc+neltg)*pm(20,mt)
608 ELSE
609 stf(i)=slsfac*geo(1,mg)*pm(20,mt)
610 ENDIF
611 ENDIF
612 ELSE
613 IF(nint>=0) THEN
614 CALL ancmsg(msgid=95,
615 . msgtype=msgwarning,
616 . anmode=aninfo_blind_2,
617 . i1=id,
618 . c1=titr,
619 . i2=ixtg(nixtg,neltg),
620 . c2='SHELL',
621 . i3=i)
622 ENDIF
623 IF(nint<0) THEN
624 CALL ancmsg(msgid=96,
625 . msgtype=msgwarning,
626 . anmode=aninfo_blind_2,
627 . i1=id,
628 . c1=titr,
629 . i2=ixtg(nixtg,neltg),
630 . c2='SHELL',
631 . i3=i)
632 ENDIF
633 ENDIF
634 IF(igap/=0) gap_m(i)=gapm
635 mbinflg(i)=bitset(mbinflg(i),3)
636 ELSEIF(nelc/=0) THEN
637 mt=ixc(1,nelc)
638 mg=ixc(6,nelc)
639 igtyp = igeo(11,mg)
640 ip = ipartc(nelc)
641 IF ( thk_part(ip) /= zero .AND. iintthick == 0) THEN
642 dx=thk_part(ip)*gapscale
643 ELSEIF ( thk(nelc) /= zero .AND. iintthick == 0) THEN
644 dx=thk(nelc)*gapscale
645 ELSEIF(igtyp ==17) THEN
646 dx=thk(nelc)*gapscale
647 ELSE
648 dx=geo(1,mg)*gapscale
649 ENDIF
650 gapm=half*dx
651 gaps2=max(gaps2,gapm)
652 gapmn = min(gapmn,dx)
653 dxm=dxm+dx
654 ndx=ndx+1
655 igmat = igeo(98,mg)
656 IF(mt>0)THEN
657 IF(igtyp == 11 .AND. igmat > 0) THEN
658 IF ( thk(nelc) /= zero .AND. iintthick == 0) THEN
659 stf(i)=slsfac*thk(nelc)*geo(ipgmat + 2 ,mg)
660 ELSE
661 stf(i)=slsfac*geo(1,mg)*geo(ipgmat + 2 ,mg)
662 ENDIF
663 ELSEIF(igtyp==52 .OR.
664 . ((igtyp == 17 .OR. igtyp == 51) .AND. igmat > 0))THEN
665 isubstack = iworksh(3,nelc)
666 st=pm_stack(2,isubstack)
667 stf(i)=slsfac*thk(nelc)*st
668 ELSE
669 IF ( thk(nelc) /= zero .AND. iintthick == 0) THEN
670 stf(i)=slsfac*thk(nelc)*pm(20,mt)
671 ELSEIF(igtyp ==17) THEN
672 stf(i)=slsfac*thk(nelc)*pm(20,mt)
673 ELSE
674 stf(i)=slsfac*geo(1,mg)*pm(20,mt)
675 ENDIF
676 ENDIF
677 ELSE
678 IF(nint>=0) THEN
679 CALL ancmsg(msgid=95,
680 . msgtype=msgwarning,
681 . anmode=aninfo_blind_2,
682 . i1=id,
683 . c1=titr,
684 . i2=ixc(nixc,nelc),
685 . c2='SHELL',
686 . i3=i)
687 ENDIF
688 IF(nint<0) THEN
689 CALL ancmsg(msgid=96,
690 . msgtype=msgwarning,
691 . anmode=aninfo_blind_2,
692 . i1=id,
693 . c1=titr,
694 . i2=ixc(nixc,nelc),
695 . c2='SHELL',
696 . i3=i)
697 ENDIF
698 ENDIF
699 IF(igap/=0) gap_m(i)=gapm
700 mbinflg(i)=bitset(mbinflg(i),4)
701 ENDIF
702C
703 IF(nels+nelc+neltg==0)THEN
704
705C In SPMD you need an element associated with the edge otherwise error
706 IF(nint>0) THEN
707 CALL ancmsg(msgid=481,
708 . msgtype=msgerror,
709 . anmode=aninfo_blind_2,
710 . i1=id,
711 . c1=titr,
712 . i2=i)
713 ENDIF
714 IF(nint<0) THEN
715 CALL ancmsg(msgid=482,
716 . msgtype=msgerror,
717 . anmode=aninfo_blind_2,
718 . i1=id,
719 . c1=titr,
720 . i2=i)
721 ENDIF
722
723 ENDIF
724 500 CONTINUE
725C---------------------------
726C GAP
727C---------------------------
728 gapmx=sqrt(gapmx)
729 IF(igap==0)THEN
730C GAP FIXE
731 IF(gap<=zero)THEN
732 IF(ndx/=0)THEN
733 gap = dxm/ndx
734 gap = min(half*gapmx,gap)
735 ELSE
736 gap = em01 * gapmx
737 ENDIF
738c WRITE(IOUT,1300)GAP
739 ENDIF
740 gapmin = gap
741 IF(inacti/=7.AND.gap>0.5*gapmx)THEN
742 gaptmp = half*gapmx
743 CALL ancmsg(msgid=94,
744 . msgtype=msgwarning,
745 . anmode=aninfo_blind_2,
746 . i1=id,
747 . c1=titr,
748 . r1=gap,
749 . r2=gaptmp)
750 ENDIF
751 ELSE
752C GAP VARIABLE :
753C - GAPMIN CONTIENT ONE GAP MINIMUM UTILISE SI GAP_S(I)+GAP_M(J) < GAPMIN
754C - GAP CONTIENT LE SUP DE (GAP_S(I)+GAP_M(J),GAPMIN)
755 IF(gap<=zero)THEN
756 IF(ndx/=0)THEN
757 gapmin = gapmn
758 gapmin = min(half*gapmx,gapmin)
759 ELSE
760c GAPMIN = EM01 * GAPMX
761 gapmin = min(gapmn,em01 * gapmx)
762 ENDIF
763c WRITE(IOUT,1300)GAPMIN
764 ELSE
765 gapmin = gap
766 ENDIF
767C ABOVE VARIABLE GAPS
768 gap = max(gaps1+gaps2,gapmin)
769 gap=min(gap,gapmax)
770 IF(inacti/=7.AND.gap>half*gapmx)THEN
771 gaptmp = 0.5*gapmx
772 CALL ancmsg(msgid=477,
773 . msgtype=msgwarning,
774 . anmode=aninfo_blind_2,
775 . i1=id,
776 . c1=titr,
777 . r1=gap)
778 ENDIF
779 ENDIF
780C---------------------------------------------
781C SETTING TO ONE OF THE NODAL STIFFNESS MULTIPLIER
782C---------------------------------------------
783c STFN is temporarily from 1 to NSN instead of 1 to NLN
784 DO l=1,nsn
785 stfn(l) = 1.
786 ENDDO
787C---------------------------------------------
788C LIMITATION OF THE GAP OF SOLIDS
789C---------------------------------------------
790 IF (igap/=0) THEN
791 DO i = 1, nrt
792 IF(gap_m(i) == zero)THEN
793 gap_sh(i) = min(gapsolidmax,gap_sh(i))
794 gap_sh(i) = max(gapsol,gap_sh(i))
795c GAP_M for sorting
796 gap_m(i)=gap_m(i)+two*gap_sh(i)
797 ENDIF
798 ENDDO
799 ENDIF
800C
801C Calculation of the real gap to be used during the retri criterion
802C
803 gapshmax = zero
804 IF (igap==0) THEN
805 gapinf=gap
806 ELSE
807 gapinfs=ep30
808 gapinfm=ep30
809 gapsups = zero
810 gapsupm = zero
811 DO i = 1, nsn
812 gapinfs = min(gapinfs,gap_s(i))
813 gapsups = max(gapsups,gap_s(i))
814 ENDDO
815 DO i = 1, nrt
816c GAP_M(I)=GAP_M(I)+TWO*GAP_SH(I)
817 gapinfm = min(gapinfm,gap_m(i))
818 gapsupm = max(gapsupm,gap_m(i))
819 gapshmax = max(gapshmax,gap_sh(i))
820 ENDDO
821 gapinf= max(gapinfs+gapinfm,gapmin)
822 gap = min(gapsups+gapsupm,gapmax)
823 ENDIF
824
825 DO i=1,nln
826 IF(tag(nlg(i)) == 1)nbinflg(i)=bitunset(nbinflg(i),7)
827 ENDDO
828C------------
829 RETURN
830 1300 FORMAT(2x,'GAP MIN = ',1pg20.13)
bitget
integer function bitget(i, n)
Definition bitget.F:37
bitset
integer function bitset(i, n)
Definition bitget.F:66
bitunset
integer function bitunset(i, n)
Definition bitget.F:84
area
subroutine area(d1, x, x2, y, y2, eint, stif0)
Definition hm_read_prop32.F:567
i4gmx3
subroutine i4gmx3(x, irect, i, gapmax)
Definition i4gmx3.F:35
incoq3
subroutine incoq3(irect, ixc, ixtg, nint, nel, neltg, is, geo, pm, knod2elc, knod2eltg, nod2elc, nod2eltg, thk, nty, igeo, pm_stack, iworksh)
Definition incoq3.F:46
i20nelts
subroutine i20nelts(x, irect, ixs, nint, nel, i, area, noint, ir, surf_eltyp, surf_elem)
Definition inelt.F:171
ineltc
subroutine ineltc(nelc, neltg, is, surf_eltyp, surf_elem)
Definition inelt.F:134
insol3
subroutine insol3(x, irect, ixs, nint, nel, i, area, noint, knod2els, nod2els, ir, ixs10, ixs16, ixs20)
Definition insol3.F:44
min
#define min(a, b)
Definition macros.h:20
id
initmumps id
Definition multiplerhs_example.m:4
groupdef_mod
Definition groupdef_mod.F:668
message_mod
Definition message_mod.F:1257
names_and_titles_mod
Definition names_and_titles_mod.F:1002
names_and_titles_mod::nchartitle
integer, parameter nchartitle
Definition names_and_titles_mod.F:1008
ancmsg
subroutine ancmsg(msgid, msgtype, anmode, i1, i2, i3, i4, i5, i6, i7, i8, i9, i10, i11, i12, i13, i14, i15, i16, i17, i18, i19, i20, r1, r2, r3, r4, r5, r6, r7, r8, r9, c1, c2, c3, c4, c5, c6, c7, c8, c9, prmode)
Definition message.F:895
volint
subroutine volint(vol)
Definition volint.F:38

◆ i20sti3e()

subroutine i20sti3e ( x,
integer, dimension(2,*) ixlin,
stf,
integer, dimension(nixs,*) ixs,
pm,
geo,
integer nrt,
integer, dimension(nixc,*) ixc,
integer nintr,
slsfac,
integer nty,
gapmax,
integer noint,
gap_sm,
ms,
integer, dimension(nixtg,*) ixtg,
integer, dimension(nixt,*) ixt,
integer, dimension(nixp,*) ixp,
integer, dimension(nixr,*) ixr,
integer igap,
gapmin,
gap0,
gapinf,
integer nsne,
integer, dimension(*) ipartc,
integer, dimension(*) iparttg,
thk,
thk_part,
integer, dimension(*) ixs10,
integer id,
character(len=nchartitle) titr,
integer, dimension(nixx,*) kxx,
integer, dimension(*) ixx,
integer, dimension(npropgi,*) igeo,
integer, dimension(*) nod2el1d,
integer, dimension(*) knod2el1d,
integer, dimension(*) knod2els,
integer, dimension(*) knod2elc,
integer, dimension(*) knod2eltg,
integer, dimension(*) nod2els,
integer, dimension(*) nod2elc,
integer, dimension(*) nod2eltg,
lelx,
pm_stack,
integer, dimension(3,*) iworksh )

Definition at line 848 of file i20sti3.F.

858C-----------------------------------------------
859C M o d u l e s
860C-----------------------------------------------
861 USE message_mod
862 USE names_and_titles_mod , ONLY : nchartitle
863 use element_mod , only : nixs,nixc,nixtg,nixt,nixp,nixr
864C-----------------------------------------------
865C I m p l i c i t T y p e s
866C-----------------------------------------------
867#include "implicit_f.inc"
868C-----------------------------------------------
869C C o m m o n B l o c k s
870C-----------------------------------------------
871#include "units_c.inc"
872#include "param_c.inc"
873#include "com04_c.inc"
874#include "scr08_c.inc"
875#include "scr23_c.inc"
876C-----------------------------------------------
877C D u m m y A r g u m e n t s
878C-----------------------------------------------
879 INTEGER NRT, NINTR, NTY, NOINT,IGAP,NSNE
880C REAL
881 my_real
882 . slsfac, gapmax,gapmin,gap0
883 INTEGER IXLIN(2,*), IXS(NIXS,*), IXC(NIXC,*),
884 . IXTG(NIXTG,*),IXT(NIXT,*),IXP(NIXP,*),IXR(NIXR,*),
885 . IPARTC(*), IPARTTG(*),IXS10(*),KXX(NIXX,*),IXX(*),
886 . IGEO(NPROPGI,*),
887 . KNOD2ELS(*), KNOD2ELC(*), KNOD2ELTG(*),
888 . NOD2ELS(*), NOD2ELC(*), NOD2ELTG(*),
889 . NOD2EL1D(*),KNOD2EL1D(*),IWORKSH(3,*)
890C REAL
891 my_real
892 . x(3,*), stf(*), pm(npropm,*), geo(npropg,*),
893 . ms(*),gap_sm(*),xl2, gapinf,thk(*),thk_part(*),lelx(*),
894 . pm_stack(20,*)
895 INTEGER ID
896 CHARACTER(LEN=NCHARTITLE) :: TITR
897C-----------------------------------------------
898C L o c a l V a r i a b l e s
899C-----------------------------------------------
900 INTEGER NDX, I, INRT, NELS, MT, JJ, JJJ, NELC,
901 . MG, NELTG,NELT,NELP,NELR,
902 . IGTYP,NELX,IPGMAT,IGMAT,ISUBSTACK
903C REAL
904 my_real
905 . dxm, gapmx, gapmn, area, vol, dx,gap1,gaps1,gaptmp,
906 . get_u_geo
907C-----------------------------------------------
908 EXTERNAL get_u_geo
909C--------------------------------------------------------------
910C CALCULATION OF SEGMENT STIFFNESSES
911C V16 : IN THE CASE WHERE ONE SEGMENT BELONGS BOTH
912C TO A BRICK AND A SHELL, THE SHELL STIFFNESS IS CHOSEN
913C OF THE SHELL UNLESS THE SHELL MATERIAL IS NULL.
914C---------------------------------------------------------------
915 dxm=zero
916 ndx=0
917 gaps1=zero
918 gapmx=ep30
919 gapmn=ep30
920
921C
922 DO 500 i=1,nrt
923 stf(i)=zero
924 gap_sm(i)=zero
925 inrt=i
926 CALL i11gmx3(x,ixlin,inrt,gapmx,xl2)
927C----------------------
928C ELEMENTS SOLIDES
929C----------------------
930 CALL i11sol(x,ixlin,ixs,nintr,nels,inrt,
931 . area,noint,knod2els,nod2els,ixs10)
932 IF(nels/=0) THEN
933 mt=ixs(1,nels)
934 IF(mt>0)THEN
935 DO 100 jj=1,8
936 jjj=ixs(jj+1,nels)
937 xc(jj)=x(1,jjj)
938 yc(jj)=x(2,jjj)
939 zc(jj)=x(3,jjj)
940 100 CONTINUE
941 CALL volint(vol)
942 IF(xl2>0.0)THEN
943 stf(i)=slsfac*vol*pm(100,mt)/xl2
944 ELSE
945 stf(i)=zero
946 ENDIF
947 ELSE
948C IF(NINTR>=0)WRITE (IOUT,1500) IXS(11,NELS),I, NOINT
949 IF(nintr>=0) THEN
950 CALL ancmsg(msgid=95,
951 . msgtype=msgwarning,
952 . anmode=aninfo_blind_2,
953 . i1=id,
954 . c1=titr,
955 . i2=ixs(nixs,nels),
956 . c2='SOLID',
957 . i3=i)
958 ENDIF
959C IF(NINTR<0)WRITE (IOUT,1600) IXS(11,NELS),I, NOINT
960C IWARN=IWARN+1
961 IF(nintr<0) THEN
962 CALL ancmsg(msgid=96,
963 . msgtype=msgwarning,
964 . anmode=aninfo_blind_2,
965 . i1=id,
966 . c1=titr,
967 . i2=ixs(nixs,nels),
968 . c2='SOLID',
969 . i3=i)
970 ENDIF
971 ENDIF
972 ENDIF
973C---------------------
974C ELEMENTS COQUES
975C---------------------
976 CALL i11coq(ixlin,ixc ,ixtg,nintr,nelc ,
977 . neltg,inrt,geo,pm,thk,igeo,
978 . knod2elc,knod2eltg,nod2elc,nod2eltg,
979 . pm_stack, iworksh )
980 IF(neltg/=0) THEN
981C
982 mt=ixtg(1,neltg)
983 mg=ixtg(5,neltg)
984 igtyp = igeo(11,mg)
985 dx=geo(1,mg)
986 IF(igtyp == 17 .OR. igtyp == 51 .OR. igtyp ==52)
987 . dx = thk(numelc + neltg)
988 gap_sm(i)=half*dx
989 gaps1=max(gaps1,gap_sm(i))
990 gapmn = min(gapmn,dx)
991 dxm=dxm+dx
992 ndx=ndx+1
993 igmat = igeo(98,mg)
994 ipgmat=700
995 IF(mt>0)THEN
996 IF(igtyp == 11 .AND. igmat > 0)THEN
997 stf(i)=slsfac*dx*geo(ipgmat + 2 ,mg)
998 ELSEIF(igtyp==52 .OR.
999 . ((igtyp == 17 .OR. igtyp == 51 ) .AND. igmat > 0))THEN
1000 isubstack = iworksh(3,neltg + numelc)
1001 stf(i)=slsfac*dx*pm_stack(2,isubstack)
1002 ELSE
1003 stf(i)=slsfac*dx*pm(20,mt)
1004 ENDIF
1005 ELSE
1006C IF(NINTR>=0)WRITE (IOUT,1700) IXTG(NIXTG,NELTG),I, NOINT
1007 IF(nintr>=0) THEN
1008 CALL ancmsg(msgid=95,
1009 . msgtype=msgwarning,
1010 . anmode=aninfo_blind_2,
1011 . i1=id,
1012 . c1=titr,
1013 . i2=ixtg(nixtg,neltg),
1014 . c2='SHELL',
1015 . i3=i)
1016 ENDIF
1017C IF(NINTR<0)WRITE (IOUT,1800) IXTG(NIXTG,NELTG),I, NOINT
1018C IWARN=IWARN+1
1019 IF(nintr<0) THEN
1020 CALL ancmsg(msgid=96,
1021 . msgtype=msgwarning,
1022 . anmode=aninfo_blind_2,
1023 . i1=id,
1024 . c1=titr,
1025 . i2=ixtg(nixtg,neltg),
1026 . c2='SHELL',
1027 . i3=i)
1028 ENDIF
1029 ENDIF
1030 ELSEIF(nelc/=0) THEN
1031C
1032 mt=ixc(1,nelc)
1033 mg=ixc(6,nelc)
1034 igtyp = igeo(11,mg)
1035 dx=geo(1,mg)
1036 IF(igtyp == 17 .OR. igtyp == 51 .OR. igtyp ==52)
1037 . dx = thk(nelc)
1038 gap_sm(i)=half*dx
1039 gaps1=max(gaps1,gap_sm(i))
1040 gapmn = min(gapmn,dx)
1041 dxm=dxm+dx
1042 ndx=ndx+1
1043 igmat = igeo(98,mg)
1044 IF(mt>0)THEN
1045 IF(igtyp == 11 .AND. igmat > 0) THEN
1046 stf(i)=slsfac*dx*geo(ipgmat + 2 ,mg)
1047 ELSEIF(igtyp ==52 .OR.
1048 . ((igtyp == 17 .OR. igtyp == 51) .AND. igmat > 0))THEN
1049 isubstack = iworksh(3,nelc)
1050 stf(i)=slsfac*dx*pm_stack(2,isubstack)
1051 ELSE
1052 stf(i)=slsfac*dx*pm(20,mt)
1053 ENDIF
1054 ELSE
1055C IF(NINTR>=0)WRITE (IOUT,1700) IXC(7,NELC),I, NOINT
1056 IF(nintr>=0) THEN
1057 CALL ancmsg(msgid=95,
1058 . msgtype=msgwarning,
1059 . anmode=aninfo_blind_2,
1060 . i1=id,
1061 . c1=titr,
1062 . i2=ixc(nixc,nelc),
1063 . c2='SHELL',
1064 . i3=i)
1065 ENDIF
1066C IF(NINTR<0)WRITE (IOUT,1800) IXC(7,NELC),I, NOINT
1067C IWARN=IWARN+1
1068 IF(nintr<0) THEN
1069 CALL ancmsg(msgid=96,
1070 . msgtype=msgwarning,
1071 . anmode=aninfo_blind_2,
1072 . i1=id,
1073 . c1=titr,
1074 . i2=ixc(nixc,nelc),
1075 . c2='SHELL',
1076 . i3=i)
1077 ENDIF
1078 ENDIF
1079 ENDIF
1080C---------------------
1081C ELEMENTS TIGE POUTRE RESSORT
1082C---------------------
1083 CALL i11fil(ixlin,ixt,ixp,ixr,nintr,nelt ,
1084 . nelp,nelr,nelx,inrt,nod2el1d,
1085 . knod2el1d,kxx,ixx)
1086
1087 IF(nelt/=0) THEN
1088C
1089 mt=ixt(1,nelt)
1090 mg=ixt(4,nelt)
1091 dx=sqrt(geo(1,mg))
1092 IF(igtyp == 17 .OR. igtyp == 51 .OR. igtyp == 52 )
1093 . dx = sqrt(thk(numelc + nelt))
1094 gap_sm(i)=max(gap_sm(i),half*dx)
1095 gaps1=max(gaps1,gap_sm(i))
1096 gapmn = min(gapmn,dx)
1097 dxm=dxm+dx
1098 ndx=ndx+1
1099 igmat = igeo(98,mg)
1100 IF(mt>0)THEN
1101 IF(igtyp == 11 .AND. igmat > 0) THEN
1102 stf(i)=slsfac*dx*geo(ipgmat + 2 ,mg)
1103 ELSEIF((igtyp == 17 .OR. igtyp == 17) .AND. igmat > 0) THEN
1104 isubstack = iworksh(3,numelc + nelt)
1105 stf(i)=slsfac*dx*pm_stack(2,isubstack)
1106 ELSE
1107 stf(i)=slsfac*dx*pm(20,mt)
1108 ENDIF
1109 ELSE
1110C IF(NINTR>=0)WRITE (IOUT,1700) IXT(NIXT,NELT),I, NOINT
1111 IF(nintr>=0) THEN
1112 CALL ancmsg(msgid=95,
1113 . msgtype=msgwarning,
1114 . anmode=aninfo_blind_2,
1115 . i1=id,
1116 . c1=titr,
1117 . i2=ixt(nixt,nelt),
1118 . c2='TRUSS',
1119 . i3=i)
1120 ENDIF
1121C IF(NINTR<0)WRITE (IOUT,1800) IXT(NIXT,NELT),I, NOINT
1122C IWARN=IWARN+1
1123 IF(nintr<0) THEN
1124 CALL ancmsg(msgid=96,
1125 . msgtype=msgwarning,
1126 . anmode=aninfo_blind_2,
1127 . i1=id,
1128 . c1=titr,
1129 . i2=ixt(nixt,nelt),
1130 . c2='TRUSS',
1131 . i3=i)
1132 ENDIF
1133 ENDIF
1134 ELSEIF(nelp/=0) THEN
1135C
1136 mt=ixp(1,nelp)
1137 mg=ixp(5,nelp)
1138 dx=sqrt(geo(1,mg))
1139 gap_sm(i)=max(gap_sm(i),half*dx)
1140 gaps1=max(gaps1,gap_sm(i))
1141 gapmn = min(gapmn,dx)
1142 dxm=dxm+dx
1143 ndx=ndx+1
1144 IF(mt>0)THEN
1145 stf(i)=slsfac*dx*pm(20,mt)
1146 ELSE
1147C IF(NINTR>=0)WRITE (IOUT,1700) IXP(NIXP,NELP),I, NOINT
1148 IF(nintr>=0) THEN
1149 CALL ancmsg(msgid=95,
1150 . msgtype=msgwarning,
1151 . anmode=aninfo_blind_2,
1152 . i1=id,
1153 . c1=titr,
1154 . i2=ixp(nixp,nelp),
1155 . c2='BEAM',
1156 . i3=i)
1157 ENDIF
1158C IF(NINTR<0)WRITE (IOUT,1800) IXP(NIXP,NELP),I, NOINT
1159C IWARN=IWARN+1
1160 IF(nintr<0) THEN
1161 CALL ancmsg(msgid=96,
1162 . msgtype=msgwarning,
1163 . anmode=aninfo_blind_2,
1164 . i1=id,
1165 . c1=titr,
1166 . i2=ixp(nixp,nelp),
1167 . c2='BEAM',
1168 . i3=i)
1169 ENDIF
1170 ENDIF
1171 ELSEIF(nelr/=0) THEN
1172C
1173 mg=ixr(1,nelr)
1174 mt = ixr(5,nelr)
1175 IF(mg>0)THEN
1176 igtyp=nint(geo(12,mg))
1177 IF(igtyp==4.OR.igtyp==12)THEN
1178 stf(i)=slsfac*geo(2,mg)
1179 ELSEIF(igtyp==8.OR.igtyp==13)THEN
1180 stf(i)=slsfac*max(geo(3,mg),geo(10,mg),geo(15,mg))
1181 ELSEIF(igtyp == 23)THEN
1182 stf(i)=slsfac*max(pm(191,mt),pm(192,mt),pm(193,mt))
1183 ELSEIF(igtyp==25)THEN
1184 stf(i)=slsfac*geo(10,mg)
1185 ELSEIF(igtyp>=29)THEN
1186 stf(i)=slsfac*geo(3,mg)
1187 ELSE
1188 WRITE(6,'(A)') 'INTERNAL ERROR 987'
1189 CALL my_exit(2)
1190C STOP 987
1191 ENDIF
1192 ELSE
1193C IF(NINTR>=0)WRITE (IOUT,1700) IXR(NIXR,NELR),I, NOINT
1194 IF(nintr>=0) THEN
1195 CALL ancmsg(msgid=95,
1196 . msgtype=msgwarning,
1197 . anmode=aninfo_blind_2,
1198 . i1=id,
1199 . c1=titr,
1200 . i2=ixr(nixr,nelr),
1201 . c2='SPRING',
1202 . i3=i)
1203 ENDIF
1204C IF(NINTR<0)WRITE (IOUT,1800) IXR(NIXR,NELR),I, NOINT
1205C IWARN=IWARN+1
1206 IF(nintr<0) THEN
1207 CALL ancmsg(msgid=96,
1208 . msgtype=msgwarning,
1209 . anmode=aninfo_blind_2,
1210 . i1=id,
1211 . c1=titr,
1212 . i2=ixr(nixr,nelr),
1213 . c2='SPRING',
1214 . i3=i)
1215 ENDIF
1216 ENDIF
1217 ELSEIF(nelx/=0) THEN
1218C
1219 mg=kxx(2,nelx)
1220 IF(mg>0)THEN
1221 stf(i)=slsfac*get_u_geo(4,mg)*(kxx(3,nelx)-1)/lelx(nelx)
1222 ELSE
1223 IF(nintr>=0) THEN
1224 CALL ancmsg(msgid=95,
1225 . msgtype=msgwarning,
1226 . anmode=aninfo_blind_2,
1227 . i1=id,
1228 . c1=titr,
1229 . i2=kxx(nixx,nelx),
1230 . c2='XELEM',
1231 . i3=i)
1232 ENDIF
1233 IF(nintr<0) THEN
1234 CALL ancmsg(msgid=96,
1235 . msgtype=msgwarning,
1236 . anmode=aninfo_blind_2,
1237 . i1=id,
1238 . c1=titr,
1239 . i2=kxx(nixx,nelx),
1240 . c2='XELEM',
1241 . i3=i)
1242 ENDIF
1243 ENDIF
1244 ENDIF
1245C---------------------------
1246 IF(nels+nelc+neltg+nelt+nelp+nelr+numelx==0.)THEN
1247C In SPMD you need an element associated with the edge otherwise error
1248 IF(nintr>0) THEN
1249 CALL ancmsg(msgid=481,
1250 . msgtype=msgerror,
1251 . anmode=aninfo_blind_2,
1252 . i1=id,
1253 . c1=titr,
1254 . i2=i)
1255 ENDIF
1256 IF(nintr<0) THEN
1257 CALL ancmsg(msgid=482,
1258 . msgtype=msgerror,
1259 . anmode=aninfo_blind_2,
1260 . i1=id,
1261 . c1=titr,
1262 . i2=i)
1263 ENDIF
1264 ENDIF
1265
1266 500 CONTINUE
1267C---------------------------
1268C GAP
1269C---------------------------
1270 gapmx=sqrt(gapmx)
1271 IF(igap==0)THEN
1272C---------------------------
1273C GAP FIXE
1274C---------------------------
1275 IF(gap0>zero)THEN
1276 gap1 = gap0
1277 ELSE
1278 IF(ndx/=0)THEN
1279 gap1 = min(half*gapmx,dxm/ndx)
1280 ELSE
1281 gap1 = em01* gapmx
1282 ENDIF
1283 IF(nintr<0)WRITE(iout,1300)half*(gapmin+gap1)
1284 ENDIF
1285C
1286 IF(nintr<0) gap1 = half*(gapmin+gap1)
1287 gapmin = gap1
1288 gapmax = gap1
1289C
1290 IF(gap1>half*gapmx)THEN
1291C WRITE(IOUT,1400)GAP1,0.5*GAPMX
1292C IWARN=IWARN+1
1293 gaptmp = half*gapmx
1294 CALL ancmsg(msgid=94,
1295 . msgtype=msgwarning,
1296 . anmode=aninfo_blind_2,
1297 . i1=id,
1298 . c1=titr,
1299 . r1=gap1,
1300 . r2=gaptmp)
1301 ENDIF
1302 ELSE
1303C---------------------------
1304C GAP VARIABLE
1305C---------------------------
1306 IF(gap0>zero)THEN
1307 gap1 = gap0
1308 ELSE
1309 IF(ndx/=0)THEN
1310 gap1 = min(half*gapmx,gapmn)
1311 ELSE
1312 gap1 = em01 * gapmx
1313 ENDIF
1314 IF(nintr<0)WRITE(iout,1300)half*(gapmin+gap1)
1315 ENDIF
1316C MINI GAP AND ABOVE VARIABLE GAPS
1317 IF(nintr>0)THEN
1318 gapmin = gap1
1319 gapmax = gaps1
1320 ELSE
1321 gapmin = half*(gapmin+gap1)
1322 gapmax = max(gapmax+gaps1,gapmin)
1323 ENDIF
1324C
1325 IF(gapmax>half*gapmx)THEN
1326 gaptmp = half*gapmx
1327 CALL ancmsg(msgid=94,
1328 . msgtype=msgwarning,
1329 . anmode=aninfo_blind_2,
1330 . i1=id,
1331 . c1=titr,
1332 . r1=gapmax,
1333 . r2=gaptmp)
1334 ENDIF
1335 ENDIF
1336C---------------------------
1337C STIF GLOBAL
1338C---------------------------
1339 IF(slsfac<zero)THEN
1340 DO i=1,nrt
1341 stf(i)=-slsfac
1342 ENDDO
1343 ENDIF
1344C---------------------------------------------
1345C
1346C Calculation of the real gap to be used during the retri criterion
1347C
1348 IF (igap==0) THEN
1349 gapinf=gapmax/two ! multiplied by 2 in i20ini3
1350 ELSE
1351 DO i = 1, nrt
1352 gapinf = min(gapinf,gap_sm(i))
1353 ENDDO
1354 ENDIF
1355 RETURN
1356
1357 1300 FORMAT(2x,'COMPUTED GAP = ',1pg20.13)
1358
my_exit
void my_exit(int *i)
Definition analyse.c:1038
i11coq
subroutine i11coq(irect, ixc, ixtg, nint, nel, neltg, is, geo, pm, thk, igeo, knod2elc, knod2eltg, nod2elc, nod2eltg, pm_stack, iworksh)
Definition i11coq.F:35
i11fil
subroutine i11fil(irect, ixt, ixp, ixr, nint, nelt, nelp, nelr, nelx, is, nod2el1d, knod2el1d, kxx, ixx)
Definition i11coq.F:168
i11gmx3
subroutine i11gmx3(x, irect, i, gapmax, xl2)
Definition i11gmx3.F:32
i11sol
subroutine i11sol(x, irect, ixs, nint, nel, i, area, noint, knod2els, nod2els, ixs10)
Definition i11sol.F:33