OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
shellthk_upd.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!|| shellthk_upd ../starter/source/properties/composite_options/drape/shellthk_upd.F
25!||--- called by ------------------------------------------------------
26!|| lectur ../starter/source/starter/lectur.F
27!||--- uses -----------------------------------------------------
28!|| drape_mod ../starter/share/modules1/drape_mod.F
29!|| stack_mod ../starter/share/modules1/stack_mod.F
30!|| submodel_mod ../starter/share/modules1/submodel_mod.F
31!||====================================================================
32 SUBROUTINE shellthk_upd(
33 . DRAPE , STACK, THK ,IXC ,IXTG ,
34 . IGEO ,IWORKSH ,INDX)
35C-----------------------------------------------
36C M o d u l e s
37C-----------------------------------------------
38 USE submodel_mod
39 USE stack_mod
40 USE drape_mod
41 use element_mod , only : nixc,nixtg
42C-----------------------------------------------
43C I m p l i c i t T y p e s
44C-----------------------------------------------
45#include "implicit_f.inc"
46C-----------------------------------------------
47C A n a l y s e M o d u l e
48C-----------------------------------------------
49C-----------------------------------------------
50C C o m m o n B l o c k s
51C-----------------------------------------------
52#include "com04_c.inc"
53#include "param_c.inc"
54C-----------------------------------------------
55C D u m m y A r g u m e n t s
56C-----------------------------------------------
57 INTEGER :: IXC(NIXC,*),
58 . IXTG(NIXTG,*),IGEO(NPROPGI,*),IWORKSH(3,*)
59 my_real ::
60 . thk(*)
61C-----------------------------------------------
62 TYPE (DRAPE_) , DIMENSION(*), TARGET :: DRAPE
63 TYPE (STACK_PLY) :: STACK
64 INTEGER, DIMENSION(NUMELC+NUMELTG) :: INDX
65C-----------------------------------------------
66C L o c a l V a r i a b l e s
67C-----------------------------------------------
68 INTEGER :: II,NPT,PID, IGTYP,IPOS,IPPID,IPMAT,IPANG, IPTHK,
69 . IPPOS, NTHK,ISUBS,J,I3,ISH3N,IE,NSLICE,K,IINT,IPID,IP
70 my_real :: thinning, thkly ,tmin,tmax,thickt,thickc, thk_it
71 TYPE (DRAPE_PLY_), POINTER :: DRAPE_PLY
72C-----------------------------------------------
73C-----------------------------------------------
74 my_real
75 . a_gauss(9,9),w_gauss(9,9)
76C-----------------------------------------------
77 DATA a_gauss /
78 1 0. ,0. ,0. ,
79 1 0. ,0. ,0. ,
80 1 0. ,0. ,0. ,
81 2 -.577350269189626,0.577350269189626,0. ,
82 2 0. ,0. ,0. ,
83 2 0. ,0. ,0. ,
84 3 -.774596669241483,0. ,0.774596669241483,
85 3 0. ,0. ,0. ,
86 3 0. ,0. ,0. ,
87 4 -.861136311594053,-.339981043584856,0.339981043584856,
88 4 0.861136311594053,0. ,0. ,
89 4 0. ,0. ,0. ,
90 5 -.906179845938664,-.538469310105683,0. ,
91 5 0.538469310105683,0.906179845938664,0. ,
92 5 0. ,0. ,0. ,
93 6 -.932469514203152,-.661209386466265,-.238619186083197,
94 6 0.238619186083197,0.661209386466265,0.932469514203152,
95 6 0. ,0. ,0. ,
96 7 -.949107912342759,-.741531185599394,-.405845151377397,
97 7 0. ,0.405845151377397,0.741531185599394,
98 7 0.949107912342759,0. ,0. ,
99 8 -.960289856497536,-.796666477413627,-.525532409916329,
100 8 -.183434642495650,0.183434642495650,0.525532409916329,
101 8 0.796666477413627,0.960289856497536,0. ,
102 9 -.968160239507626,-.836031107326636,-.613371432700590,
103 9 -.324253423403809,0. ,0.324253423403809,
104 9 0.613371432700590,0.836031107326636,0.968160239507626/
105 DATA w_gauss /
106 1 2. ,0. ,0. ,
107 1 0. ,0. ,0. ,
108 1 0. ,0. ,0. ,
109 2 1. ,1. ,0. ,
110 2 0. ,0. ,0. ,
111 2 0. ,0. ,0. ,
112 3 0.555555555555556,0.888888888888889,0.555555555555556,
113 3 0. ,0. ,0. ,
114 3 0. ,0. ,0. ,
115 4 0.347854845137454,0.652145154862546,0.652145154862546,
116 4 0.347854845137454,0. ,0. ,
117 4 0. ,0. ,0. ,
118 5 0.236926885056189,0.478628670499366,0.568888888888889,
119 5 0.478628670499366,0.236926885056189,0. ,
120 5 0. ,0. ,0. ,
121 6 0.171324492379170,0.360761573048139,0.467913934572691,
122 6 0.467913934572691,0.360761573048139,0.171324492379170,
123 6 0. ,0. ,0. ,
124 7 0.129484966168870,0.279705391489277,0.381830050505119,
125 7 0.417959183673469,0.381830050505119,0.279705391489277,
126 7 0.129484966168870,0. ,0. ,
127 8 0.101228536290376,0.222381034453374,0.313706645877887,
128 8 0.362683783378362,0.362683783378362,0.313706645877887,
129 8 0.222381034453374,0.101228536290376,0. ,
130 9 0.081274388361574,0.180648160694857,0.260610696402935,
131 9 0.312347077040003,0.330239355001260,0.312347077040003,
132 9 0.260610696402935,0.180648160694857,0.081274388361574/
133C=======================================================================
134!!###########################################################
135C
136 DO ii=1,numelc
137 npt = iworksh(1,ii)
138 pid = ixc(6,ii)
139 igtyp = igeo(11,pid)
140 IF(igtyp /=17 .AND. igtyp /= 51 .AND. igtyp /= 52) cycle
141 ipos = igeo(99,pid)
142C---
143C update the shell thickness if /DRAPE defined
144C---
145C re-set the thickness of shell according to /DRAPE layer thinning
146 tmin = ep20
147 tmax = -ep20
148 thickt = zero
149 ippid = 2
150 ipmat = ippid + npt
151 ipang = 1
152 ipthk = ipang + npt
153 ippos = ipthk + npt
154 nthk = ippos + npt
155 isubs = iworksh(3,ii)
156 thickt = stack%GEO(1 ,isubs)
157 ie = indx(ii)
158!!
159 thickc = zero
160 IF(ie == 0 ) THEN
161 DO j=1,npt
162 i3 = ipthk + j
163 thkly = stack%GEO(i3 ,isubs)*thickt
164 thickc = thickt + thkly
165 ENDDO
166 ELSE
167 IF(igtyp == 51 .OR. igtyp == 52) THEN
168 DO j=1,npt
169 i3 = ipthk + j
170 thkly = stack%GEO(i3 ,isubs)*thickt
171 ipid = stack%IGEO(ippid + j,isubs)
172 iint = igeo(47,pid)
173 ip = drape(ie)%INDX_PLY(j)
174 IF(ip > 0) THEN
175 drape_ply => drape(ie)%DRAPE_PLY(ip)
176 nslice = drape_ply%NSLICE
177 IF(iint == 1) THEN
178 DO k=1,nslice
179 thk_it = thkly/nslice
180 thinning = drape_ply%RDRAPE(k,1)
181 thk_it = thk_it*thinning
182 thickc = thickc + thk_it
183 ENDDO
184 ELSEIF(iint == 2) THEN
185 DO k=1,nslice
186 thk_it = half*thkly*w_gauss(k,nslice)
187 thinning = drape_ply%RDRAPE(k,1)
188 thk_it = thk_it*thinning
189 thickc = thickc + thk_it
190 ENDDO
191 ENDIF
192 ELSE ! IP=0 (no drape
193 thickc = thickc + thkly
194 ENDIF
195 ENDDO !not
196 ELSE ! IGTYP == 17
197 DO j=1,npt
198 ip= drape(ie)%INDX_PLY(j)
199 i3 = ipthk + j
200 thkly = stack%GEO(i3 ,isubs)*thickt
201 IF(ip > 0) THEN
202 drape_ply => drape(ie)%DRAPE_PLY(ip)
203 thinning = drape_ply%RDRAPE(1,1)
204 thkly = thkly*thinning
205 ENDIF
206 thickc = thickc + thkly
207 ENDDO
208 ENDIF ! igtyp
209 drape(ie)%THICK = thickc
210 ENDIF ! IE
211 IF (thk(ii) == zero) thk(ii) = thickc
212 ENDDO ! numelc
213C --- T3
214 DO ii=1,numeltg
215 ish3n = numelc + ii
216 npt = iworksh(1,ish3n)
217 pid = ixtg(5,ii)
218 igtyp = igeo(11,pid)
219 IF(igtyp /=17 .AND. igtyp /= 51 .AND. igtyp /= 52) cycle
220 ipos = igeo(99,pid)
221C---
222C update the shell thickness if /DRAPE defined
223C---
224C re-set the thickness of shell according to /DRAPE layer thinning
225 tmin = ep20
226 tmax = -ep20
227 thickt = zero
228 ippid = 2
229 ipmat = ippid + npt
230 ipang = 1
231 ipthk = ipang + npt
232 ippos = ipthk + npt
233 nthk = ippos + npt
234 isubs =iworksh(3,ish3n)
235 thickt = stack%GEO(1 ,isubs)
236C
237 ie = indx(ish3n)
238 thickc = zero
239 IF(ie == 0 ) THEN
240 DO j=1,npt
241 i3 = ipthk + j
242 thkly = stack%GEO(i3 ,isubs)*thickt
243 thickc = thickc + thkly
244 ENDDO
245 ELSE
246 IF(igtyp == 51 .OR. igtyp == 52) THEN
247 DO j=1,npt
248 i3 = ipthk + j
249 ip= drape(ie)%INDX_PLY(j)
250 thkly = stack%GEO(i3 ,isubs)*thickt
251 ipid = stack%IGEO(ippid + j,isubs)
252 iint = igeo(47,pid)
253 IF(ip > 0) THEN
254 drape_ply => drape(ie)%DRAPE_PLY(ip)
255 nslice = drape_ply%NSLICE
256 IF(iint == 1) THEN
257 DO k=1,nslice
258 thk_it = thkly/nslice
259 thinning = drape_ply%RDRAPE(k,1)
260 thk_it = thk_it*thinning
261 thickc = thickc + thk_it
262 ENDDO
263 ELSEIF(iint == 2) THEN
264 DO k=1,nslice
265 thk_it = half*thkly*w_gauss(k,nslice)
266 thinning = drape_ply%RDRAPE(k,1)
267 thk_it = thk_it*thinning
268 thickc = thickc + thk_it
269 ENDDO
270 ENDIF
271 ELSE
272 thickc = thickc + thkly
273 ENDIF
274 ENDDO
275 ELSE ! IGTYP == 17
276 DO j=1,npt
277 i3 = ipthk + j
278 ip= drape(ie)%INDX_PLY(j)
279 thkly = stack%GEO(i3 ,isubs)*thickt
280 IF(ip > 0) THEN
281 drape_ply => drape(ie)%DRAPE_PLY(ip)
282 thinning = drape_ply%RDRAPE(1,1)
283 thkly = thkly*thinning
284 ENDIF
285 thickc = thickc + thkly
286 ENDDO ! IGTYP
287 ENDIF
288 drape(ie)%THICK = thickc
289 ENDIF ! IE
290 IF (thk(ish3n) == zero) thk(ish3n) = thickc
291 ENDDO ! numelc
292C============================================================================
293
294 RETURN
295 END
my_real
#define my_real
Definition cppsort.cpp:32
drape_mod
Definition drape_mod.F:54
stack_mod
Definition stack_mod.F:75
submodel_mod
Definition submodel_mod.F:717
shellthk_upd
subroutine shellthk_upd(drape, stack, thk, ixc, ixtg, igeo, iworksh, indx)
Definition shellthk_upd.F:35