OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
layini1.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!|| layini1 ../starter/source/elements/shell/coqueba/layini1.f
25!||--- called by ------------------------------------------------------
26!|| c3init3 ../starter/source/elements/sh3n/coque3n/c3init3.F
27!|| cbainit3 ../starter/source/elements/shell/coqueba/cbainit3.F
28!|| cdkinit3 ../starter/source/elements/sh3n/coquedk/cdkinit3.F
29!|| cinit3 ../starter/source/elements/shell/coque/cinit3.F
30!||--- uses -----------------------------------------------------
31!|| drape_mod ../starter/share/modules1/drape_mod.F
32!|| stack_mod ../starter/share/modules1/stack_mod.F
33!||====================================================================
34 SUBROUTINE layini1(
35 . ELBUF_STR ,JFT ,JLT ,GEO ,IGEO ,
36 . MAT ,PID ,MATLY ,POSLY ,IGTYP ,
37 . NLAY ,NPT ,ISUBSTACK ,STACK ,DRAPE ,
38 . NFT ,THK ,NEL ,IDRAPE ,
39 . NUMEL_DRAPE ,INDX )
40C-----------------------------------------------
41C M o d u l e s
42C-----------------------------------------------
43 USE elbufdef_mod
44 USE stack_mod
45 USE drape_mod
46C-----------------------------------------------
47C I m p l i c i t T y p e s
48C-----------------------------------------------
49#include "implicit_f.inc"
50C-----------------------------------------------
51C G l o b a l P a r a m e t e r s
52C-----------------------------------------------
53#include "mvsiz_p.inc"
54#include "param_c.inc"
55C-----------------------------------------------
56C C o m m o n B l o c k s
57C-----------------------------------------------
58#include "drape_c.inc"
59C-----------------------------------------------
60C D u m m y A r g u m e n t s
61C-----------------------------------------------
62 INTEGER JFT,JLT,NPT,NEL,IGTYP,ISUBSTACK,NLAY,NFT,IDRAPE,NUMEL_DRAPE
63 INTEGER MAT(*), PID(*), MATLY(*), IGEO(NPROPGI,*)
64 my_real GEO(NPROPG,*),POSLY(MVSIZ,*),THK(*)
65 TYPE(ELBUF_STRUCT_), TARGET :: ELBUF_STR
66 TYPE (STACK_PLY) :: STACK
67 TYPE (DRAPE_), DIMENSION(NUMELC_DRAPE + NUMELTG_DRAPE), TARGET :: DRAPE
68 INTEGER , DIMENSION(NUMEL_DRAPE) :: INDX
69C-----------------------------------------------
70C L o c a l V a r i a b l e s
71C-----------------------------------------------
72 INTEGER I, J, N, IADR, IPTHK, IPMAT, IPPOS ,IPPID, IPID,
73 . ipang,mat_ly(mvsiz),it,itl,ilay,nptt,max_nptt,ipt,jmly,iint,
74 . ipid_ly,ipt_all,mat_lay,nslice,ipos,ie,ip
75 parameter(max_nptt = 100)
76 my_real
77 . thk_it(max_nptt*nlay,mvsiz),zshift,thk_nptt,
78 . thkl,pos_nptt,pos_0,thickt,thinning,thk_ly(mvsiz),
79 . thkly,ratio_thkly(mvsiz,npt)
80C
81 TYPE (DRAPE_PLY_) , POINTER :: DRAPE_PLY
82C-----------------------------------------------
83 my_real
84 . A_GAUSS(9,9),W_GAUSS(9,9)
85C-----------------------------------------------
86 DATA a_gauss /
87 1 0. ,0. ,0. ,
88 1 0. ,0. ,0. ,
89 1 0. ,0. ,0. ,
90 2 -.577350269189626,0.577350269189626,0. ,
91 2 0. ,0. ,0. ,
92 2 0. ,0. ,0. ,
93 3 -.774596669241483,0. ,0.774596669241483,
94 3 0. ,0. ,0. ,
95 3 0. ,0. ,0. ,
96 4 -.861136311594053,-.339981043584856,0.339981043584856,
97 4 0.861136311594053,0. ,0. ,
98 4 0. ,0. ,0. ,
99 5 -.906179845938664,-.538469310105683,0. ,
100 5 0.538469310105683,0.906179845938664,0. ,
101 5 0. ,0. ,0. ,
102 6 -.932469514203152,-.661209386466265,-.238619186083197,
103 6 0.238619186083197,0.661209386466265,0.932469514203152,
104 6 0. ,0. ,0. ,
105 7 -.949107912342759,-.741531185599394,-.405845151377397,
106 7 0. ,0.405845151377397,0.741531185599394,
107 7 0.949107912342759,0. ,0. ,
108 8 -.960289856497536,-.796666477413627,-.525532409916329,
109 8 -.183434642495650,0.183434642495650,0.525532409916329,
110 8 0.796666477413627,0.960289856497536,0. ,
111 9 -.968160239507626,-.836031107326636,-.613371432700590,
112 9 -.324253423403809,0. ,0.324253423403809,
113 9 0.613371432700590,0.836031107326636,0.968160239507626/
114 DATA w_gauss /
115 1 2. ,0. ,0. ,
116 1 0. ,0. ,0. ,
117 1 0. ,0. ,0. ,
118 2 1. ,1. ,0. ,
119 2 0. ,0. ,0. ,
120 2 0. ,0. ,0. ,
121 3 0.555555555555556,0.888888888888889,0.555555555555556,
122 3 0. ,0. ,0. ,
123 3 0. ,0. ,0. ,
124 4 0.347854845137454,0.652145154862546,0.652145154862546,
125 4 0.347854845137454,0. ,0. ,
126 4 0. ,0. ,0. ,
127 5 0.236926885056189,0.478628670499366,0.568888888888889,
128 5 0.478628670499366,0.236926885056189,0. ,
129 5 0. ,0. ,0. ,
130 6 0.171324492379170,0.360761573048139,0.467913934572691,
131 6 0.467913934572691,0.360761573048139,0.171324492379170,
132 6 0. ,0. ,0. ,
133 7 0.129484966168870,0.279705391489277,0.381830050505119,
134 7 0.417959183673469,0.381830050505119,0.279705391489277,
135 7 0.129484966168870,0. ,0. ,
136 8 0.101228536290376,0.222381034453374,0.313706645877887,
137 8 0.362683783378362,0.362683783378362,0.313706645877887,
138 8 0.222381034453374,0.101228536290376,0. ,
139 9 0.081274388361574,0.180648160694857,0.260610696402935,
140 9 0.312347077040003,0.330239355001260,0.312347077040003,
141 9 0.260610696402935,0.180648160694857,0.081274388361574/
142C=======================================================================
143 ipthk = 300
144 ippos = 400
145 ipmat = 100
146c
147c---------------------------------------------------------
148 SELECT CASE (igtyp)
149c----
150 CASE (1,9,10,11,16)
151 DO n=1,npt
152 iadr = (n-1)*jlt
153 pos_0 = geo(ippos+n,pid(1))
154 DO i = jft,jlt
155 j = iadr+i
156c THKLY(J) = WF(N,NPT)
157 posly(i,n) = pos_0
158 matly(j) = mat(1)
159 ENDDO
160 ENDDO
161c----
162 CASE (17)
163c----
164 ippid = 2
165 ipmat = ippid + npt
166 ipang = 1
167 ipthk = ipang + npt
168 ippos = ipthk + npt
169 ipos = igeo(99,pid(1))
170 zshift = geo(199,pid(1))
171 thickt = stack%GEO(1,isubstack)
172 IF(ipos == 2 ) zshift = zshift /max(thickt,em20)
173 IF(idrape == 0 ) THEN
174 DO n=1,npt
175 iadr = (n-1)*jlt
176 DO i=jft,jlt
177 j = iadr+i
178 matly(j) = stack%IGEO(ipmat + n ,isubstack)
179 posly(i,n) = stack%GEO (ippos + n ,isubstack)
180 ENDDO
181 ENDDO
182 ELSE ! idrape > 0
183 DO n=1,npt
184 iadr = (n-1)*jlt
185 DO i=jft,jlt
186 j = iadr+i
187 ie = indx(nft + i)
188 IF(ie == 0) THEN
189 matly(j) = stack%IGEO(ipmat + n ,isubstack)
190 posly(i,n) = stack%GEO (ippos + n ,isubstack)
191 thickt = stack%GEO(1,isubstack)
192 thkly = stack%GEO (ipthk + n ,isubstack)*thickt
193 ratio_thkly(i,n) = thkly/thk(i)
194 IF (n == 1) THEN
195 posly(i,n) = zshift + half*ratio_thkly(i,n)
196 ELSE
197 posly(i,n) = posly(i,n-1)
198 . + half*(ratio_thkly(i,n)+ratio_thkly(i,n-1))
199 ENDIF ! IF (N == 1)
200 ELSE
201 ip= drape(ie)%INDX_PLY(n)
202 IF(ip > 0) THEN
203 drape_ply => drape(ie)%DRAPE_PLY(ip)
204 nslice = drape_ply%NSLICE ! one slice by layer
205 thinning = drape_ply%RDRAPE(1,1)
206 thickt = stack%GEO(1,isubstack)
207 thkly = stack%GEO(ipthk + n,isubstack)*thickt ! initial THKLY
208 thkly = thkly*thinning ! new THKLY (/DRAPE thinning)
209 thkly = thkly/thk(i) ! layer thickness ratio
210 ratio_thkly(i,n) = thkly
211 IF (n == 1) THEN
212 posly(i,n) = zshift + half*ratio_thkly(i,n)
213 ELSE
214 posly(i,n) = posly(i,n-1)
215 . + half*(ratio_thkly(i,n)+ratio_thkly(i,n-1))
216 ENDIF ! IF (N == 1)
217 ELSE
218 thickt = stack%GEO(1,isubstack)
219 thkly = stack%GEO(ipthk + n,isubstack)*thickt ! initial THKLY
220 thkly = thkly/thk(i) ! layer thickness ratio
221 ratio_thkly(i,n) = thkly
222 IF (n == 1) THEN
223 posly(i,n) = zshift + half*ratio_thkly(i,n)
224 ELSE
225 posly(i,n) = posly(i,n-1)
226 . + half*(ratio_thkly(i,n)+ratio_thkly(i,n-1))
227 ENDIF ! IF (N == 1)
228 ENDIF
229 ENDIF ! IE
230 ENDDO
231 ENDDO
232 ENDIF ! idrape
233c----
234 CASE (51, 52)
235c----
236 ipt_all = 0
237c stack addresses
238 ipang = 1
239 ippid = 2
240 ipmat = ippid + nlay ! layer material address ( NLAY = NPT )
241 ipthk = ipang + nlay ! layer thickness address ( NLAY = NPT )
242 ippos = ipthk + nlay ! layer position address ( NLAY = NPT )
243 ipos = igeo(99,pid(1))
244 zshift = geo(199,pid(1))
245 thickt = stack%GEO(1,isubstack)
246 IF(ipos == 2 )zshift = zshift /max(thickt,em20)
247 IF(idrape == 0) THEN
248 DO ilay=1,nlay
249 nptt = elbuf_str%BUFLY(ilay)%NPTT
250 ipid_ly = stack%IGEO(ippid + ilay,isubstack) ! layer PID (igtyp = 19)
251 ipid = stack%IGEO(ippid,isubstack)
252 iint = igeo(47,ipid)
253 mat_ly = elbuf_str%BUFLY(ilay)%IMAT
254 !! layer of stack infos:
255 IF(iint == 1) THEN
256 DO i=jft,jlt
257 mat_ly(i) = stack%IGEO(ipmat + ilay,isubstack) ! layer material
258 thk_ly(i) = stack%GEO(ipthk + ilay,isubstack) ! layer thickness ratio
259 ratio_thkly(i,ilay) = thk_ly(i)
260 jmly = (ilay-1)*jlt + i
261 DO it=1,nptt
262 ipt = ipt_all + it
263 thk_it(ipt,i) = thk_ly(i)/nptt ! uniform distribution of NPTT through layer
264 IF (ipt == 1) THEN
265 posly(i,ipt) = zshift + half*thk_it(ipt,i) ! integr. point "IT" position ratio
266 ELSE
267 posly(i,ipt) = posly(i,ipt - 1) ! integr. point "IT" position ratio
268 . + half*(thk_it(ipt,i) + thk_it(ipt-1,i))
269 ENDIF ! IF (ILAY == 1)
270 ENDDO
271 matly(jmly) = mat_ly(i) ! layer defined
272 ENDDO ! DO I=JFT,JLT
273 ELSEIF(iint == 2) THEN
274 DO i=jft,jlt
275 mat_ly(i) = stack%IGEO(ipmat + ilay,isubstack) ! layer material
276 thk_ly(i) = stack%GEO(ipthk + ilay,isubstack) ! layer thickness ratio
277 mat_ly(i) = stack%IGEO(ipmat + ilay,isubstack) ! layer material
278 ratio_thkly(i,ilay) = thk_ly(i)
279 jmly = (ilay-1)*jlt + i
280 DO it=1,nptt
281 ipt = ipt_all + it
282 thk_it(ipt,i) = half*thk_ly(i)*w_gauss(it,nptt)
283 IF (ipt == 1) THEN
284 posly(i,ipt) = zshift + half*thk_it(ipt,i) ! integr. point "IT" position ratio
285 ELSE
286 posly(i,ipt) = posly(i,ipt - 1) ! integr. point "IT" position ratio
287 . + half*(thk_it(ipt,i) + thk_it(ipt-1,i))
288 ENDIF !
289 ENDDO
290 matly(jmly) = mat_ly(i) ! layer defined
291 ENDDO ! JFT,JLT
292 ENDIF !!int
293 ipt_all = ipt_all + nptt
294 ENDDO ! DO ILAY=1,NLAY
295 ELSE ! idrape > 0
296 DO ilay=1,nlay
297 nptt = elbuf_str%BUFLY(ilay)%NPTT
298 ipid_ly = stack%IGEO(ippid + ilay,isubstack) ! layer PID (igtyp = 19)
299 ipid = stack%IGEO(ippid,isubstack)
300 iint = igeo(47,ipid)
301 mat_ly = elbuf_str%BUFLY(ilay)%IMAT
302 !! layer of stack infos:
303 IF(iint == 1) THEN
304 DO i=jft,jlt
305 ie = indx(nft + i)
306 mat_ly(i) = stack%IGEO(ipmat + ilay,isubstack) ! layer material
307 IF(ie == 0) THEN
308 thk_ly(i) = stack%GEO(ipthk + ilay,isubstack) ! layer thickness ratio
309 ratio_thkly(i,ilay) = thk_ly(i)
310 jmly = (ilay-1)*jlt + i
311 DO it=1,nptt
312 ipt = ipt_all + it
313 thk_it(ipt,i) = thk_ly(i)/nptt ! uniform distribution of NPTT through layer
314 IF (ipt == 1) THEN
315 posly(i,ipt) = zshift + half*thk_it(ipt,i) ! integr. point "IT" position ratio
316 ELSE
317 posly(i,ipt) = posly(i,ipt - 1) ! integr. point "IT" position ratio
318 . + half*(thk_it(ipt,i) + thk_it(ipt-1,i))
319 ENDIF ! IF (ILAY == 1)
320 matly(jmly) = mat_ly(i) ! layer defined
321 ENDDO
322 ELSE ! IE > 0
323 ip = drape(ie)%INDX_PLY(ilay)
324 IF(ip > 0 ) THEN
325 drape_ply => drape(ie)%DRAPE_PLY(ip)
326 nslice = drape_ply%NSLICE ! NPPT
327 thickt = stack%GEO(1,isubstack)
328 thk_ly(i) = stack%GEO(ipthk + ilay,isubstack)*thickt ! initial THKLY
329 jmly = (ilay-1)*jlt + i
330 DO it = 1,nptt
331 ipt = ipt_all + it
332 j = (ipt-1)*jlt + i
333 thinning = drape_ply%RDRAPE(it,1)
334 thk_it(ipt,i) = thk_ly(i)*thinning/nptt
335 thk_it(ipt,i) = thk_it(ipt,i)/thk(i) ! slice thickness ratio
336 !!RATIO_THKLY(I,ILAY) = THK_LY(I)
337 IF (ipt == 1 ) THEN
338 posly(i,ipt) = zshift + half*thk_it(ipt,i) ! integr. point "IT" position ratio
339 ELSE
340 posly(i,ipt) = posly(i,ipt - 1) ! integr. point "IT" position ratio
341 . + half*(thk_it(ipt,i) + thk_it(ipt-1,i))
342 ENDIF ! IF (IPT == 1)
343 matly(jmly) = mat_ly(i) ! layer defined
344 ENDDO
345 ELSE ! IP = 0
346 thickt = stack%GEO(1,isubstack)
347 thk_ly(i) = stack%GEO(ipthk + ilay,isubstack)*thickt ! initial THKLY
348 jmly = (ilay-1)*jlt + i
349 DO it = 1,nptt
350 ipt = ipt_all + it
351 j = (ipt-1)*jlt + i
352 thk_it(ipt,i) = thk_ly(i)/nptt
353 thk_it(ipt,i) = thk_it(ipt,i)/thk(i) ! slice thickness ratio
354 !!RATIO_THKLY(I,ILAY) = THK_LY(I)
355 IF (ipt == 1 ) THEN
356 posly(i,ipt) = zshift + half*thk_it(ipt,i) ! integr. point "IT" position ratio
357 ELSE
358 posly(i,ipt) = posly(i,ipt - 1) ! integr. point "IT" position ratio
359 . + half*(thk_it(ipt,i) + thk_it(ipt-1,i))
360 ENDIF ! IF (IPT == 1)
361 matly(jmly) = mat_ly(i) ! layer defined
362 ENDDO
363 ENDIF
364 ENDIF ! IE
365 ENDDO ! DO i=jft,jlt
366 ELSEIF(iint == 2) THEN
367 DO i=jft,jlt
368 ie = indx(nft + i)
369 mat_ly(i) = stack%IGEO(ipmat + ilay,isubstack) ! layer material
370 IF(ie == 0) THEN
371 thk_ly(i) = stack%GEO(ipthk + ilay,isubstack) ! layer thickness ratio
372 mat_ly(i) = stack%IGEO(ipmat + ilay,isubstack) ! layer material
373 ratio_thkly(i,ilay) = thk_ly(i)
374 jmly = (ilay-1)*jlt + i
375 DO it=1,nptt
376 ipt = ipt_all + it
377 thk_it(ipt,i) = half*thk_ly(i)*w_gauss(it,nptt)
378 IF (ipt == 1) THEN
379 posly(i,ipt) = zshift + half*thk_it(ipt,i) ! integr. point "IT" position ratio
380 ELSE
381 posly(i,ipt) = posly(i,ipt - 1) ! integr. point "IT" position ratio
382 . + half*(thk_it(ipt,i) + thk_it(ipt-1,i))
383 ENDIF !
384 matly(jmly) = mat_ly(i) ! layer defined
385 ENDDO
386 ELSE ! IE > 0
387 !!calcul automatique de position des NPTT dans les couches ---
388 ip = drape(ie)%INDX_PLY(ilay)
389 IF(ip > 0) THEN
390 drape_ply => drape(ie)%DRAPE_PLY(ip)
391 nslice = drape_ply%NSLICE ! = NPTT
392 thickt = stack%GEO(1,isubstack)
393 thk_ly(i) = stack%GEO(ipthk + ilay,isubstack)*thickt ! initial THKLY
394 jmly = (ilay-1)*jlt + i
395 DO it = 1,nptt
396 ipt = ipt_all + it
397 j = (ipt-1)*jlt + i
398 thinning = drape_ply%RDRAPE(it,1)
399 thk_it(ipt,i) = half*thk_ly(i)*w_gauss(it,nptt)*thinning
400 thk_it(ipt,i) = thk_it(ipt,i)/thk(i) ! slice thickness ratio
401 IF (ipt == 1 ) THEN
402 posly(i,ipt) = zshift + half*thk_it(ipt,i) ! integr. point "IT" position ratio
403 ELSE
404 posly(i,ipt) = posly(i,ipt - 1) ! integr. point "IT" position ratio
405 . + half*(thk_it(ipt,i) + thk_it(ipt-1,i))
406 ENDIF ! IF (IPT == 1)
407 matly(jmly) = mat_ly(i) ! layer defined
408 ENDDO
409 ELSE
410 thickt = stack%GEO(1,isubstack)
411 thk_ly(i) = stack%GEO(ipthk + ilay,isubstack)*thickt ! initial THKLY
412 jmly = (ilay-1)*jlt + i
413 DO it = 1,nptt
414 ipt = ipt_all + it
415 j = (ipt-1)*jlt + i
416 thk_it(ipt,i) = half*thk_ly(i)*w_gauss(it,nptt)
417 thk_it(ipt,i) = thk_it(ipt,i)/thk(i) ! slice thickness ratio
418 IF (ipt == 1 ) THEN
419 posly(i,ipt) = zshift + half*thk_it(ipt,i) ! integr. point "IT" position ratio
420 ELSE
421 posly(i,ipt) = posly(i,ipt - 1) ! integr. point "IT" position ratio
422 . + half*(thk_it(ipt,i) + thk_it(ipt-1,i))
423 ENDIF ! IF (IPT == 1)
424 matly(jmly) = mat_ly(i) ! layer defined
425 ENDDO
426 ENDIF ! IP
427 ENDIF ! IE
428 ENDDO ! JFT,JLT
429 ENDIF !!int
430 ipt_all = ipt_all + nptt
431 ENDDO ! DO ILAY=1,NLAY
432 ENDIF ! IDRAPE
433c----
434 CASE DEFAULT
435c----
436 DO n=1,npt
437 iadr = (n-1)*jlt
438 pos_0 = geo(ippos+n,pid(1))
439 thk_nptt = geo(ipthk+n,pid(1))
440 DO i = jft,jlt
441 j = iadr+i
442c THKLY(J) = THK_NPTT
443 posly(i,n) = pos_0
444 matly(j) = mat(1)
445 ENDDO
446 ENDDO
447c----
448 END SELECT
449c-----------
450 RETURN
451 END SUBROUTINE layini1
452C
layini1
subroutine layini1(elbuf_str, jft, jlt, geo, igeo, mat, pid, matly, posly, igtyp, nlay, npt, isubstack, stack, drape, nft, thk, nel, idrape, numel_drape, indx)
Definition layini1.F:40
max
#define max(a, b)
Definition macros.h:21
drape_mod
Definition drape_mod.F:54
stack_mod
Definition stack_mod.F:72
starter
program starter
Definition starter.F:39