OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
cbufxfe.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!|| cbufxfe ../starter/source/elements/xfem/cbufxfe.F
25!||--- called by ------------------------------------------------------
26!|| c3init3 ../starter/source/elements/sh3n/coque3n/c3init3.F
27!|| cbainit3 ../starter/source/elements/shell/coqueba/cbainit3.F
28!|| cinit3 ../starter/source/elements/shell/coque/cinit3.F
29!||--- calls -----------------------------------------------------
30!|| layini_xfe ../starter/source/elements/xfem/cbufxfe.F
31!|| thick_ilev ../starter/source/elements/xfem/thick_ilev.F
32!||--- uses -----------------------------------------------------
33!|| stack_mod ../starter/share/modules1/stack_mod.F
34!||====================================================================
35 SUBROUTINE cbufxfe(ELBUF_STR,XFEM_STR,ISUBSTACK,STACK ,
36 . IGEO ,GEO ,LFT ,LLT ,MAT,
37 . PID ,NPT ,NPTT ,NLAY,IR ,
38 . IS ,IXFEM,MTN ,NG)
39C-----------------------------------------------
40C M o d u l e s
41C-----------------------------------------------
42 USE elbufdef_mod
43 USE stack_mod
44C-----------------------------------------------
45C I m p l i c i t T y p e s
46C-----------------------------------------------
47#include "implicit_f.inc"
48C-----------------------------------------------
49C G l o b a l P a r a m e t e r s
50C-----------------------------------------------
51#include "mvsiz_p.inc"
52C-----------------------------------------------
53C C o m m o n B l o c k s
54C-----------------------------------------------
55#include "com01_c.inc"
56#include "com_xfem1.inc"
57#include "param_c.inc"
58C-----------------------------------------------
59C D u m m y A r g u m e n t s
60C-----------------------------------------------
61 INTEGER IGEO(NPROPGI,*),LFT,LLT,MAT(*),PID(*),NPT,NPTT,NLAY,
62 . IR,IS,IXFEM,MTN,ISUBSTACK,NG
63C REAL
64 my_real
65 . geo(npropg,*)
66 TYPE(elbuf_struct_) :: ELBUF_STR
67 TYPE(elbuf_struct_), TARGET ,DIMENSION(NGROUP,*):: XFEM_STR
68 ! when XFEM is ON, XFEM_STR's dimension = NGROUP,NXEL
69C-----------------------------------------------
70C L o c a l V a r i a b l e s
71C-----------------------------------------------
72 INTEGER IGTYP,IREP,IXEL,I,II,IT,ILAY,L_DMG
73 INTEGER MATLY(MVSIZ*100)
74 my_real
75 . thkly(mvsiz*100),posly(mvsiz,100)
76 my_real,
77 . DIMENSION(:), POINTER :: dir_dmg
78C
79 TYPE (L_BUFEL_) ,POINTER :: LBUF
80 TYPE (STACK_PLY) :: STACK
81C=======================================================================
82 igtyp = igeo(11,pid(1))
83 irep = igeo(6,pid(1))
84 IF (ixfem == 1) npt = 1
85C
86 DO ixel=1,nxel
87 CALL layini_xfe(elbuf_str,isubstack,stack ,
88 . lft ,llt ,npt ,geo ,igeo ,
89 . mat ,pid ,thkly ,matly ,posly ,
90 . igtyp )
91 CALL thick_ilev(elbuf_str,xfem_str(ng,ixel),
92 . lft ,llt ,nlay ,ir ,is ,
93 . nptt ,ixfem,thkly ,posly,irep ,ixel)
94c
95 IF (mtn == 27) THEN ! Initialize crack directions
96 IF (ixfem == 1) THEN ! multilayer xfem
97 DO ilay=1,nlay
98 DO it=1,elbuf_str%BUFLY(ilay)%NPTT
99 l_dmg = xfem_str(ng,ixel)%BUFLY(ilay)%L_DMG
100 lbuf => xfem_str(ng,ixel)%BUFLY(ilay)%LBUF(ir,is,it)
101 dir_dmg => lbuf%DMG(1:l_dmg*llt)
102 DO i=lft,llt
103 dir_dmg(i) = one
104 dir_dmg(i+llt) = zero
105 ENDDO
106 ENDDO
107 ENDDO
108 ELSE ! monolayer xfem
109 DO it=1,npt
110 l_dmg = xfem_str(ng,ixel)%BUFLY(1)%L_DMG
111 lbuf => xfem_str(ng,ixel)%BUFLY(1)%LBUF(ir,is,it)
112 dir_dmg => lbuf%DMG(1:l_dmg*llt)
113 DO i=lft,llt
114 dir_dmg(i) = one
115 dir_dmg(i+llt) = zero
116 ENDDO
117 ENDDO
118 ENDIF ! Xfem
119 ENDIF ! IF (MTN == 27)
120c
121 ENDDO
122C-----------
123 RETURN
124 END
125!||====================================================================
126!|| layini_xfe ../starter/source/elements/xfem/cbufxfe.F
127!||--- called by ------------------------------------------------------
128!|| cbufxfe ../starter/source/elements/xfem/cbufxfe.F
129!||--- uses -----------------------------------------------------
130!|| stack_mod ../starter/share/modules1/stack_mod.F
131!||====================================================================
132 SUBROUTINE layini_xfe(ELBUF_STR ,ISUBSTACK,STACK ,
133 . LFT ,LLT ,NPT ,GEO ,IGEO ,
134 . MAT ,PID ,THKLY ,MATLY ,POSLY ,
135 . IGTYP )
136C-----------------------------------------------
137C M o d u l e s
138C-----------------------------------------------
139 USE elbufdef_mod
140 USE stack_mod
141C-----------------------------------------------
142C I m p l i c i t T y p e s
143C-----------------------------------------------
144#include "implicit_f.inc"
145C-----------------------------------------------
146C G l o b a l P a r a m e t e r s
147C-----------------------------------------------
148#include "mvsiz_p.inc"
149#include "param_c.inc"
150C-----------------------------------------------
151C D u m m y A r g u m e n t s
152C-----------------------------------------------
153 INTEGER LFT,LLT,NPT,IGTYP,ISUBSTACK
154 INTEGER MAT(*), PID(*), MATLY(*), IGEO(NPROPGI,*)
155 my_real GEO(NPROPG,*), POSLY(MVSIZ,*), THKLY(*)
156 TYPE (ELBUF_STRUCT_) :: ELBUF_STR
157 TYPE (STACK_PLY) :: STACK
158C-----------------------------------------------
159C L o c a l V a r i a b l e s
160C-----------------------------------------------
161 INTEGER I,J,N,NPTT,IADR,IPANG,IPTHK,IPMAT,IPPOS,IPPID,IPID,
162 . jmly,ipt,it,ipt_all,iint,mat_ly,ipid_ly,ilay,nlay,max_nptt
163 parameter(max_nptt = 10)
164 my_real
165 . thk_it(max_nptt),pos_it(max_nptt),thk_ly,pos_ly,thk_nptt,
166 . pos_nptt,thickt,pos_0
167C-----------------------------------------------
168 my_real
169 . a_gauss(9,9),w_gauss(9,9)
170C-----------------------------------------------
171 DATA a_gauss /
172 1 0. ,0. ,0. ,
173 1 0. ,0. ,0. ,
174 1 0. ,0. ,0. ,
175 2 -.577350269189626,0.577350269189626,0. ,
176 2 0. ,0. ,0. ,
177 2 0. ,0. ,0. ,
178 3 -.774596669241483,0. ,0.774596669241483,
179 3 0. ,0. ,0. ,
180 3 0. ,0. ,0. ,
181 4 -.861136311594053,-.339981043584856,0.339981043584856,
182 4 0.861136311594053,0. ,0. ,
183 4 0. ,0. ,0. ,
184 5 -.906179845938664,-.538469310105683,0. ,
185 5 0.538469310105683,0.906179845938664,0. ,
186 5 0. ,0. ,0. ,
187 6 -.932469514203152,-.661209386466265,-.238619186083197,
188 6 0.238619186083197,0.661209386466265,0.932469514203152,
189 6 0. ,0. ,0. ,
190 7 -.949107912342759,-.741531185599394,-.405845151377397,
191 7 0. ,0.405845151377397,0.741531185599394,
192 7 0.949107912342759,0. ,0. ,
193 8 -.960289856497536,-.796666477413627,-.525532409916329,
194 8 -.183434642495650,0.183434642495650,0.525532409916329,
195 8 0.796666477413627,0.960289856497536,0. ,
196 9 -.968160239507626,-.836031107326636,-.613371432700590,
197 9 -.324253423403809,0. ,0.324253423403809,
198 9 0.613371432700590,0.836031107326636,0.968160239507626/
199 DATA w_gauss /
200 1 2. ,0. ,0. ,
201 1 0. ,0. ,0. ,
202 1 0. ,0. ,0. ,
203 2 1. ,1. ,0. ,
204 2 0. ,0. ,0. ,
205 2 0. ,0. ,0. ,
206 3 0.555555555555556,0.888888888888889,0.555555555555556,
207 3 0. ,0. ,0. ,
208 3 0. ,0. ,0. ,
209 4 0.347854845137454,0.652145154862546,0.652145154862546,
210 4 0.347854845137454,0. ,0. ,
211 4 0. ,0. ,0. ,
212 5 0.236926885056189,0.478628670499366,0.568888888888889,
213 5 0.478628670499366,0.236926885056189,0. ,
214 5 0. ,0. ,0. ,
215 6 0.171324492379170,0.360761573048139,0.467913934572691,
216 6 0.467913934572691,0.360761573048139,0.171324492379170,
217 6 0. ,0. ,0. ,
218 7 0.129484966168870,0.279705391489277,0.381830050505119,
219 7 0.417959183673469,0.381830050505119,0.279705391489277,
220 7 0.129484966168870,0. ,0. ,
221 8 0.101228536290376,0.222381034453374,0.313706645877887,
222 8 0.362683783378362,0.362683783378362,0.313706645877887,
223 8 0.222381034453374,0.101228536290376,0. ,
224 9 0.081274388361574,0.180648160694857,0.260610696402935,
225 9 0.312347077040003,0.330239355001260,0.312347077040003,
226 9 0.260610696402935,0.180648160694857,0.081274388361574/
227C=======================================================================
228 ipthk = 300
229 ippos = 400
230 ipmat = 100
231 nlay = elbuf_str%NLAY
232c-----------
233 IF (igtyp==11) THEN
234 DO ilay=1,nlay
235 iadr = (ilay-1)*llt
236 DO i=lft,llt
237 j = iadr+i
238 matly(j) = igeo(ipmat+ilay,pid(1))
239 thkly(j) = geo(ipthk+ilay,pid(1))
240 posly(i,ilay) = geo(ippos+ilay,pid(1))
241 ENDDO
242 ENDDO
243c-----------
244 ELSEIF (igtyp == 51.OR. igtyp == 52) THEN
245 ipt_all = 0
246 ipang = 1
247 ippid = 2
248 ipmat = ippid + nlay ! layer material address
249 ipthk = ipang + nlay ! layer thickness address
250 ippos = ipthk + nlay ! layer position address
251 DO ilay=1,nlay
252 nptt = elbuf_str%BUFLY(ilay)%NPTT
253 thk_ly = stack%GEO(ipthk + ilay,isubstack) ! layer thickness ratio
254 pos_ly = stack%GEO(ippos + ilay,isubstack) ! layer position ratio
255 mat_ly = stack%IGEO(ipmat + ilay,isubstack) ! layer material
256 ipid_ly = stack%IGEO(ippid + ilay,isubstack) ! layer PID (igtyp = 19)
257 ipid = stack%IGEO(ippid,isubstack)
258 iint = igeo(47,ipid)
259 IF (iint == 1) THEN ! uniform distribution - by default
260 DO it=1,nptt
261 thk_it(it) = thk_ly/nptt ! equally distribution of NPTT through layer
262 ENDDO
263 pos_0 = pos_ly - half*thk_ly
264 IF (nlay == 1) pos_0 = - half !! special case
265 pos_it(1) = pos_0 + half*thk_it(1)
266 DO it=2,nptt
267 pos_it(it) = pos_it(it-1) + half*(thk_it(it) + thk_it(it-1))
268 ENDDO
269 ELSEIF (iint == 2) THEN ! Gauss distribution
270 DO it=1,nptt
271 thk_it(it) = half*thk_ly*w_gauss(it,nptt)
272 pos_it(it) = pos_ly + half*thk_ly*a_gauss(it,nptt)
273 ENDDO
274 ENDIF
275c remplissage
276 DO it=1,nptt
277 ipt = ipt_all + it
278 thk_nptt = thk_it(it)
279 pos_nptt = pos_it(it)
280 IF (nptt == 1) THEN
281 thk_nptt = thk_ly
282 pos_nptt = pos_ly
283 ENDIF
284 DO i=lft,llt
285 j = (ipt-1)*llt + i
286 jmly = (ilay-1)*llt + i
287C
288 thkly(j) = thk_ly ! LAYER thickness ratio !
289 posly(i,ipt)= pos_nptt ! integr. point "IT" position ratio
290 matly(jmly) = mat_ly ! layer defined
291 ENDDO
292 ENDDO
293 ipt_all = ipt_all + nptt
294 ENDDO ! DO ILAY=1,NPT
295c-----------
296 ELSEIF (igtyp==1) THEN
297 DO n=1,npt
298 iadr = (n-1)*llt
299 DO i = lft,llt
300 j = iadr+i
301 thkly(j) = one/npt
302 posly(i,n) = geo(ippos+n,pid(i))
303 matly(j) = mat(i)
304 ENDDO
305 ENDDO
306 ELSE
307 DO n=1,npt
308 iadr = (n-1)*llt
309 DO i = lft,llt
310 j = iadr+i
311 thkly(j) = geo(ipthk+n,pid(i))
312 posly(i,n) = geo(ippos+n,pid(i))
313 matly(j) = mat(i)
314 ENDDO
315 ENDDO
316 ENDIF
317c-----------
318 RETURN
319 END
cbufxfe
subroutine cbufxfe(elbuf_str, xfem_str, isubstack, stack, igeo, geo, lft, llt, mat, pid, npt, nptt, nlay, ir, is, ixfem, mtn, ng)
Definition cbufxfe.F:39
layini_xfe
subroutine layini_xfe(elbuf_str, isubstack, stack, lft, llt, npt, geo, igeo, mat, pid, thkly, matly, posly, igtyp)
Definition cbufxfe.F:136
my_real
#define my_real
Definition cppsort.cpp:32
stack_mod
Definition stack_mod.F:72
thick_ilev
subroutine thick_ilev(elbuf_str, xfem_str, lft, llt, nlay, ir, is, nptt, ixfem, thkly, posly, irep, ixel)
Definition thick_ilev.F:32