OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
i23gap3.F File Reference
#include "implicit_f.inc"
#include "com04_c.inc"
#include "param_c.inc"
#include "units_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine i23gap3 (x, irects, irectm, nrts, nrtm, geo, ixs, pm, ixc, ixtg, nint, nty, noint, nsn, nsv, intth, nmn, msr, wa, knod2els, knod2elc, knod2eltg, nod2els, nod2elc, nod2eltg, thk, ixs10, ixs16, ixs20, ipartc, iparttg, gap, igap, gap_s, gapmin, gapinf, gapmax, gapscale, bgapsmx, stfn, stf, id, titr, gap_m, igeo, pm_stack, iworksh)

Function/Subroutine Documentation

◆ i23gap3()

subroutine i23gap3 ( x,
integer, dimension(4,*) irects,
integer, dimension(4,*) irectm,
integer nrts,
integer nrtm,
geo,
integer, dimension(nixs,*) ixs,
pm,
integer, dimension(nixc,*) ixc,
integer, dimension(nixtg,*) ixtg,
integer nint,
integer nty,
integer noint,
integer nsn,
integer, dimension(*) nsv,
integer intth,
integer nmn,
integer, dimension(*) msr,
wa,
integer, dimension(*) knod2els,
integer, dimension(*) knod2elc,
integer, dimension(*) knod2eltg,
integer, dimension(*) nod2els,
integer, dimension(*) nod2elc,
integer, dimension(*) nod2eltg,
thk,
integer, dimension(*) ixs10,
integer, dimension(*) ixs16,
integer, dimension(*) ixs20,
integer, dimension(*) ipartc,
integer, dimension(*) iparttg,
gap,
integer igap,
gap_s,
gapmin,
gapinf,
gapmax,
gapscale,
bgapsmx,
stfn,
stf,
integer id,
character(len=nchartitle) titr,
gap_m,
integer, dimension(npropgi,*) igeo,
pm_stack,
integer, dimension(*) iworksh )

Definition at line 36 of file i23gap3.F.

