OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
globmat.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!|| globmat ../starter/source/materials/globmat.F
25!||--- called by ------------------------------------------------------
26!|| lectur ../starter/source/starter/lectur.f
27!||--- uses -----------------------------------------------------
28!|| submodel_mod ../starter/share/modules1/submodel_mod.F
29!||====================================================================
30 SUBROUTINE globmat( IGEO ,GEO ,PM, PM_STACK,GEO_STACK,
31 . IGEO_STACK)
32C
33C-----------------------------------------------
34C M o d u l e s
35C-----------------------------------------------
36 USE submodel_mod
37C-----------------------------------------------
38C I m p l i c i t T y p e s
39C-----------------------------------------------
40#include "implicit_f.inc"
41C-----------------------------------------------
42C C o m m o n B l o c k s
43C-----------------------------------------------
44#include "com04_c.inc"
45#include "units_c.inc"
46#include "param_c.inc"
47C-----------------------------------------------
48C D u m m y A r g u m e n t s
49C-----------------------------------------------
50 INTEGER IGEO(NPROPGI,*),IGEO_STACK(4* NPT_STACK+2,*)
51 my_real
52 . geo(npropg,*),pm(npropm,*),geo_stack(6*npt_stack+1,*),
53 . pm_stack(20,*)
54C-----------------------------------------------
55C L o c a l V a r i a b l e s
56C-----------------------------------------------
57 INTEGER I,IGMAT,IPOS,IGTYP,IPMAT ,IPTHK ,IPPOS ,IPGMAT,NPT,N,
58 . i1,i2,i3,matly,icrypt,nlay,ilay,ipang,ippid,is,pids
59 my_real
60 . a11,a11r,c1,iz,g,nu,a12,e,rhog,b1t2, thickt,ssp, thkly,posly,
61 . rho,c1thk,a12thk,a1thk ,gthk,nuthk ,ethk,rhog0,rhocpg,rho0,rhocp
62C
63!! TYPE (STACK_PLY) :: STACK
64C-----------------------------------------------
65C-----------------------------------------------
66C=======================================================================
67C For Shell
68C-----------------------------------------------
69C
70C stockage de Geo
71C
72 icrypt = 0
73 DO i=1,numgeo
74 igtyp=igeo(11,i)
75 igmat = igeo(98,i)
76 ipos = igeo(99,i)
77 npt = int(geo(6,i))
78 IF(igtyp == 11 .AND. igmat > 0) THEN
79 a11 = zero
80 a11r = zero
81 c1 = zero
82 iz = zero
83 g = zero
84 nu = zero
85 a12 = zero
86 e = zero
87 rhog = zero
88 b1t2 = zero
89 rhog0 = zero
90 rhocpg = zero
91C
92 ipmat = 100
93 ipthk = 300
94 ippos = 400
95 ipgmat = 700
96
97 npt = int(geo(6,i))
98 thickt = zero
99 DO n=1,npt
100 i1=ipthk+n
101 i3=ippos+n
102 thickt= geo(200,i)
103 thkly = geo(i1,i)*thickt
104 posly = geo(i3,i)*thickt
105 i2=ipmat+n
106 matly = igeo(i2,i)
107 ethk = pm(20,matly)*thkly
108 nuthk = pm(21,matly)*thkly
109 gthk = pm(22,matly)*thkly
110 a1thk = pm(24,matly)*thkly
111 a12thk = pm(25,matly)*thkly
112 c1thk = pm(32,matly)*thkly
113 rhog = rhog + pm(1,matly)*thkly
114 rhog0 = rhog0 + pm(89,matly)*thkly
115 rhocpg = rhocpg + pm(69,matly)*thkly
116 a11 = a11 + a1thk
117 b1t2 = b1t2 + a1thk*posly
118 a11r = a11r + a1thk*(thkly*thkly*one_over_12 + posly*posly)
119 iz = iz + thkly*(thkly*thkly*one_over_12 + posly*posly)
120 c1 = c1 + c1thk
121 g = g + gthk
122 nu = nu + nuthk
123 a12 = a12 + a12thk
124 e = e + ethk
125 ENDDO
126 rho = rhog/max(em20,thickt)
127 rho0 = rhog0/max(em20,thickt)
128 rhocp = rhocpg/max(em20,thickt)
129 e = e/max(em20,thickt)
130 a11 = a11/max(em20,thickt)
131 a12 = a12/max(em20,thickt)
132 iz = one_over_12*thickt**3
133 a11r =a11r/max(em20, iz)
134 c1 = c1 /max(em20,thickt)
135 g = g /max(em20,thickt)
136 nu = nu /max(em20,thickt)
137 ssp = a11/max(em20,rho)
138 ssp = sqrt(ssp)
139 geo(ipgmat +1 ,i) = rho
140 geo(ipgmat +2 ,i) = e
141 geo(ipgmat +3 ,i) = nu
142 geo(ipgmat +4 ,i) = g
143 geo(ipgmat +5 ,i) = a11
144 geo(ipgmat +6 ,i) = a12
145 geo(ipgmat +7 ,i) = a11r
146 geo(ipgmat +8 ,i) = c1
147 geo(ipgmat +9 ,i) = ssp
148C used for QEPH
149 geo(ipgmat +10,i) = sqrt(g)
150 geo(ipgmat +11,i) = sqrt(a11)
151 geo(ipgmat +12,i) = sqrt(a12)
152 geo(ipgmat +13,i) = sqrt(nu)
153 geo(ipgmat +14,i) = rho0
154 geo(ipgmat +15,i) = rhocp
155C
156 IF(icrypt/=0)THEN
157 WRITE(iout,'(5X,A,//)')'CONFIDENTIAL DATA'
158 ELSE
159 WRITE(iout,100)igeo(1,i),rho,e,nu,g
160 ENDIF
161 ELSEIF(igtyp == 52 .OR.
162 . ((igtyp == 17 .OR. igtyp == 51) .AND. igmat > 0)) THEN
163 DO is = 1,ns_stack
164C initialisation of parameters
165 pids = igeo_stack(2,is)
166 IF(pids == i) THEN
167 a11 = zero
168 a11r = zero
169 c1 = zero
170 iz = zero
171 g = zero
172 nu = zero
173 a12 = zero
174 e = zero
175 rhog = zero
176 b1t2 = zero
177 rhog0 = zero
178 rhocpg = zero
179 ipang = 1
180 ippid = 2
181C
182 nlay = igeo_stack(1,is)
183
184 ipmat = ippid + nlay ! layer material address ( NLAY = NPT )
185 ipthk = ipang + nlay ! layer thickness address ( NLAY = NPT )
186 ippos = ipthk + nlay ! layer position address ( NLAY = NPT )
187 thickt = zero
188 DO ilay=1,nlay
189 thickt = geo_stack(1,is)
190 thkly = geo_stack(ipthk + ilay,is)*thickt
191 posly = geo_stack(ippos + ilay,is)*thickt
192 matly = igeo_stack(ipmat + ilay,is)
193 ethk = pm(20,matly)*thkly
194 nuthk = pm(21,matly)*thkly
195 gthk = pm(22,matly)*thkly
196 a1thk = pm(24,matly)*thkly
197 a12thk = pm(25,matly)*thkly
198 c1thk = pm(32,matly)*thkly
199 rhog = rhog + pm(1,matly)*thkly
200 rhog0 = rhog0 + pm(89,matly)*thkly
201 rhocpg = rhocpg + pm(69,matly)*thkly
202 a11 = a11 + a1thk
203 b1t2 = b1t2 + a1thk*posly
204 a11r = a11r + a1thk*(thkly*thkly*one_over_12 + posly*posly)
205 iz = iz + thkly*(thkly*thkly*one_over_12 + posly*posly)
206 c1 = c1 + c1thk
207 g = g + gthk
208 nu = nu + nuthk
209 a12 = a12 + a12thk
210 e = e + ethk
211 ENDDO ! NLAY
212 rho = rhog/max(em20,thickt)
213 rho0 = rhog0/max(em20,thickt)
214 rhocp = rhocpg/max(em20,thickt)
215 e = e/max(em20,thickt)
216 a11 = a11/max(em20,thickt)
217 a12 = a12/max(em20,thickt)
218 iz = one_over_12*thickt**3
219 a11r =a11r/max(em20, iz)
220 c1 = c1 /max(em20,thickt)
221 g = g /max(em20,thickt)
222 nu = nu /max(em20,thickt)
223 ssp = a11/max(em20,rho)
224 ssp = sqrt(ssp)
225 pm_stack(1 ,is) = rho
226 pm_stack(2 ,is) = e
227 pm_stack(3 ,is) = nu
228 pm_stack(4 ,is) = g
229 pm_stack(5 ,is) = a11
230 pm_stack(6 ,is) = a12
231 pm_stack(7 ,is) = a11r
232 pm_stack(8 ,is) = c1
233 pm_stack(9 ,is) = ssp
234C used for QEPH
235 pm_stack(10,is) = sqrt(g)
236 pm_stack(11,is) = sqrt(a11)
237 pm_stack(12,is) = sqrt(a12)
238 pm_stack(13,is) = sqrt(nu)
239 pm_stack(14,is) = rho0
240 pm_stack(15,is) = rhocp
241 IF(icrypt/=0)THEN
242 WRITE(iout,'(5x,a,//)')'confidential data'
243 ELSE
244 WRITE(IOUT,100)IGEO(1,I),RHO,E,NU,G
245 ENDIF
246 ENDIF
247 ENDDO ! NS_STACK
248 ENDIF
249 ENDDO ! NUMGEO
250C--------
251 100 FORMAT(//,
252 & 5X,'characteristics of global material for composite layered',
253 & ' shell property set ',/
254 & ,5X,' have been recomputed in order to ensure stability',/
255 & ,5X,'property set number . . . . . . . . . . . .=',I10/
256 & ,5X,'initial density. . . . . . . . . . . . . . =',1PG20.13/
257 & ,5X,'young modulus . . . . . . . . . . . . . . .=',1PG20.13/
258 & ,5X,'poisson ratio . . . . . . . . . . . . . . .=',1PG20.13/
259 & ,5X,'shear modulus . . . . . . . . . . . . . . .=',1PG20.13//)
260 RETURN
261 END
my_real
#define my_real
Definition cppsort.cpp:32
globmat
subroutine globmat(igeo, geo, pm, pm_stack, geo_stack, igeo_stack)
Definition globmat.F:32
max
#define max(a, b)
Definition macros.h:21
for
for(i8=*sizetab-1;i8 >=0;i8--)
Definition mumps_common.c:91
submodel_mod
Definition submodel_mod.F:712
lectur
subroutine lectur(multi_fvm, lsubmodel, is_dyna, detonators, ebcs_tab, seatbelt_converted_elements, nb_seatbelt_shells, nb_dyna_include, user_windows, output, mat_elem, names_and_titles, defaults, glob_therm, pblast, sensor_user_struct)
Definition lectur.F:533
starter
program starter
Definition starter.F:39