OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
inint3_thkvar.F
Go to the documentation of this file.
1Copyright> OpenRadioss
2Copyright> Copyright (C) 1986-2025 Altair Engineering Inc.
3Copyright>
4Copyright> This program is free software: you can redistribute it and/or modify
5Copyright> it under the terms of the GNU Affero General Public License as published by
6Copyright> the Free Software Foundation, either version 3 of the License, or
7Copyright> (at your option) any later version.
8Copyright>
9Copyright> This program is distributed in the hope that it will be useful,
10Copyright> but WITHOUT ANY WARRANTY; without even the implied warranty of
11Copyright> MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12Copyright> GNU Affero General Public License for more details.
13Copyright>
14Copyright> You should have received a copy of the GNU Affero General Public License
15Copyright> along with this program. If not, see <https://www.gnu.org/licenses/>.
16Copyright>
17Copyright>
18Copyright> Commercial Alternative: Altair Radioss Software
19Copyright>
20Copyright> As an alternative to this open-source version, Altair also offers Altair Radioss
21Copyright> software under a commercial license. Contact Altair to discuss further if the
22Copyright> commercial version may interest you: https://www.altair.com/radioss/.
23!||====================================================================
24!|| inint3_thkvar ../starter/source/interfaces/inter3d1/inint3_thkvar.F
25!||--- called by ------------------------------------------------------
26!|| inintr_thkvar ../starter/source/interfaces/interf1/inintr_thkvar.F
27!||--- calls -----------------------------------------------------
28!|| ancmsg ../starter/source/output/message/message.F
29!|| i21buc1 ../starter/source/interfaces/inter3d1/i21buc3.F
30!|| i21dst3 ../starter/source/interfaces/inter3d1/i21dst3.F
31!|| i21gap3 ../starter/source/interfaces/inter3d1/i21gap3.F
32!|| i21norm3 ../starter/source/interfaces/inter3d1/i21norm3.F
33!|| i21pwr3 ../starter/source/interfaces/inter3d1/i21pwr3.F
34!|| i21rcurv ../starter/source/interfaces/inter3d1/i21norm3.F
35!|| i21reset ../starter/source/interfaces/inter3d1/i21reset.F
36!|| i21rot ../starter/source/interfaces/inter3d1/i21rot.f
37!||--- uses -----------------------------------------------------
38!|| intstamp_mod ../starter/share/modules1/intstamp_mod.F
39!|| message_mod ../starter/share/message_module/message_mod.F
40!||====================================================================
41 SUBROUTINE inint3_thkvar(
42 1 INTBUF_TAB ,INSCR ,X ,IXS ,
43 2 IXC ,IXTG ,PM ,GEO ,IPARI ,
44 3 NUMINT ,ITAB ,MWA ,RWA ,IWRN ,
45 4 IKINE ,KNOD2ELS,KNOD2ELC,KNOD2ELTG ,NOD2ELS ,
46 5 NOD2ELC,NOD2ELTG ,
47 6 THKSH4_VAR,THKSH3_VAR,THKNOD,INTSTAMP,SKEW ,
48 7 MS ,IN ,V ,VR ,RBY ,
49 8 NPBY ,LPBY ,I_MEM ,RESORT,IPARTS ,
50 9 IPARTC ,IPARTG ,THK_PART,ID ,TITR,
51 A NOM_OPT)
52C-----------------------------------------------
53C M o d u l e s
54C-----------------------------------------------
55 USE message_mod
56 USE intstamp_mod
57 USE intbufdef_mod
59C-----------------------------------------------
60C I m p l i c i t T y p e s
61C-----------------------------------------------
62#include "implicit_f.inc"
63C-----------------------------------------------
64C G l o b a l P a r a m e t e r s
65C-----------------------------------------------
66#include "mvsiz_p.inc"
67C-----------------------------------------------
68C C o m m o n B l o c k s
69C-----------------------------------------------
70#include "com04_c.inc"
71#include "param_c.inc"
72#include "scr03_c.inc"
73#include "units_c.inc"
74#include "vect07_c.inc"
75#include "scr17_c.inc"
76C-----------------------------------------------
77C D u m m y A r g u m e n t s
78C-----------------------------------------------
79 INTEGER NUMINT, IWRN, I_MEM, RESORT
80 INTEGER INSCR(*), IXS(NIXS,*), IXC(NIXC,*),
81 . IXTG(NIXTG,*), IPARI(*), ITAB(*), MWA(*), IKINE(*),
82 . KNOD2ELS(*), KNOD2ELC(*), KNOD2ELTG(*),
83 . NOD2ELS(*), NOD2ELC(*), NOD2ELTG(*),
84 . NPBY(NNPBY,*), LPBY(*), IPARTS(*), IPARTC(*), IPARTG(*)
85 TYPE(INTSTAMP_DATA) INTSTAMP
86 INTEGER NOM_OPT(LNOPT1,*)
87 my_real
88 . X(3,*), PM(*), GEO(*),RWA(6,*),
89 . thksh4_var(*), thksh3_var(*), thknod(*),
90 . skew(lskew,*), ms(*), in(*), v(3,*), vr(3,*), rby(nrby,*),
91 . thk_part(*)
92 INTEGER ID
93 CHARACTER(LEN=NCHARTITLE) :: TITR
94 TYPE(INTBUF_STRUCT_) :: INTBUF_TAB
95C-----------------------------------------------
96C L o c a l V a r i a b l e s
97C-----------------------------------------------
98 INTEGER NRTS, NRTM, NSN, NMN, NTY, NST, MST, NOINT,
99 . I, I_STOK,IRS,IRM,
100 . NSEG, NGROUS, NG, INACTI,IWPENE,
101 . JLT_NEW,IGAP,MULTIMP,IADM,INTTH,
102 . isu1, isu2,
103 . isk, irot, j, msr, irb, k, nsl, n
104 INTEGER, DIMENSION(MVSIZ) ::PROV_N,PROV_E
105 INTEGER, DIMENSION(MVSIZ) :: IX1,IX2,IX3,IX4,NSVG
106 my_real, DIMENSION(MVSIZ) :: X1,X2,X3,X4
107 my_real, DIMENSION(MVSIZ) :: Y1,Y2,Y3,Y4
108 my_real, DIMENSION(MVSIZ) :: z1,z2,z3,z4
109 my_real, DIMENSION(MVSIZ) :: xi,yi,zi
110 my_real, DIMENSION(MVSIZ) :: x0,y0,z0,stif
111 my_real, DIMENSION(MVSIZ) :: n11,n21,n31,pene1
112 my_real, DIMENSION(MVSIZ) :: nx1,ny1,nz1
113 my_real, DIMENSION(MVSIZ) :: nx2,ny2,nz2
114 my_real, DIMENSION(MVSIZ) :: nx3,ny3,nz3
115 my_real, DIMENSION(MVSIZ) :: nx4,ny4,nz4
116 my_real, DIMENSION(MVSIZ) :: p1,p2,p3,p4
117 my_real, DIMENSION(MVSIZ) :: lb1,lb2,lb3,lb4
118 my_real, DIMENSION(MVSIZ) :: lc1,lc2,lc3,lc4
119 INTEGER, DIMENSION(:),ALLOCATABLE :: TAGNOD
120 my_real, DIMENSION(:) ,POINTER :: gap_s0
121 my_real,TARGET, DIMENSION(1):: gaps0_bid
122C REAL
123 my_real
124 . maxbox,minbox
125 my_real
126 . gapv(mvsiz), pene(mvsiz),gap0
127 CHARACTER MESS*40
128 DATA mess/'/INTER/TYPE21 INITIALIZATIONS '/
129C-----------------------------------------------
130C
131 ALLOCATE(tagnod(numnod))
132 iwpene = 0
133 nrts =ipari(3)
134 nrtm =ipari(4)
135 nsn =ipari(5)
136 nmn =ipari(6)
137 nty =ipari(7)
138 nst =ipari(8)
139 mst =ipari(9)
140 noint =ipari(15)
141 igap =ipari(21)
142 inacti= ipari(22)
143 multimp= ipari(23)
144 irm= ipari(24)
145 irs= ipari(25)
146 isu1=ipari(45)
147 isu2=ipari(46)
148 iadm=ipari(44)
149 intth=ipari(47)
150C
151C
152 IF (resort == 0)THEN
153 WRITE(iout,2001)noint,nty
154 END IF
155C
156C=======================================================================
157 IF(nty==21) THEN
158C=======================================================================
159C
160C CALCUL DU GAP, apres INITIA (lecture des epaisseurs).
161C
162 IF(igap == 2) THEN
163 gap0 = intbuf_tab%VARIABLES(2)
164 CALL i21gap3(
165 1 x ,intbuf_tab%IRECTS,intbuf_tab%IRECTM,nrts,nrtm,
166 2 geo ,pm ,ixs ,ixc ,ixtg ,
167 3 -numint ,nty ,noint ,nsn ,intbuf_tab%NSV,
168 4 gap0,igap ,intbuf_tab%GAP_S,intbuf_tab%VARIABLES(13),
169 . intbuf_tab%VARIABLES(6),
170 5 intbuf_tab%VARIABLES(16),intbuf_tab%IELES,intbuf_tab%STF,
171 . nmn ,intbuf_tab%MSR ,
172 6 knod2els ,knod2elc ,knod2eltg ,nod2els ,nod2elc ,
173 7 nod2eltg ,thknod ,
174 8 ikine ,itab ,inacti ,intbuf_tab%VARIABLES(19),
175 . intbuf_tab%STFNS,
176 9 intbuf_tab%VARIABLES(23),intbuf_tab%GAP_S(1+nsn:2*nsn),intbuf_tab%AREAS,
177 . intbuf_tab%XM0,intbuf_tab%VARIABLES(27),
178 a intbuf_tab%VARIABLES(28),intbuf_tab%VARIABLES(29),intth ,intbuf_tab%VARIABLES(32),
179 . iparts ,
180 b ipartc, ipartg, thk_part,intbuf_tab%THKNOD0 ,id,titr ,
181 c intbuf_tab%VARIABLES(46),resort )
182
183 ELSE
184 gap_s0 => gaps0_bid
185 gap0 = intbuf_tab%VARIABLES(2)
186 CALL i21gap3(
187 1 x ,intbuf_tab%IRECTS,intbuf_tab%IRECTM,nrts,nrtm,
188 2 geo ,pm ,ixs ,ixc ,ixtg ,
189 3 -numint ,nty ,noint ,nsn ,intbuf_tab%NSV,
190 4 gap0,igap ,intbuf_tab%GAP_S,intbuf_tab%VARIABLES(13),
191 . intbuf_tab%VARIABLES(6),
192 5 intbuf_tab%VARIABLES(16),intbuf_tab%IELES,intbuf_tab%STF,
193 . nmn ,intbuf_tab%MSR ,
194 6 knod2els ,knod2elc ,knod2eltg ,nod2els ,nod2elc ,
195 7 nod2eltg ,thknod ,
196 8 ikine ,itab ,inacti ,intbuf_tab%VARIABLES(19),
197 . intbuf_tab%STFNS,
198 9 intbuf_tab%VARIABLES(23),gap_s0,intbuf_tab%AREAS,
199 . intbuf_tab%XM0,intbuf_tab%VARIABLES(27),
200 a intbuf_tab%VARIABLES(28),intbuf_tab%VARIABLES(29),intth ,intbuf_tab%VARIABLES(32),
201 . iparts ,
202 b ipartc, ipartg, thk_part,intbuf_tab%THKNOD0 ,id,titr ,
203 c intbuf_tab%VARIABLES(46),resort )
204
205 ENDIF
206C
207C INITIALISATIONS (PRE-CALCUL DES NORMALES, etc)
208C
209 CALL i21norm3(
210 1 x ,intbuf_tab%IRECTM,nrtm ,nmn ,intbuf_tab%MSR ,
211 2 -numint ,nty ,noint ,intbuf_tab%NOD_NORMAL,intbuf_tab%XM0)
212C
213 IF(iadm/=0)THEN
214 CALL i21rcurv(
215 1 nrtm ,intbuf_tab%XM0,intbuf_tab%NOD_NORMAL,intbuf_tab%IRECTM,intbuf_tab%RCURV,
216 2 intbuf_tab%ANGLM)
217 END IF
218C
219 CALL i21reset(nsn, intbuf_tab%IRTLM, intbuf_tab%CSTS)
220C
221C IL FAUT ENCORE FAIRE ONE BUCKET SORT DANS LE STARTER
222C
223 maxbox = intbuf_tab%VARIABLES(9)
224 minbox = intbuf_tab%VARIABLES(12)
225 CALL i21buc1(
226 1 x ,intbuf_tab%IRECTM ,intbuf_tab%NSV,intbuf_tab%VARIABLES(4),nseg ,
227 2 nmn ,nrtm ,mwa ,nsn ,intbuf_tab%CAND_E ,
228 3 intbuf_tab%CAND_N ,gap0,rwa ,noint,i_stok ,
229 4 intbuf_tab%VARIABLES(5),intbuf_tab%VARIABLES(8),maxbox ,minbox ,intbuf_tab%MSR,
230 5 intbuf_tab%STF ,multimp ,itab ,intbuf_tab%GAP_S ,igap ,
231 6 intbuf_tab%VARIABLES(13),intbuf_tab%VARIABLES(16) ,inacti ,nrts ,intbuf_tab%IRECTS,
232 7 intbuf_tab%XM0 ,intbuf_tab%VARIABLES(23),intbuf_tab%VARIABLES(22),
233 8 intbuf_tab%VARIABLES(32),id,titr,i_mem,
234 9 ix1 ,ix2 ,ix3 ,ix4 ,nsvg ,
235 1 x1 ,x2 ,x3 ,x4 ,y1 ,
236 2 y2 ,y3 ,y4 ,z1 ,z2 ,
237 3 z3 ,z4 ,xi ,yi ,zi ,
238 4 x0 ,y0 ,z0 ,stif ,nx1 ,
239 5 ny1 ,nz1 ,nx2 ,ny2 ,nz2 ,
240 6 nx3 ,ny3 ,nz3 ,nx4 ,ny4 ,
241 7 nz4 ,p1 ,p2 ,p3 ,p4 ,
242 8 lb1 ,lb2 ,lb3 ,lb4 ,lc1 ,
243 9 lc2 ,lc3 ,lc4 ,pene1 ,prov_n ,
244 1 prov_e,n11 ,n21 ,n31 ,intbuf_tab%VARIABLES(46))
245 IF (i_mem == 2 ) resort = resort + 1
246 IF (i_mem == 2 ) RETURN
247 intbuf_tab%VARIABLES(9) = maxbox
248 intbuf_tab%VARIABLES(12) = minbox
249 intbuf_tab%VARIABLES(2) = gap0
250C
251C PUIS CALCULER LES PENETRATIONS INITIALES AVEC ONE I21DST3
252C
253 ngrous=1+(i_stok-1)/nvsiz
254C
255 DO 700 ng=1,ngrous
256
257 IF(ipri>=1) WRITE(iout,2007)
258 nft = (ng-1) * nvsiz
259 lft = 1
260 llt = min0( nvsiz, i_stok - nft )
261 CALL i21dst3(
262 1 llt ,intbuf_tab%CAND_N(1+nft),intbuf_tab%CAND_E(1+nft),intbuf_tab%IRECTM,intbuf_tab%NSV,
263 2 intbuf_tab%GAP_S,x ,intbuf_tab%IRTLM,intbuf_tab%CSTS,
264 . intbuf_tab%VARIABLES(23),
265 3 intbuf_tab%NOD_NORMAL,intbuf_tab%XM0,pene,intbuf_tab%PENIS,intbuf_tab%IFPEN,
266 4 igap ,intbuf_tab%VARIABLES(2), intbuf_tab%VARIABLES(16), intbuf_tab%VARIABLES(13) ,
267 . intbuf_tab%VARIABLES(32),
268 5 intbuf_tab%VARIABLES(46))
269 700 CONTINUE
270C
271 CALL i21pwr3(
272 . itab ,inacti,intbuf_tab%CAND_E,intbuf_tab%CAND_N,intbuf_tab%STFNS,
273 1 x ,i_stok,intbuf_tab%NSV,iwpene ,intbuf_tab%PENIS,
274 2 noint ,nty ,intbuf_tab%GAP_S,intbuf_tab%MSR,intbuf_tab%IRTLM,
275 3 intbuf_tab%IRECTM ,intbuf_tab%XM0,intbuf_tab%VARIABLES(13),intbuf_tab%VARIABLES(16),
276 . intbuf_tab%VARIABLES(23),
277 4 nsn ,mwa ,intbuf_tab%VARIABLES(32),id,titr)
278
279 IF(iwpene==0.AND.(inacti==5.OR.inacti==6))
280 . ipari(22) = -inacti ! passage en negatif pour dimensionnenment
281 intbuf_tab%I_STOK(1)=iwpene
282C
283C IF(NUMELS10>0)CALL
284C . INSOLT10(IXS(1,NUMELS8+1),IXS(1,NUMELS+1),INTBUF_TAB%IRECTM),
285C . NOINT,NRTM,ITAB,KNOD2ELS,NOD2ELS)
286C=======================================================================
287C COPIE DONNEES RBODY => INTERFACE
288C----------------------------------------------------------------
289 irb=intstamp%IRB
290 msr=intstamp%MSR
291 intstamp%XG(1)=x(1,msr)
292 intstamp%XG(2)=x(2,msr)
293 intstamp%XG(3)=x(3,msr)
294 intstamp%V(1) =v(1,msr)
295 intstamp%V(2) =v(2,msr)
296 intstamp%V(3) =v(3,msr)
297 intstamp%MASS =ms(msr)
298 DO j=1,9
299 intstamp%ROT(j)=rby(j,irb)
300 END DO
301 intstamp%IN(1)=rby(10,irb)
302 intstamp%IN(2)=rby(11,irb)
303 intstamp%IN(3)=rby(12,irb)
304 intstamp%VR(1)=vr(1,msr)
305 intstamp%VR(2)=vr(2,msr)
306 intstamp%VR(3)=vr(3,msr)
307C----------------------------------------------------------------
308C CHECK MAIN NODES OF INTERFACE BELONG TO ASSOCIATED RBODY
309C----------------------------------------------------------------
310 k=0
311 DO n=1,irb-1
312 k=k+npby(2,n)
313 END DO
314C
315 tagnod(1:numnod)=0
316C
317 nsl=npby(2,irb)
318 DO i=1,nsl
319 n=lpby(k+i)
320 tagnod(n)=1
321 END DO
322C
323 DO i=1,nmn
324 n=intbuf_tab%MSR(i)
325 IF(tagnod(n)==0)THEN
326 CALL ancmsg(msgid=932,
327 . msgtype=msgerror,
328 . anmode=aninfo,
329 . i1=id,
330 . c1=titr,
331 . i2=itab(n),
332 . i3=nom_opt(1,irb))
333 END IF
334 END DO
335C----------------------------------------------------------------
336C PASSAGE DE NOD_NORMAL et XM0 en COORD LOCALES
337C - DS REP INERTIES PRINCIPALES)
338C----------------------------------------------------------------
339 irot=intstamp%IROT
340 CALL i21rot(
341 1 irot ,intstamp%XG,intstamp%ROT,nmn ,intbuf_tab%NOD_NORMAL,
342 2 intbuf_tab%XM0,intstamp%BRACKET,nrtm,intbuf_tab%IRECTM,
343 . intbuf_tab%VARIABLES(27),
344 3 intbuf_tab%VARIABLES(28),intbuf_tab%VARIABLES(29),nsn,intbuf_tab%XSAV)
345C=======================================================================
346 ENDIF
347 DEALLOCATE(tagnod)
348C
349 RETURN
350C---+----1----+----2----+----3----+----4----+----5----+----6----+----7--
351 2001 FORMAT(//,1x,'INTERFACE NUMBER. . . . . . . . . . . . . .',i10/
352 + ,1x,'INTERFACE TYPE. . . . . . . . . . . . . . .',i6/)
353 2002 FORMAT(//
354 +' SECONDARY NEAREST NEAREST MAIN NODES SECONDARY '/
355 +' NODE MAIN SEGMENT S T')
356 2022 FORMAT(//
357 +' SECONDARY NEAREST MAIN NODES SECONDARY '/
358 +' node segment ',
359 +' s t dist')
360 2003 FORMAT(//
361 +' main nearest nearest secondary nodes main'/
362 +' node secondary segment s t')
363 2007 FORMAT(//' impact candidates',/,
364 +' main secondary nodes '/
365 +' node ')
366 2011 FORMAT(//' impact candidates',/,
367 +' main nodes secondary nodes ')
368C-----
369 END
subroutine i21buc1(x, irect, nsv, bumult, nseg, nmn, nrtm, mwa, nsn, cand_e, cand_n, gap, xyzm, noint, i_stok, dist, tzinf, maxbox, minbox, msr, stf, multimp, itab, gap_s, igap, gapmin, gapmax, inacti, nrts, irects, xm0, depth, margeref, drad, id, titr, i_mem, ix1, ix2, ix3, ix4, nsvg, x1, x2, x3, x4, y1, y2, y3, y4, z1, z2, z3, z4, xi, yi, zi, x0, y0, z0, stif, nx1, ny1, nz1, nx2, ny2, nz2, nx3, ny3, nz3, nx4, ny4, nz4, p1, p2, p3, p4, lb1, lb2, lb3, lb4, lc1, lc2, lc3, lc4, pene, prov_n, prov_e, n11, n21, n31, dgapload)
Definition i21buc3.F:57
subroutine i21norm3(x, irectm, nrtm, nmn, msr, nint, nty, noint, nod_normal, xm0)
Definition i21norm3.F:31
subroutine i21rcurv(nrtm, xm0, nod_normal, irect, rcurv, anglm)
Definition i21norm3.F:250
subroutine i21pwr3(itab, inacti, cand_e, cand_n, stfn, x, i_stok, nsv, iwpene, peni, noint, nty, gap_s, msr, irtlm, irect, xm0, gapmin, gapmax, depth, nsn, itag, drad, id, titr)
Definition i21pwr3.F:38
subroutine i21rot(irot, xg, rot, nmn, nod_normal, xm0, bracket, nrtm, irectm, lxm, lym, lzm, nsn, xsav)
Definition i21rot.F:31
subroutine inint3_thkvar(intbuf_tab, inscr, x, ixs, ixc, ixtg, pm, geo, ipari, numint, itab, mwa, rwa, iwrn, ikine, knod2els, knod2elc, knod2eltg, nod2els, nod2elc, nod2eltg, thksh4_var, thksh3_var, thknod, intstamp, skew, ms, in, v, vr, rby, npby, lpby, i_mem, resort, iparts, ipartc, ipartg, thk_part, id, titr, nom_opt)
integer, parameter nchartitle
int main(int argc, char *argv[])
subroutine i21dst3(jlt, cand_n, cand_e, irect, nsv, gap_s, x, irtlm, csts, depth, nod_normal, xm0, pene, peni, ifpen, igap, gap, gapmax, gapmin, drad, dgapload)
Definition i21dst3.F:34
subroutine i21gap3(x, irects, irectm, nrts, nrtm, geo, pm, ixs, ixc, ixtg, nint, nty, noint, nsn, nsv, gap, igap, gap_s, gapmin, criter, gapmax, ieles, stf, nmn, msr, knod2els, knod2elc, knod2eltg, nod2els, nod2elc, nod2eltg, thknod, ikine, itab, inacti, gapscale, stfn, depth, gap_s0, area_s0, xm0, lxm, lym, lzm, intth, drad, iparts, ipartc, ipartg, thk_part, thknod0, id, titr, dgapload, resort)
Definition i21gap3.F:46
subroutine i21reset(nsn, irtlm, csts)
Definition i21reset.F:29
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
program starter
Definition starter.F:39