47 USE message_mod
48 USE names_and_titles_mod , ONLY : nchartitle
49C-----------------------------------------------
50C I m p l i c i t T y p e s
51C-----------------------------------------------
52#include "implicit_f.inc"
53C-----------------------------------------------
54C C o m m o n B l o c k s
55C-----------------------------------------------
56#include "com04_c.inc"
57#include "param_c.inc"
58#include "units_c.inc"
59C-----------------------------------------------
60C D u m m y A r g u m e n t s
61C-----------------------------------------------
62 INTEGER NRTS, NRTM, NINT, NTY, NOINT, NSN, NMN, IGAP
63 INTEGER IRECTS(4,*), IRECTM(4,*), IXS(NIXS,*), IXC(NIXC,*),
64 . NSV(*), IXTG(NIXTG,*),
65 . KNOD2ELS(*), KNOD2ELC(*), KNOD2ELTG(*), NOD2ELS(*), NOD2ELC(*),
66 . NOD2ELTG(*),
67 . INTTH, MSR(*), IXS10(*),
68 . IXS16(*), IXS20(*), IPARTC(*), IPARTTG(*),IGEO(NPROPGI,*),
69 . IWORKSH(*)
70C REAL
71 my_real
72 . gap, gapmin, gapinf, gapmax, gapscale, bgapsmx,
73 . x(3,*), pm(npropm,*), geo(npropg,*), thk(*), wa(*),
74 . gap_s(*), stfn(*), stf(*), gap_m(*),pm_stack(*)
75 INTEGER ID
76 CHARACTER(LEN=NCHARTITLE) :: TITR
77C-----------------------------------------------
78C L o c a l V a r i a b l e s
79C-----------------------------------------------
80 INTEGER I, J, INRT, NELS, NELC, NELTG, IE, II, MAT, IP, MG, NDX,
81 . IGTYP
82C REAL
83 my_real
84 . dxm, gapmx, gapmn, area, dx, gapm
85C--------------------------------------------------------------
86 dxm=zero
87 ndx=0
88 gapmx=ep30
89 gapmn=ep30
90C------------------------------------
91C GAP VARIABLE NOEUDS SECONDS
92C------------------------------------
93 IF(igap>=1)THEN
94 DO i=1,numnod
95 wa(i)=zero
96 ENDDO
97 END IF
98C-----
99 DO 250 i=1,nrts
100 inrt=i
101C----------------------
102C ELEMENTS SOLIDES
103C----------------------
104 CALL insol3(x,irects,ixs,nint,nels,inrt,
105 . area,noint,knod2els ,nod2els ,0 ,ixs10,
106 . ixs16,ixs20)
107C---------------------
108C ELEMENTS COQUES
109C---------------------
110 CALL incoq3(irects,ixc ,ixtg ,nint ,nelc ,
111 . neltg,inrt,geo ,pm ,knod2elc ,
112 . knod2eltg ,nod2elc ,nod2eltg,thk,nty,igeo,
113 . pm_stack , iworksh )
114 IF(neltg/=0) THEN
115 IF(igap>=1)THEN
116 mg=ixtg(5,neltg)
117 igtyp = igeo(11,mg)
118 ip = iparttg(neltg)
119 dx=half*geo(1,mg)
120 IF(igtyp == 17) dx = half*thk(numelc + neltg)
121 wa(ixtg(2,neltg))=max(wa(ixtg(2,neltg)),dx)
122 wa(ixtg(3,neltg))=max(wa(ixtg(3,neltg)),dx)
123 wa(ixtg(4,neltg))=max(wa(ixtg(4,neltg)),dx)
124 END IF
125 ELSEIF(nelc/=0) THEN
126 IF(igap>=1)THEN
127 mg=ixc(6,nelc)
128 igtyp = igeo(11,mg)
129 ip = ipartc(nelc)
130 dx=half*geo(1,mg)
131 IF(igtyp == 17) dx = half*thk(nelc)
132 wa(ixc(2,nelc))=max(wa(ixc(2,nelc)),dx)
133 wa(ixc(3,nelc))=max(wa(ixc(3,nelc)),dx)
134 wa(ixc(4,nelc))=max(wa(ixc(4,nelc)),dx)
135 wa(ixc(5,nelc))=max(wa(ixc(5,nelc)),dx)
136 END IF
137 ENDIF
138C
139 IF(nels+nelc+neltg==0)THEN
140Ca verifier (second) en SPMD il faut un element associe a l'arrete sinon erreur
141 IF(nint>0) THEN
142 CALL ancmsg(msgid=481,
143 . msgtype=msgerror,
144 . anmode=aninfo_blind_2,
145 . i1=id,
146 . c1=titr,
147 . i2=i)
148 ENDIF
149 IF(nint<0) THEN
150 CALL ancmsg(msgid=482,
151 . msgtype=msgerror,
152 . anmode=aninfo_blind_2,
153 . i1=id,
154 . c1=titr,
155 . i2=i)
156 ENDIF
157 ENDIF
158 250 CONTINUE
159C-----
160 IF(igap>=1)THEN
161 DO i=1,nsn
162 gapm=gapscale * wa(nsv(i))
163 gap_s(i)= gapm
164 ENDDO
165 ENDIF
166C------------------------------------
167C GAP FACES MAINS
168C------------------------------------
169 DO 350 i=1,nrtm
170 inrt=i
171 gapm=zero
172 CALL i4gmx3(x,irectm,inrt,gapmx)
173C----------------------
174C ELEMENTS SOLIDES
175C----------------------
176 CALL insol3(x,irectm,ixs,nint,nels,inrt,
177 . area,noint,knod2els ,nod2els ,0 ,ixs10,
178 . ixs16,ixs20)
179C---------------------
180C ELEMENTS COQUES
181C---------------------
182 CALL incoq3(irectm,ixc ,ixtg ,nint ,nelc ,
183 . neltg,inrt,geo ,pm ,knod2elc ,
184 . knod2eltg ,nod2elc ,nod2eltg,thk,nty,igeo,
185 . pm_stack , iworksh )
186 IF(neltg/=0) THEN
187c IF(IGAP>=1)THEN
188 mg=ixtg(5,neltg)
189 igtyp =igeo(11,mg)
190 ip = iparttg(neltg)
191 dx =geo(1,mg)*gapscale
192 IF(igtyp == 17) dx =thk(numelc+neltg)*gapscale
193c END IF
194 ELSEIF(nelc/=0) THEN
195c IF(IGAP>=1)THEN
196 mg=ixc(6,nelc)
197 igtyp =igeo(11,mg)
198 ip = ipartc(nelc)
199 dx =geo(1,mg)*gapscale
200 IF(igtyp == 17) dx =thk(nelc)*gapscale
201c END IF
202 ENDIF
203 gapm=half*dx
204 gapmn = min(gapmn,half*dx)
205 dxm=dxm+dx
206 ndx=ndx+1
207 IF(igap/=0) gap_m(i)=gapm
208C
209 IF(nels+nelc+neltg==0)THEN
210Ca verifier (second) en SPMD il faut un element associe a l'arrete sinon erreur
211 IF(nint>0) THEN
212 CALL ancmsg(msgid=481,
213 . msgtype=msgerror,
214 . anmode=aninfo_blind_2,
215 . i1=id,
216 . c1=titr,
217 . i2=i)
218 ENDIF
219 IF(nint<0) THEN
220 CALL ancmsg(msgid=482,
221 . msgtype=msgerror,
222 . anmode=aninfo_blind_2,
223 . i1=id,
224 . c1=titr,
225 . i2=i)
226 ENDIF
227 ENDIF
228 350 CONTINUE
229C------------------------------------
230C GAP
231C------------------------------------
232 gapmx=sqrt(gapmx)
233 IF(igap==0)THEN
234C GAP FIXE
235 IF(gap<=zero)THEN
236 IF(ndx/=0)THEN
237 gap = dxm/ndx
238 gap = min(half*gapmx,gap)
239 ELSE
240 gap = em01 * gapmx
241 ENDIF
242 WRITE(iout,1000)gap
243 ENDIF
244 gapmin = gap
245 gapmax = gap
246 ELSE
247C GAP VARIABLE :
248C - GAPMIN CONTIENT ONE GAP MINIMUM UTILISE SI GAP_S(I)+GAP_M(J) < GAPMIN
249C - GAP CONTIENT LE SUP DE (GAP_S(I)+GAP_M(J),GAPMIN)
250 IF(gap<=zero)THEN
251 IF(ndx/=0)THEN
252 gapmin = gapmn
253 gapmin = min(half*gapmx,gapmin)
254 ELSE
255 gapmin = em01 * gapmx
256 ENDIF
257 ELSE
258 gapmin=gap
259 END IF
260 WRITE(iout,1000)gapmin
261C
262C GAP n'est pas utilise pour Igap > 0 ; Gapmin peut etre egal a 0.
263 IF(gapmax==zero)gapmax=ep30
264 WRITE(iout,1500)gapmax
265 gap = min(gap,gapmax)
266 ENDIF
267C------------------------------------
268C
269C Calcul du gap reel a utiliser lors du critere de retri
270C
271 bgapsmx = zero
272 IF (igap==0) THEN
273 gapinf=gap
274 ELSE
275 gapinf=ep30
276 DO i = 1, nsn
277 gapinf = min(gapinf,gap_s(i))
278 bgapsmx = max(bgapsmx,gap_s(i))
279 ENDDO
280 DO i = 1, nrtm
281 gapinf = min(gapinf,gap_m(i))
282 ENDDO
283 gapinf=max(gapinf,gapmin)
284 ENDIF
285C---------------------------------------------
286C STiff cote main (1: active ; 0: inactive)
287C------------------------------------
288 DO i=1,nrtm
289 stf(i)=one
290 END DO
291C---------------------------------------------
292C MISE A ONE DU MULTIPLICATEUR NODALE DES RIGIDITES
293C---------------------------------------------
294 DO i=1,nsn
295 stfn(i) = one
296 END DO
297C---------------------------
298 RETURN
299 1000 FORMAT(2x,'GAP MIN = ',1pg20.13)
300 1500 FORMAT(2x,'GAP MAX = ',1pg20.13)
my_real
#define my_real
Definition cppsort.cpp:32
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:45
insol3
subroutine insol3(x, irect, ixs, nint, nel, i, area, noint, knod2els, nod2els, ir, ixs10, ixs16, ixs20)
Definition insol3.F:43
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21
id
initmumps id
Definition multiplerhs_example.m:4
message_mod
Definition message_mod.F:1249
names_and_titles_mod
Definition names_and_titles_mod.F:997
names_and_titles_mod::nchartitle
integer, parameter nchartitle
Definition names_and_titles_mod.F:1003
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:889