OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
i23gap3.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/.
23C
24!||====================================================================
25!|| i23gap3 ../starter/source/interfaces/inter3d1/i23gap3.F
26!||--- called by ------------------------------------------------------
27!|| inint3 ../starter/source/interfaces/inter3d1/inint3.F
28!||--- calls -----------------------------------------------------
29!|| ancmsg ../starter/source/output/message/message.F
30!|| i4gmx3 ../starter/source/interfaces/inter3d1/i4gmx3.f
31!|| incoq3 ../starter/source/interfaces/inter3d1/incoq3.f
32!|| insol3 ../starter/source/interfaces/inter3d1/insol3.F
33!||--- uses -----------------------------------------------------
34!|| message_mod ../starter/share/message_module/message_mod.F
35!||====================================================================
36 SUBROUTINE i23gap3(
37 1 X ,IRECTS ,IRECTM ,NRTS ,NRTM ,
38 2 GEO ,IXS ,PM ,IXC ,IXTG ,
39 3 NINT ,NTY ,NOINT ,NSN ,NSV ,
40 4 INTTH ,NMN ,MSR ,WA ,
41 5 KNOD2ELS ,KNOD2ELC ,KNOD2ELTG ,NOD2ELS ,NOD2ELC ,
42 6 NOD2ELTG ,THK ,IXS10 ,IXS16 ,IXS20 ,
43 7 IPARTC ,IPARTTG ,GAP ,IGAP ,GAP_S ,
44 8 GAPMIN ,GAPINF ,GAPMAX ,GAPSCALE,BGAPSMX ,
45 9 STFN ,STF ,ID,TITR ,GAP_M ,IGEO ,
46 A PM_STACK,IWORKSH )
47 USE message_mod
48 USE names_and_titles_mod , ONLY : nchartitle
49 use element_mod , only :nixs,nixc,nixtg
50C-----------------------------------------------
51C I m p l i c i t T y p e s
52C-----------------------------------------------
53#include "implicit_f.inc"
54C-----------------------------------------------
55C C o m m o n B l o c k s
56C-----------------------------------------------
57#include "com04_c.inc"
58#include "param_c.inc"
59#include "units_c.inc"
60C-----------------------------------------------
61C D u m m y A r g u m e n t s
62C-----------------------------------------------
63 INTEGER NRTS, NRTM, NINT, NTY, NOINT, NSN, NMN, IGAP
64 INTEGER IRECTS(4,*), IRECTM(4,*), IXS(NIXS,*), IXC(NIXC,*),
65 . NSV(*), IXTG(NIXTG,*),
66 . KNOD2ELS(*), KNOD2ELC(*), KNOD2ELTG(*), NOD2ELS(*), NOD2ELC(*),
67 . NOD2ELTG(*),
68 . INTTH, MSR(*), IXS10(*),
69 . IXS16(*), IXS20(*), IPARTC(*), IPARTTG(*),IGEO(NPROPGI,*),
70 . IWORKSH(*)
71C REAL
72 my_real
73 . gap, gapmin, gapinf, gapmax, gapscale, bgapsmx,
74 . x(3,*), pm(npropm,*), geo(npropg,*), thk(*), wa(*),
75 . gap_s(*), stfn(*), stf(*), gap_m(*),pm_stack(*)
76 INTEGER ID
77 CHARACTER(LEN=NCHARTITLE) :: TITR
78C-----------------------------------------------
79C L o c a l V a r i a b l e s
80C-----------------------------------------------
81 INTEGER I, INRT, NELS, NELC, NELTG, IP, MG, NDX,
82 . igtyp
83C REAL
84 my_real
85 . dxm, gapmx, gapmn, area, dx, gapm
86C--------------------------------------------------------------
87 dxm=zero
88 ndx=0
89 gapmx=ep30
90 gapmn=ep30
91C------------------------------------
92C GAP VARIABLE NODES SECONDS
93C------------------------------------
94 IF(igap>=1)THEN
95 DO i=1,numnod
96 wa(i)=zero
97 ENDDO
98 END IF
99C-----
100 DO 250 i=1,nrts
101 inrt=i
102C----------------------
103C ELEMENTS SOLIDES
104C----------------------
105 CALL insol3(x,irects,ixs,nint,nels,inrt,
106 . area,noint,knod2els ,nod2els ,0 ,ixs10,
107 . ixs16,ixs20)
108C---------------------
109C ELEMENTS COQUES
110C---------------------
111 CALL incoq3(irects,ixc ,ixtg ,nint ,nelc ,
112 . neltg,inrt,geo ,pm ,knod2elc ,
113 . knod2eltg ,nod2elc ,nod2eltg,thk,nty,igeo,
114 . pm_stack , iworksh )
115 IF(neltg/=0) THEN
116 IF(igap>=1)THEN
117 mg=ixtg(5,neltg)
118 igtyp = igeo(11,mg)
119 ip = iparttg(neltg)
120 dx=half*geo(1,mg)
121 IF(igtyp == 17) dx = half*thk(numelc + neltg)
122 wa(ixtg(2,neltg))=max(wa(ixtg(2,neltg)),dx)
123 wa(ixtg(3,neltg))=max(wa(ixtg(3,neltg)),dx)
124 wa(ixtg(4,neltg))=max(wa(ixtg(4,neltg)),dx)
125 END IF
126 ELSEIF(nelc/=0) THEN
127 IF(igap>=1)THEN
128 mg=ixc(6,nelc)
129 igtyp = igeo(11,mg)
130 ip = ipartc(nelc)
131 dx=half*geo(1,mg)
132 IF(igtyp == 17) dx = half*thk(nelc)
133 wa(ixc(2,nelc))=max(wa(ixc(2,nelc)),dx)
134 wa(ixc(3,nelc))=max(wa(ixc(3,nelc)),dx)
135 wa(ixc(4,nelc))=max(wa(ixc(4,nelc)),dx)
136 wa(ixc(5,nelc))=max(wa(ixc(5,nelc)),dx)
137 END IF
138 ENDIF
139C
140 IF(nels+nelc+neltg==0)THEN
141CTo be checked (second) in SPMD you need an element associated with the arrete otherwise error
142 IF(nint>0) THEN
143 CALL ancmsg(msgid=481,
144 . msgtype=msgerror,
145 . anmode=aninfo_blind_2,
146 . i1=id,
147 . c1=titr,
148 . i2=i)
149 ENDIF
150 IF(nint<0) THEN
151 CALL ancmsg(msgid=482,
152 . msgtype=msgerror,
153 . anmode=aninfo_blind_2,
154 . i1=id,
155 . c1=titr,
156 . i2=i)
157 ENDIF
158 ENDIF
159 250 CONTINUE
160C-----
161 IF(igap>=1)THEN
162 DO i=1,nsn
163 gapm=gapscale * wa(nsv(i))
164 gap_s(i)= gapm
165 ENDDO
166 ENDIF
167C------------------------------------
168C GAP FACES MAINS
169C------------------------------------
170 DO 350 i=1,nrtm
171 inrt=i
172 gapm=zero
173 CALL i4gmx3(x,irectm,inrt,gapmx)
174C----------------------
175C ELEMENTS SOLIDES
176C----------------------
177 CALL insol3(x,irectm,ixs,nint,nels,inrt,
178 . area,noint,knod2els ,nod2els ,0 ,ixs10,
179 . ixs16,ixs20)
180C---------------------
181C ELEMENTS COQUES
182C---------------------
183 CALL incoq3(irectm,ixc ,ixtg ,nint ,nelc ,
184 . neltg,inrt,geo ,pm ,knod2elc ,
185 . knod2eltg ,nod2elc ,nod2eltg,thk,nty,igeo,
186 . pm_stack , iworksh )
187 IF(neltg/=0) THEN
188c IF(IGAP>=1)THEN
189 mg=ixtg(5,neltg)
190 igtyp =igeo(11,mg)
191 ip = iparttg(neltg)
192 dx =geo(1,mg)*gapscale
193 IF(igtyp == 17) dx =thk(numelc+neltg)*gapscale
194c END IF
195 ELSEIF(nelc/=0) THEN
196c IF(IGAP>=1)THEN
197 mg=ixc(6,nelc)
198 igtyp =igeo(11,mg)
199 ip = ipartc(nelc)
200 dx =geo(1,mg)*gapscale
201 IF(igtyp == 17) dx =thk(nelc)*gapscale
202c END IF
203 ENDIF
204 gapm=half*dx
205 gapmn = min(gapmn,half*dx)
206 dxm=dxm+dx
207 ndx=ndx+1
208 IF(igap/=0) gap_m(i)=gapm
209C
210 IF(nels+nelc+neltg==0)THEN
211CTo be checked (second) in SPMD you need an element associated with the arrete otherwise error
212 IF(nint>0) THEN
213 CALL ancmsg(msgid=481,
214 . msgtype=msgerror,
215 . anmode=aninfo_blind_2,
216 . i1=id,
217 . c1=titr,
218 . i2=i)
219 ENDIF
220 IF(nint<0) THEN
221 CALL ancmsg(msgid=482,
222 . msgtype=msgerror,
223 . anmode=aninfo_blind_2,
224 . i1=id,
225 . c1=titr,
226 . i2=i)
227 ENDIF
228 ENDIF
229 350 CONTINUE
230C------------------------------------
231C GAP
232C------------------------------------
233 gapmx=sqrt(gapmx)
234 IF(igap==0)THEN
235C GAP FIXE
236 IF(gap<=zero)THEN
237 IF(ndx/=0)THEN
238 gap = dxm/ndx
239 gap = min(half*gapmx,gap)
240 ELSE
241 gap = em01 * gapmx
242 ENDIF
243 WRITE(iout,1000)gap
244 ENDIF
245 gapmin = gap
246 gapmax = gap
247 ELSE
248C GAP VARIABLE :
249C - GAPMIN CONTIENT ONE GAP MINIMUM UTILISE SI GAP_S(I)+GAP_M(J) < GAPMIN
250C - GAP CONTIENT LE SUP DE (GAP_S(I)+GAP_M(J),GAPMIN)
251 IF(gap<=zero)THEN
252 IF(ndx/=0)THEN
253 gapmin = gapmn
254 gapmin = min(half*gapmx,gapmin)
255 ELSE
256 gapmin = em01 * gapmx
257 ENDIF
258 ELSE
259 gapmin=gap
260 END IF
261 WRITE(iout,1000)gapmin
262C
263C Gap is not used for IGAP> 0;Gapmin can be equal to 0.
264 IF(gapmax==zero)gapmax=ep30
265 WRITE(iout,1500)gapmax
266 gap = min(gap,gapmax)
267 ENDIF
268C------------------------------------
269C
270C Calculation of the real gap to use during the retri criterion
271C
272 bgapsmx = zero
273 IF (igap==0) THEN
274 gapinf=gap
275 ELSE
276 gapinf=ep30
277 DO i = 1, nsn
278 gapinf = min(gapinf,gap_s(i))
279 bgapsmx = max(bgapsmx,gap_s(i))
280 ENDDO
281 DO i = 1, nrtm
282 gapinf = min(gapinf,gap_m(i))
283 ENDDO
284 gapinf=max(gapinf,gapmin)
285 ENDIF
286C---------------------------------------------
287C STiff cote main (1: active ; 0: inactive)
288C------------------------------------
289 DO i=1,nrtm
290 stf(i)=one
291 END DO
292C---------------------------------------------
293C SETTING TO ONE OF THE NODAL STIFFNESS MULTIPLIER
294C---------------------------------------------
295 DO i=1,nsn
296 stfn(i) = one
297 END DO
298C---------------------------
299 RETURN
300 1000 FORMAT(2x,'GAP MIN = ',1pg20.13)
301 1500 FORMAT(2x,'GAP MAX = ',1pg20.13)
302 END
area
subroutine area(d1, x, x2, y, y2, eint, stif0)
Definition hm_read_prop32.F:567
i23gap3
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)
Definition i23gap3.F:47
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
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
max
#define max(a, b)
Definition macros.h:21
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
starter
program starter
Definition starter.F:39