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)

Function/Subroutine Documentation

◆ globmat()

subroutine globmat ( integer, dimension(npropgi,*) igeo,
geo,
pm,
pm_stack,
geo_stack,
integer, dimension(4* npt_stack+2,*) igeo_stack )

Definition at line 30 of file globmat.F.

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
my_real
#define my_real
Definition cppsort.cpp:32
max
#define max(a, b)
Definition macros.h:21
submodel_mod
Definition submodel_mod.F:712