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