OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
globmat.F File Reference
#include "implicit_f.inc"
#include "com04_c.inc"
#include "units_c.inc"
#include "param_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine globmat (igeo, geo, pm, pm_stack, geo_stack, igeo_stack, mat_param)

Function/Subroutine Documentation

◆ globmat()

subroutine globmat ( integer, dimension(npropgi,*) igeo,
geo,
pm,
pm_stack,
geo_stack,
integer, dimension(4* npt_stack+2,*) igeo_stack,
type(matparam_struct_), dimension(nummat), intent(inout) mat_param )

Definition at line 30 of file globmat.F.

32C
33C-----------------------------------------------
34C M o d u l e s
35C-----------------------------------------------
36 USE submodel_mod
37 USE matparam_def_mod
38C-----------------------------------------------
39C I m p l i c i t T y p e s
40C-----------------------------------------------
41#include "implicit_f.inc"
42C-----------------------------------------------
43C C o m m o n B l o c k s
44C-----------------------------------------------
45#include "com04_c.inc"
46#include "units_c.inc"
47#include "param_c.inc"
48C-----------------------------------------------
49C D u m m y A r g u m e n t s
50C-----------------------------------------------
51 INTEGER IGEO(NPROPGI,*),IGEO_STACK(4* NPT_STACK+2,*)
52 my_real
53 . geo(npropg,*),pm(npropm,*),geo_stack(6*npt_stack+1,*),
54 . pm_stack(20,*)
55 TYPE(MATPARAM_STRUCT_) ,DIMENSION(NUMMAT) ,INTENT(INOUT) :: MAT_PARAM
56C-----------------------------------------------
57C L o c a l V a r i a b l e s
58C-----------------------------------------------
59 INTEGER I,IGMAT,IPOS,IGTYP,IPMAT ,IPTHK ,IPPOS ,IPGMAT,NPT,N,
60 . I1,I2,I3,MATLY,ICRYPT,NLAY,ILAY,IPANG,IPPID,IS,PIDS
61 my_real
62 . a11,a11r,c1,iz,g,nu,a12,e,rhog,b1t2, thickt,ssp, thkly,posly,
63 . rho,c1thk,a12thk,a1thk ,gthk,nuthk ,ethk,rhog0,rhocpg,rho0,rhocp
64C
65!! TYPE (STACK_PLY) :: STACK
66C-----------------------------------------------
67C-----------------------------------------------
68C=======================================================================
69C For Shell
70C-----------------------------------------------
71C
72C storage of Geo
73C
74 icrypt = 0
75 DO i=1,numgeo
76 igtyp=igeo(11,i)
77 igmat = igeo(98,i)
78 ipos = igeo(99,i)
79 npt = int(geo(6,i))
80 IF(igtyp == 11 .AND. igmat > 0) THEN
81 a11 = zero
82 a11r = zero
83 c1 = zero
84 iz = zero
85 g = zero
86 nu = zero
87 a12 = zero
88 e = zero
89 rhog = zero
90 b1t2 = zero
91 rhog0 = zero
92 rhocpg = zero
93C
94 ipmat = 100
95 ipthk = 300
96 ippos = 400
97 ipgmat = 700
98
99 npt = int(geo(6,i))
100 thickt = zero
101 DO n=1,npt
102 i1=ipthk+n
103 i3=ippos+n
104 thickt= geo(200,i)
105 thkly = geo(i1,i)*thickt
106 posly = geo(i3,i)*thickt
107 i2=ipmat+n
108 matly = igeo(i2,i)
109 ethk = pm(20,matly)*thkly
110 nuthk = pm(21,matly)*thkly
111 gthk = pm(22,matly)*thkly
112 a1thk = pm(24,matly)*thkly
113 a12thk = pm(25,matly)*thkly
114 c1thk = pm(32,matly)*thkly
115 rhog = rhog + mat_param(matly)%RHO * thkly
116 rhog0 = rhog0 + mat_param(matly)%RHO0 * thkly
117 rhocpg = rhocpg + mat_param(matly)%THERM%RHOCP* thkly
118 a11 = a11 + a1thk
119 b1t2 = b1t2 + a1thk*posly
120 a11r = a11r + a1thk*(thkly*thkly*one_over_12 + posly*posly)
121 iz = iz + thkly*(thkly*thkly*one_over_12 + posly*posly)
122 c1 = c1 + c1thk
123 g = g + gthk
124 nu = nu + nuthk
125 a12 = a12 + a12thk
126 e = e + ethk
127 ENDDO
128 rho = rhog/max(em20,thickt)
129 rho0 = rhog0/max(em20,thickt)
130 rhocp = rhocpg/max(em20,thickt)
131 e = e/max(em20,thickt)
132 a11 = a11/max(em20,thickt)
133 a12 = a12/max(em20,thickt)
134 iz = one_over_12*thickt**3
135 a11r =a11r/max(em20, iz)
136 c1 = c1 /max(em20,thickt)
137 g = g /max(em20,thickt)
138 nu = nu /max(em20,thickt)
139 ssp = a11/max(em20,rho)
140 ssp = sqrt(ssp)
141 geo(ipgmat +1 ,i) = rho
142 geo(ipgmat +2 ,i) = e
143 geo(ipgmat +3 ,i) = nu
144 geo(ipgmat +4 ,i) = g
145 geo(ipgmat +5 ,i) = a11
146 geo(ipgmat +6 ,i) = a12
147 geo(ipgmat +7 ,i) = a11r
148 geo(ipgmat +8 ,i) = c1
149 geo(ipgmat +9 ,i) = ssp
150C used for QEPH
151 geo(ipgmat +10,i) = sqrt(g)
152 geo(ipgmat +11,i) = sqrt(a11)
153 geo(ipgmat +12,i) = sqrt(a12)
154 geo(ipgmat +13,i) = sqrt(nu)
155 geo(ipgmat +14,i) = rho0
156 geo(ipgmat +15,i) = rhocp
157C
158 IF(icrypt/=0)THEN
159 WRITE(iout,'(5X,A,//)')'CONFIDENTIAL DATA'
160 ELSE
161 WRITE(iout,100)igeo(1,i),rho,e,nu,g
162 ENDIF
163 ELSEIF(igtyp == 52 .OR.
164 . ((igtyp == 17 .OR. igtyp == 51) .AND. igmat > 0)) THEN
165 DO is = 1,ns_stack
166C initialization of parameters
167 pids = igeo_stack(2,is)
168 IF(pids == i) THEN
169 a11 = zero
170 a11r = zero
171 c1 = zero
172 iz = zero
173 g = zero
174 nu = zero
175 a12 = zero
176 e = zero
177 rhog = zero
178 b1t2 = zero
179 rhog0 = zero
180 rhocpg = zero
181 ipang = 1
182 ippid = 2
183C
184 nlay = igeo_stack(1,is)
185
186 ipmat = ippid + nlay ! layer material address ( NLAY = NPT )
187 ipthk = ipang + nlay ! layer thickness address ( NLAY = NPT )
188 ippos = ipthk + nlay ! layer position address ( NLAY = NPT )
189 thickt = zero
190 DO ilay=1,nlay
191 thickt = geo_stack(1,is)
192 thkly = geo_stack(ipthk + ilay,is)*thickt
193 posly = geo_stack(ippos + ilay,is)*thickt
194 matly = igeo_stack(ipmat + ilay,is)
195 ethk = pm(20,matly)*thkly
196 nuthk = pm(21,matly)*thkly
197 gthk = pm(22,matly)*thkly
198 a1thk = pm(24,matly)*thkly
199 a12thk = pm(25,matly)*thkly
200 c1thk = pm(32,matly)*thkly
201 rhog = rhog + mat_param(matly)%RHO * thkly
202 rhog0 = rhog0 + mat_param(matly)%RHO0 * thkly
203 rhocpg = rhocpg + mat_param(matly)%THERM%RHOCP* thkly
204 a11 = a11 + a1thk
205 b1t2 = b1t2 + a1thk*posly
206 a11r = a11r + a1thk*(thkly*thkly*one_over_12 + posly*posly)
207 iz = iz + thkly*(thkly*thkly*one_over_12 + posly*posly)
208 c1 = c1 + c1thk
209 g = g + gthk
210 nu = nu + nuthk
211 a12 = a12 + a12thk
212 e = e + ethk
213 ENDDO ! NLAY
214 rho = rhog/max(em20,thickt)
215 rho0 = rhog0/max(em20,thickt)
216 rhocp = rhocpg/max(em20,thickt)
217 e = e/max(em20,thickt)
218 a11 = a11/max(em20,thickt)
219 a12 = a12/max(em20,thickt)
220 iz = one_over_12*thickt**3
221 a11r =a11r/max(em20, iz)
222 c1 = c1 /max(em20,thickt)
223 g = g /max(em20,thickt)
224 nu = nu /max(em20,thickt)
225 ssp = a11/max(em20,rho)
226 ssp = sqrt(ssp)
227 pm_stack(1 ,is) = rho
228 pm_stack(2 ,is) = e
229 pm_stack(3 ,is) = nu
230 pm_stack(4 ,is) = g
231 pm_stack(5 ,is) = a11
232 pm_stack(6 ,is) = a12
233 pm_stack(7 ,is) = a11r
234 pm_stack(8 ,is) = c1
235 pm_stack(9 ,is) = ssp
236C used for QEPH
237 pm_stack(10,is) = sqrt(g)
238 pm_stack(11,is) = sqrt(a11)
239 pm_stack(12,is) = sqrt(a12)
240 pm_stack(13,is) = sqrt(nu)
241 pm_stack(14,is) = rho0
242 pm_stack(15,is) = rhocp
243 IF(icrypt/=0)THEN
244 WRITE(iout,'(5X,A,//)')'CONFIDENTIAL DATA'
245 ELSE
246 WRITE(iout,100)igeo(1,i),rho,e,nu,g
247 ENDIF
248 ENDIF
249 ENDDO ! NS_STACK
250 ENDIF
251 ENDDO ! NUMGEO
252C--------
253 100 FORMAT(//,
254 & 5x,'CHARACTERISTICS OF GLOBAL MATERIAL FOR COMPOSITE LAYERED',
255 & ' SHELL PROPERTY SET ',/
256 & ,5x,' HAVE BEEN RECOMPUTED IN ORDER TO ENSURE STABILITY',/
257 & ,5x,'PROPERTY SET NUMBER . . . . . . . . . . . .=',i10/
258 & ,5x,'INITIAL DENSITY. . . . . . . . . . . . . . =',1pg20.13/
259 & ,5x,'YOUNG MODULUS . . . . . . . . . . . . . . .=',1pg20.13/
260 & ,5x,'POISSON RATIO . . . . . . . . . . . . . . .=',1pg20.13/
261 & ,5x,'SHEAR MODULUS . . . . . . . . . . . . . . .=',1pg20.13//)
262 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
max
#define max(a, b)
Definition macros.h:21
submodel_mod
Definition submodel_mod.F:717