OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
cmatc3.F File Reference
#include "implicit_f.inc"
#include "mvsiz_p.inc"
#include "param_c.inc"
#include "impl1_c.inc"
#include "impl2_c.inc"
#include "com20_c.inc"
#include "vectorize.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine cmatc3 (jft, jlt, pm, mat, geo, pid, area, thk0, thk02, thk, thke, volg, mtn, npt, ithk, hm, hf, hc, hz, igtyp, iorth, hmor, hfor, dir, igeo, idril, ihbe, hmfor, gs, isubstack, stack, elbuf_str, nlay, drape, nft, nel, indx_drape, sedrape, numel_drape)
subroutine cctoglob (jft, jlt, hm, hc, hmor, dir, nel)
subroutine gepm_lc (jft, jlt, mat, pm, shf, hm, hc)
subroutine putsignorc3 (jft, jlt, ir, is, it, g_imp, signor)
subroutine cmatip3 (jft, jlt, pm, mat, pid, mtn, npt, hm, hf, iorth, hmor, hfor, hmfor, ipg)
subroutine cmatch3 (jft, jlt, pm, mat, geo, pid, mtn, idril, igeo, hm, hf, hz)
subroutine cdmstif (jft, jlt, vol, thk0, thk2, hm, hf, hc, hz, hmor, hfor, hmfor, iplat, dm, df, gm, gf, dhz, dmor, dfor, dmf, idril, iorth)

Function/Subroutine Documentation

◆ cctoglob()

subroutine cctoglob ( integer jft,
integer jlt,
hm,
hc,
hmor,
dir,
integer nel )

Definition at line 402 of file cmatc3.F.

403C-----------------------------------------------
404C I m p l i c i t T y p e s
405C-----------------------------------------------
406#include "implicit_f.inc"
407C-----------------------------------------------
408C G l o b a l P a r a m e t e r s
409C-----------------------------------------------
410#include "mvsiz_p.inc"
411C-----------------------------------------------
412C D u m m y A r g u m e n t s
413C-----------------------------------------------
414 INTEGER JFT, JLT,NEL
415 my_real
416 . dir(nel,2),hm(mvsiz,4),hc(mvsiz,2),hmor(mvsiz,2)
417C-----------------------------------------------
418C L o c a l V a r i a b l e s
419C-----------------------------------------------
420 INTEGER I,J
421 my_real
422 . m2(mvsiz),n2(mvsiz),mn(mvsiz),m4(mvsiz),n4(mvsiz),
423 . mn2(mvsiz),cm(6),cc(2),t1,t2,t3
424C-----------------------------------------------
425 DO i=jft,jlt
426 m2(i)= dir(i,1)*dir(i,1)
427 n2(i)= dir(i,2)*dir(i,2)
428 m4(i)= m2(i)*m2(i)
429 n4(i)= n2(i)*n2(i)
430 mn(i)= dir(i,1)*dir(i,2)
431 mn2(i)= mn(i)*mn(i)
432 ENDDO
433 DO i=jft,jlt
434 t1 = two*mn2(i)*hm(i,3)+four*mn2(i)*hm(i,4)
435 cm(1)=m4(i)*hm(i,1)+n4(i)*hm(i,2)+t1
436 cm(2)=n4(i)*hm(i,1)+m4(i)*hm(i,2)+t1
437 t2 = mn2(i)*(hm(i,1)+hm(i,2))
438 cm(3)=t2+(m4(i)+n4(i))*hm(i,3)-four*mn2(i)*hm(i,4)
439 cm(4)=t2-two*mn2(i)*(hm(i,3)+hm(i,4))+
440 . (m4(i)+n4(i))*hm(i,4)
441 t3 = mn(i)*(hm(i,3)+two*hm(i,4))
442 hmor(i,1)=mn(i)*(m2(i)*hm(i,1)-n2(i)*hm(i,2))+
443 . t3*(n2(i)-m2(i))
444 hmor(i,2)=mn(i)*(n2(i)*hm(i,1)-m2(i)*hm(i,2))+
445 . t3*(m2(i)-n2(i))
446 hm(i,1)=cm(1)
447 hm(i,2)=cm(2)
448 hm(i,3)=cm(3)
449 hm(i,4)=cm(4)
450 ENDDO
451C
452 DO i=jft,jlt
453 cm(1)= m2(i)*hc(i,1)+n2(i)*hc(i,2)
454 cm(2)= n2(i)*hc(i,1)+m2(i)*hc(i,2)
455 hc(i,1)=cm(1)
456 hc(i,2)=cm(2)
457 ENDDO
458C
459 RETURN
my_real
#define my_real
Definition cppsort.cpp:32

◆ cdmstif()

subroutine cdmstif ( integer jft,
integer jlt,
vol,
thk0,
thk2,
hm,
hf,
hc,
hz,
hmor,
hfor,
hmfor,
integer, dimension(*) iplat,
dm,
df,
gm,
gf,
dhz,
dmor,
dfor,
dmf,
integer idril,
integer iorth )

Definition at line 939 of file cmatc3.F.

944C-----------------------------------------------
945C I m p l i c i t T y p e s
946C-----------------------------------------------
947#include "implicit_f.inc"
948C-----------------------------------------------
949C D u m m y A r g u m e n t s
950C-----------------------------------------------
951 INTEGER JFT,JLT,IPLAT(*),IDRIL,IORTH
952 my_real
953 . vol(*),thk0(*),thk2(*),
954 . hm(4,*),hf(4,*),hz(*),hc(2,*),hmor(2,*),hfor(2,*),
955 . hmfor(6,*),dm(2,2,*),df(2,2,*),dhz(*) ,
956 . dmor(2,*),dfor(2,*),dmf(3,3,*),gm(*),gf(*)
957C-----------------------------------------------
958c FUNCTION: stiffness modulus matrix after integration
959C-----------------------------------------------
960C L o c a l V a r i a b l e s
961C-----------------------------------------------
962 INTEGER I,J,M,EP
963C REAL
964 my_real
965 . c1,c2,fac
966C-----------------------------------------------
967#include "vectorize.inc"
968C-----------------------
969 DO m=jft,jlt
970 ep=iplat(m)
971 c2=vol(ep)
972 c1=thk2(ep)*c2
973 dm(1,1,m)=hm(1,ep)*c2
974 dm(2,2,m)=hm(2,ep)*c2
975 dm(1,2,m)=hm(3,ep)*c2
976 dm(2,1,m)=dm(1,2,m)
977 gm(m) =hm(4,ep)*c2
978 df(1,1,m)=hf(1,ep)*c1
979 df(2,2,m)=hf(2,ep)*c1
980 df(1,2,m)=hf(3,ep)*c1
981 df(2,1,m)=df(1,2,m)
982 gf(m) =hf(4,ep)*c1
983 dhz(m)=hz(ep)*c1
984 ENDDO
985C
986 IF (idril>0) THEN
987 DO m=jft,jlt
988 ep=iplat(m)
989 c2=vol(ep)
990 dhz(m)=hz(ep)*fourth*c2
991 ENDDO
992 END IF
993C
994 IF (iorth >0 ) THEN
995 DO m=jft,jlt
996 ep=iplat(m)
997 c2=vol(ep)
998 c1=thk2(ep)*c2
999 dmor(1,m)=hmor(1,ep)*c2
1000 dmor(2,m)=hmor(2,ep)*c2
1001 dfor(1,m)=hfor(1,ep)*c1
1002 dfor(2,m)=hfor(2,ep)*c1
1003 ENDDO
1004 DO m=jft,jlt
1005 ep=iplat(m)
1006 c2=vol(ep)*thk0(ep)
1007 dmf(1,1,m)=hmfor(1,ep)*c2
1008 dmf(2,2,m)=hmfor(2,ep)*c2
1009 dmf(1,2,m)=hmfor(3,ep)*c2
1010 dmf(1,3,m)=hmfor(5,ep)*c2
1011 dmf(2,3,m)=hmfor(6,ep)*c2
1012 dmf(2,1,m)=dmf(1,2,m)
1013 dmf(3,1,m)=dmf(1,3,m)
1014 dmf(3,2,m)=dmf(2,3,m)
1015 dmf(3,3,m)=hmfor(4,ep)*c2
1016 ENDDO
1017 END IF !(IORTH >0 ) THEN
1018C
1019 RETURN

◆ cmatc3()

subroutine cmatc3 ( integer jft,
integer jlt,
pm,
integer, dimension(*) mat,
geo,
integer, dimension(*) pid,
area,
thk0,
thk02,
thk,
thke,
volg,
integer mtn,
integer npt,
integer ithk,
hm,
hf,
hc,
hz,
integer igtyp,
integer iorth,
hmor,
hfor,
dir,
integer, dimension(npropgi,*) igeo,
integer idril,
integer ihbe,
hmfor,
gs,
integer isubstack,
type (stack_ply) stack,
type(elbuf_struct_) elbuf_str,
integer nlay,
type (drape_), dimension(numel_drape) drape,
integer nft,
integer nel,
integer, dimension(sedrape) indx_drape,
integer, intent(in) sedrape,
integer, intent(in) numel_drape )

Definition at line 39 of file cmatc3.F.

47C-----------------------------------------------
48C M o d u l e s
49C-----------------------------------------------
50 USE elbufdef_mod
51 USE stack_mod
52 USE drape_mod
53C-----------------------------------------------
54C I m p l i c i t T y p e s
55C-----------------------------------------------
56#include "implicit_f.inc"
57C-----------------------------------------------
58C G l o b a l P a r a m e t e r s
59C-----------------------------------------------
60#include "mvsiz_p.inc"
61C-----------------------------------------------
62C C o m m o n B l o c k s
63C-----------------------------------------------
64#include "param_c.inc"
65#include "impl1_c.inc"
66#include "impl2_c.inc"
67C-----------------------------------------------
68C D u m m y A r g u m e n t s
69C-----------------------------------------------
70 INTEGER JFT, JLT ,MTN , NPT,ITHK,IGTYP,IORTH,ISUBSTACK,NLAY,NFT
71 INTEGER MAT(*), PID(*),IGEO(NPROPGI,*),IDRIL,IHBE
72 INTEGER , INTENT(IN) :: SEDRAPE,NUMEL_DRAPE
73 INTEGER, DIMENSION(SEDRAPE) :: INDX_DRAPE
74 my_real
75 . geo(npropg,*), pm(npropm,*), area(*),
76 . thk0(*),thk02(*),thk(*),thke(*), dir(*),
77 . volg(*),hm(mvsiz,4),hf(mvsiz,4),hc(mvsiz,2),hz(*),hmor(mvsiz,2),hfor(mvsiz,2),
78 . hmfor(mvsiz,6),gs(*)
79 TYPE (STACK_PLY) :: STACK
80 TYPE(ELBUF_STRUCT_) :: ELBUF_STR
81 TYPE (DRAPE_) :: DRAPE(NUMEL_DRAPE)
82C-----------------------------------------------
83c FUNCTION: stiffness modulus matrix build
84c
85c Note:
86c ARGUMENTS: (I: input, O: output, IO: input * output, W: workspace)
87c
88c TYPE NAME FUNCTION
89c I JFT,JLT - element id limit
90c I PM(NPROPM,MID) - input Material data
91c I MAT(NEL) ,MTN - Material id :Mid and Material type id
92c I GEO(NPROPG,PID) - input geometrical property data
93c I IGEO(NPROPGI,PID) - input geometrical property data (integer)
94c I PID(NEL) - Pid
95c I IGTYP,IORTH - Geo. property type
96c I VOLG,AREA - element volume,AREA (total)
97c O THK0,THK02 - element thickness and thickness^2
98c I THK ,THKE - element updated and initial thickness
99c I NPT,ITHK - num. integrating point in thickness,updated thickness flag
100c I DIR - orthotropic directions
101c O IORTH - flag for orthopic material (full matrix)
102c O HM(4,NEL) - membrane stiffness modulus (plane stress)
103c HM(1:D11,2:D22,3:D12,4:G);----
104c O HF(4,NEL) - bending stiffness modulus (plane stress) same than HM
105c -HF=integration(t^2*HM) explicitly of thickness
106c O HC(2,NEL) - transverse shear modulus HC(1:G23,2:G13)
107c O HZ(NEL) -drilling dof modulus
108c I IDRIL - flag of using drilling dof
109c O HMOR(2,NEL) - suppermentary membrane modulus for orthotropic (D13,D23)
110c O HFOR(2,NEL) - suppermentary bending modulus for orthotropic (D13,D23)
111c O HMFOR(6,NEL) - suppermentary membrane-bending coupling modulus for orthotropic
112c (1:D11,2:D22,3:D12,4:G,5:D13,6:D23)
113c O GS(NEL) - out of plane shear isotropic shear modulus (for QEPH hourglass part)
114C-----------------------------------------------
115C L o c a l V a r i a b l e s
116C-----------------------------------------------
117 INTEGER I,MX,IPID,J,J2,J3,JJ,NEL,L,IGMAT,IPGMAT,
118 . LAYNPT_MAX, NLAY_MAX,ILAY
119C REAL
120 my_real
121 . shf(mvsiz),nu(mvsiz),g(mvsiz),ym(mvsiz),a11(mvsiz),a12(mvsiz),
122 . e11,e22,nu12,g31,g23,a22,wmc,facg,coef,wm
123 my_real
124 . fac(mvsiz),hmly(mvsiz,4),hcly(mvsiz,2), hmorly(mvsiz,2),sfac(mvsiz)
125 INTEGER, DIMENSION(:) , ALLOCATABLE :: MATLY !!
126 my_real, DIMENSION(:) , ALLOCATABLE :: thkly !!
127 my_real, DIMENSION(:,:) , ALLOCATABLE :: posly,thk_ly
128C-----------------------------------------------
129 coef =em01
130 nel = jlt-jft+1
131 ! Npt_max
132 laynpt_max = 1
133 IF(igtyp == 51 .OR. igtyp == 52) THEN
134 DO ilay=1,elbuf_str%NLAY
135 laynpt_max = max(laynpt_max , elbuf_str%BUFLY(ilay)%NPTT)
136 ENDDO
137 ENDIF
138 nlay_max = max(nlay,npt, elbuf_str%NLAY)
139 ALLOCATE(matly(mvsiz*nlay_max), thkly(mvsiz*nlay_max*laynpt_max),
140 . posly(mvsiz,nlay_max*laynpt_max),thk_ly(nel,nlay_max*laynpt_max))
141
142C IF (IHBE>=21.AND.IHBE<=29) COEF =EM03
143 IF(ithk>0.AND.ismdisp==0)THEN
144 DO i=jft,jlt
145 thk0(i)=thk(i)
146 ENDDO
147 ELSE
148 DO i=jft,jlt
149 thk0(i)=thke(i)
150 ENDDO
151 ENDIF
152 igmat = igeo(98,pid(1))
153 ipgmat = 700
154 IF(igtyp == 11 .AND. igmat > 0) THEN
155 DO i=jft,jlt
156 thk02(i) = thk0(i)*thk0(i)
157 volg(i) = thk0(i)*area(i)
158 ipid=pid(i)
159 mx = pid(i)
160 ym(i) = geo(ipgmat +2 ,mx)
161 nu(i) = geo(ipgmat +3 ,mx)
162 g(i) = geo(ipgmat +4 ,mx)
163 a11(i) = geo(ipgmat +5 ,mx)
164 a12(i) = geo(ipgmat +6 ,mx)
165 ENDDO
166 ELSE
167C
168 mx =mat(jft)
169 DO i=jft,jlt
170 thk02(i) = thk0(i)*thk0(i)
171 volg(i) = thk0(i)*area(i)
172 ipid=pid(i)
173 ym(i) =pm(20,mx)
174 nu(i) =pm(21,mx)
175 g(i) =pm(22,mx)
176 a11(i) =pm(24,mx)
177 a12(i) =pm(25,mx)
178 ENDDO
179 END IF
180 IF(npt==1) THEN
181 DO i=jft,jlt
182 shf(i)=0.
183 ENDDO
184 ELSE
185 DO i=jft,jlt
186 shf(i)=geo(38,pid(i))
187 ENDDO
188 ENDIF
189 DO i=jft,jlt
190 gs(i)=g(i)*shf(i)
191 ENDDO
192C----this will do only for QEPH and change also in CNCOEF!!!look at starter first
193 IF(mtn>=24)THEN
194 DO i=jft,jlt
195 a12(i) =nu(i)*a11(i)
196 ENDDO
197 ELSEIF (mtn==78)THEN
198 CALL get_etfac_s(nel,sfac,mtn)
199 DO i=jft,jlt
200 ym(i) =sfac(i)*ym(i)
201 g(i) =sfac(i)*g(i)
202 a11(i)=sfac(i)*a11(i)
203 a12(i)=sfac(i)*a12(i)
204 ENDDO
205 ENDIF
206 IF (mtn==19.OR.mtn==15.OR.mtn==25) THEN
207 iorth=1
208 ELSE
209 iorth=0
210 ENDIF
211 IF (iorth==1) THEN
212 DO i=jft,jlt
213 hmfor(i,1)=zero
214 hmfor(i,2)=zero
215 hmfor(i,3)=zero
216 hmfor(i,4)=zero
217 hmfor(i,5)=zero
218 hmfor(i,6)=zero
219 ENDDO
220 IF (mtn==19) THEN
221 CALL gepm_lc(jft,jlt,mat,pm,shf,hm,hc)
222 CALL cctoglob(jft,jlt,hm,hc,hmor,dir,nel)
223 DO i=jft,jlt
224 hf(i,1)=one_over_12*hm(i,1)
225 hf(i,2)=one_over_12*hm(i,2)
226 hf(i,3)=one_over_12*hm(i,3)
227 hf(i,4)=one_over_12*hm(i,4)
228 hfor(i,1)=one_over_12*hmor(i,1)
229 hfor(i,2)=one_over_12*hmor(i,2)
230 hz(i)= max(hf(i,1),hf(i,2),hf(i,4))*kz_tol
231 ENDDO
232 ELSEIF (mtn==15.OR.mtn==25) THEN
233 IF (igtyp==9) THEN
234 CALL gepm_lc(jft,jlt,mat,pm,shf,hm,hc)
235 CALL cctoglob(jft,jlt,hm,hc,hmor,dir,nel)
236 DO i=jft,jlt
237 hf(i,1)=one_over_12*hm(i,1)
238 hf(i,2)=one_over_12*hm(i,2)
239 hf(i,3)=one_over_12*hm(i,3)
240 hf(i,4)=one_over_12*hm(i,4)
241 hfor(i,1)=one_over_12*hmor(i,1)
242 hfor(i,2)=one_over_12*hmor(i,2)
243 hz(i)= max(hf(i,1),hf(i,2),hf(i,4))*kz_tol
244 ENDDO
245 ELSEIF(igtyp == 10.OR.igtyp == 11.OR.igtyp == 17.OR.
246 . igtyp==51 .OR. igtyp == 52)THEN
247C INTEGRATION PAR COUCHES
248 CALL layini(elbuf_str,jft ,jlt ,geo ,igeo ,
249 . mat ,pid ,thkly ,matly ,posly ,
250 . igtyp ,0 ,0 ,nlay ,npt ,
251 . isubstack,stack ,drape ,nft ,thke ,
252 . nel ,thk_ly ,indx_drape,sedrape, numel_drape)
253 DO i=jft,jlt
254 hm(i,1)=zero
255 hm(i,2)=zero
256 hm(i,3)=zero
257 hm(i,4)=zero
258 hc(i,1)=zero
259 hc(i,2)=zero
260 hf(i,1)=zero
261 hf(i,2)=zero
262 hf(i,3)=zero
263 hf(i,4)=zero
264 hmor(i,1)=zero
265 hmor(i,2)=zero
266 hfor(i,1)=zero
267 hfor(i,2)=zero
268 ENDDO
269 IF(igtyp==10)THEN
270 DO j=1,npt
271 j2=1+(j-1)*jlt
272 j3=1+(j-1)*jlt*2
273 CALL gepm_lc(jft,jlt,matly(j2),pm,shf,hmly,hcly)
274 CALL cctoglob(jft,jlt,hmly,hcly,hmorly,dir(j3),nel)
275 DO i=jft,jlt
276 jj = j2 - 1 + i
277 wmc=posly(i,j)*posly(i,j)*thkly(jj)
278 hm(i,1)=hm(i,1)+thkly(jj)*hmly(i,1)
279 hm(i,2)=hm(i,2)+thkly(jj)*hmly(i,2)
280 hm(i,3)=hm(i,3)+thkly(jj)*hmly(i,3)
281 hm(i,4)=hm(i,4)+thkly(jj)*hmly(i,4)
282 hc(i,1)=hc(i,1)+thkly(jj)*hcly(i,1)
283 hc(i,2)=hc(i,2)+thkly(jj)*hcly(i,2)
284 hmor(i,1)=hmor(i,1)+thkly(jj)*hmorly(i,1)
285 hmor(i,2)=hmor(i,2)+thkly(jj)*hmorly(i,2)
286 hf(i,1)=hf(i,1)+wmc*hmly(i,1)
287 hf(i,2)=hf(i,2)+wmc*hmly(i,2)
288 hf(i,3)=hf(i,3)+wmc*hmly(i,3)
289 hf(i,4)=hf(i,4)+wmc*hmly(i,4)
290 hfor(i,1)=hfor(i,1)+wmc*hmorly(i,1)
291 hfor(i,2)=hfor(i,2)+wmc*hmorly(i,2)
292 ENDDO
293 ENDDO
294 ELSE
295 DO j=1,npt
296 j2=1+(j-1)*jlt
297 j3=1+(j-1)*jlt*2
298 CALL gepm_lc(jft,jlt,matly(j2),pm,shf,hmly,hcly)
299 CALL cctoglob(jft,jlt,hmly,hcly,hmorly,dir(j3),nel)
300 DO i=jft,jlt
301 jj = j2 - 1 + i
302 wm = posly(i,j)*thkly(jj)
303 wmc= posly(i,j)*wm
304 hm(i,1)=hm(i,1)+thkly(jj)*hmly(i,1)
305 hm(i,2)=hm(i,2)+thkly(jj)*hmly(i,2)
306 hm(i,3)=hm(i,3)+thkly(jj)*hmly(i,3)
307 hm(i,4)=hm(i,4)+thkly(jj)*hmly(i,4)
308 hc(i,1)=hc(i,1)+thkly(jj)*hcly(i,1)
309 hc(i,2)=hc(i,2)+thkly(jj)*hcly(i,2)
310 hmor(i,1)=hmor(i,1)+thkly(jj)*hmorly(i,1)
311 hmor(i,2)=hmor(i,2)+thkly(jj)*hmorly(i,2)
312 hf(i,1)=hf(i,1)+wmc*hmly(i,1)
313 hf(i,2)=hf(i,2)+wmc*hmly(i,2)
314 hf(i,3)=hf(i,3)+wmc*hmly(i,3)
315 hf(i,4)=hf(i,4)+wmc*hmly(i,4)
316 hfor(i,1)=hfor(i,1)+wmc*hmorly(i,1)
317 hfor(i,2)=hfor(i,2)+wmc*hmorly(i,2)
318 hmfor(i,1)=hmfor(i,1)+wm*hmly(i,1)
319 hmfor(i,2)=hmfor(i,2)+wm*hmly(i,2)
320 hmfor(i,3)=hmfor(i,3)+wm*hmly(i,3)
321 hmfor(i,4)=hmfor(i,4)+wm*hmly(i,4)
322 hmfor(i,5)=hmfor(i,5)+wm*hmorly(i,1)
323 hmfor(i,6)=hmfor(i,6)+wm*hmorly(i,2)
324 ENDDO
325 ENDDO
326 END IF !(IGTYP==10)
327 DO i=jft,jlt
328 hz(i)= max(hf(i,1),hf(i,2),hf(i,4))*kz_tol
329 ENDDO
330 ENDIF
331 ENDIF
332 ELSE
333C-----by layer
334 IF (mtn == 27) THEN
335 CALL layini(elbuf_str,jft ,jlt ,geo ,igeo ,
336 . mat ,pid ,thkly ,matly ,posly ,
337 . igtyp ,0 ,0 ,nlay ,npt ,
338 . isubstack,stack ,drape ,nft ,thke ,
339 . jlt ,thk_ly ,indx_drape,sedrape ,numel_drape)
340 DO i=jft,jlt
341 hm(i,1)=a11(i)
342 hm(i,2)=a11(i)
343 hm(i,3)=a12(i)
344 hm(i,4)=g(i)
345 hf(i,1)=zero
346 hf(i,2)=zero
347 hf(i,3)=zero
348 hf(i,4)=zero
349 hc(i,1)=gs(i)
350 hc(i,2)=gs(i)
351 ENDDO
352 DO j=1,npt
353 DO i=jft,jlt
354 j2=1+(j-1)*jlt
355 jj = j2 - 1 + i
356 wm = posly(i,j)*thkly(jj)
357 wmc= posly(i,j)*wm
358 hf(i,1)=hf(i,1)+wmc*hm(i,1)
359 hf(i,2)=hf(i,2)+wmc*hm(i,2)
360 hf(i,3)=hf(i,3)+wmc*hm(i,3)
361 hf(i,4)=hf(i,4)+wmc*hm(i,4)
362 ENDDO
363 END DO !J=1,NPT
364 DO i=jft,jlt
365 hz(i)= hf(i,1)*kz_tol
366 ENDDO
367 ELSE
368C
369 DO i=jft,jlt
370 hm(i,1)=a11(i)
371 hm(i,2)=a11(i)
372 hm(i,3)=a12(i)
373 hm(i,4)=g(i)
374 hf(i,1)=one_over_12*hm(i,1)
375 hf(i,2)=one_over_12*hm(i,2)
376 hf(i,3)=one_over_12*hm(i,3)
377 hf(i,4)=one_over_12*hm(i,4)
378 hc(i,1)=gs(i)
379 hc(i,2)=gs(i)
380 hz(i)= hf(i,1)*kz_tol
381 ENDDO
382 END IF !(MTN == 27) THEN
383 ENDIF
384 IF (idril>0) THEN
385 facg = coef*min(one,kz_tol*2000)
386 DO i=jft,jlt
387C-------allows changing module by KZ_TOL----
388 hz(i)= g(i)*facg
389C HZ(I)= HM(I,4)*FACG
390 ENDDO
391 END IF !(IDRIL>0) THEN
392C
393 DEALLOCATE(matly, thkly, posly, thk_ly)
394 RETURN
cctoglob
subroutine cctoglob(jft, jlt, hm, hc, hmor, dir, nel)
Definition cmatc3.F:403
gepm_lc
subroutine gepm_lc(jft, jlt, mat, pm, shf, hm, hc)
Definition cmatc3.F:468
get_etfac_s
subroutine get_etfac_s(nel, sfac, mtn)
Definition get_etfac_s.F:36
area
subroutine area(d1, x, x2, y, y2, eint, stif0)
Definition hm_read_prop32.F:567
layini
subroutine layini(elbuf_str, jft, jlt, geo, igeo, mat, pid, thkly, matly, posly, igtyp, ixfem, ixlay, nlay, npt, isubstack, stack, drape, nft, thk, nel, ratio_thkly, indx_drape, sedrape, numel_drape)
Definition layini.F:47
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21
drape_mod
Definition drape_mod.F:54
stack_mod
Definition stack_mod.F:72

◆ cmatch3()

subroutine cmatch3 ( integer jft,
integer jlt,
pm,
integer, dimension(*) mat,
geo,
integer, dimension(*) pid,
integer mtn,
integer idril,
integer, dimension(npropgi,*) igeo,
hm,
hf,
hz )

Definition at line 818 of file cmatc3.F.

821C-----------------------------------------------
822C M o d u l e s
823C-----------------------------------------------
824 USE imp_ktan
825 USE imp_ktan_def
826C-----------------------------------------------
827C I m p l i c i t T y p e s
828C-----------------------------------------------
829#include "implicit_f.inc"
830C-----------------------------------------------
831C G l o b a l P a r a m e t e r s
832C-----------------------------------------------
833#include "mvsiz_p.inc"
834C-----------------------------------------------
835C C o m m o n B l o c k s
836C-----------------------------------------------
837#include "param_c.inc"
838#include "impl2_c.inc"
839C-----------------------------------------------
840C D u m m y A r g u m e n t s
841C-----------------------------------------------
842 INTEGER JFT, JLT ,MTN
843 INTEGER MAT(*), PID(*),IGEO(NPROPGI,*),IDRIL
844C REAL
845 my_real
846 . geo(npropg,*), pm(npropm,*), hm(mvsiz,4),hf(mvsiz,4),hz(*)
847C-----------------------------------------------
848c FUNCTION: stiffness modulus matrix for hourglass part
849c
850c Note:
851c ARGUMENTS: (I: input, O: output, IO: input * output, W: workspace)
852c
853c TYPE NAME FUNCTION
854c I JFT,JLT - element id limit
855c I PM(NPROPM,MID) - input Material data
856c I MAT(NEL) ,MTN - Material id :Mid and Material type id
857c I GEO(NPROPG,PID) - input geometrical property data
858c I IGEO(NPROPGI,PID) - input geometrical property data (integer)
859c I PID(NEL) - Pid
860c O HM(NEL,4) - membrane stiffness modulus (plane stress)
861c HM(1:D11,2:D22,3:D12,4:G);----
862c O HF(NEL,4) - bending stiffness modulus (plane stress) same than HM
863c -HF=integration(t^2*HM) explicitly of thickness
864c O HZ(NEL) -drilling dof modulus
865c I IDRIL - flag of using drilling dof
866C-----------------------------------------------
867C L o c a l V a r i a b l e s
868C-----------------------------------------------
869 INTEGER I,MX,IPID,J,J2,J3,JJ,NEL,L,IGMAT,IPGMAT,IGTYP
870 my_real
871 . nu(mvsiz),g(mvsiz),ym(mvsiz),a11(mvsiz),a12(mvsiz),
872 . e11,e22,nu12,g31,g23,a22,wmc,facg,coef,wm
873 my_real
874 . fac(mvsiz)
875C-----------------------------------------------
876C NEL = JLT-JFT+1
877C CALL GET_ETFAC_S(NEL,FAC,MTN)
878C------elastic for the moment
879 DO i=jft,jlt
880 fac(i) = one
881 ENDDO
882 igtyp = igeo(11,pid(1))
883 igmat = igeo(98,pid(1))
884 ipgmat = 700
885 IF(igtyp == 11 .AND. igmat > 0) THEN
886 DO i=jft,jlt
887 mx = pid(i)
888 ym(i) = geo(ipgmat +2 ,mx)
889 nu(i) = geo(ipgmat +3 ,mx)
890 g(i) = geo(ipgmat +4 ,mx)
891 a11(i) = geo(ipgmat +5 ,mx)
892 a12(i) = geo(ipgmat +6 ,mx)
893 ENDDO
894 ELSE
895C
896 mx =mat(jft)
897 DO i=jft,jlt
898 ym(i) =pm(20,mx)
899 nu(i) =pm(21,mx)
900 g(i) =pm(22,mx)
901 a11(i) =pm(24,mx)
902 a12(i) =pm(25,mx)
903 ENDDO
904 END IF
905C----this will do only for QEPH and change also in CNCOEF!!!look at starter first
906 IF(mtn>=24)THEN
907 DO i=jft,jlt
908 a12(i) =nu(i)*a11(i)
909 ENDDO
910 ENDIF
911C ---isotrope--only--
912 DO i=jft,jlt
913 hm(i,1)=a11(i)*fac(i)
914 hm(i,2)=hm(i,1)
915 hm(i,3)=a12(i)*fac(i)
916 hm(i,4)=g(i)*fac(i)
917 hf(i,1)=one_over_12*hm(i,1)
918 hf(i,2)=one_over_12*hm(i,2)
919 hf(i,3)=one_over_12*hm(i,3)
920 hf(i,4)=one_over_12*hm(i,4)
921C-----------elastic only------------
922 hz(i)= one_over_12*a11(i)*kz_tol
923 ENDDO
924C
925 IF (idril>0) THEN
926 coef=em01
927 facg = coef*min(one,kz_tol*2000)
928 DO i=jft,jlt
929C-------elastic only; allows changing module by KZ_TOL----
930 hz(i)= g(i)*facg
931 ENDDO
932 END IF !(IDRIL>0) THEN
933C
934 RETURN
imp_ktan_def
Definition impbufdef_mod.F:208
imp_ktan
Definition impbufdef_mod.F:676

◆ cmatip3()

subroutine cmatip3 ( integer jft,
integer jlt,
pm,
integer, dimension(*) mat,
integer, dimension(*) pid,
integer mtn,
integer npt,
hm,
hf,
integer iorth,
hmor,
hfor,
hmfor,
integer ipg )

Definition at line 579 of file cmatc3.F.

582C-----------------------------------------------
583C M o d u l e s
584C-----------------------------------------------
585 USE imp_ktan
586 USE imp_ktan_def
587C-----------------------------------------------
588C I m p l i c i t T y p e s
589C-----------------------------------------------
590#include "implicit_f.inc"
591C-----------------------------------------------
592C G l o b a l P a r a m e t e r s
593C-----------------------------------------------
594#include "mvsiz_p.inc"
595C-----------------------------------------------
596C C o m m o n B l o c k s
597C-----------------------------------------------
598#include "param_c.inc"
599#include "impl1_c.inc"
600#include "com20_c.inc"
601C-----------------------------------------------
602C D u m m y A r g u m e n t s
603C-----------------------------------------------
604 INTEGER JFT, JLT ,MTN , NPT,IORTH,IPG
605 INTEGER MAT(*), PID(*)
606 my_real
607 . pm(npropm,*),hm(mvsiz,4),hf(mvsiz,4),hmor(mvsiz,2),hfor(mvsiz,2),hmfor(mvsiz,6)
608C-----------------------------------------------
609c FUNCTION: stiffness modulus matrix build per ipg (on the surface)
610c
611c Note:
612c ARGUMENTS: (I: input, O: output, IO: input * output, W: workspace)
613c
614c TYPE NAME FUNCTION
615c I JFT,JLT - element id limit
616c I PM(NPROPM,MID) - input Material data
617c I MAT(NEL) ,MTN - Material id :Mid and Material type id
618c I PID(NEL) - Pid
619c I NPT, - num. integrating point in thickness
620c I IPG - PG on surface (for one-point integration shell should input 1)
621c O IORTH - flag for orthopic material (full matrix)
622c O HM(4,NEL) - membrane stiffness modulus (plane stress)
623c HM(1:C11,2:C22,3:C12,4:G);----
624c O HF(4,NEL) - bending stiffness modulus (plane stress) same than HM
625c -HF=integration(t^2*HM) explicitly of thickness
626c O HMOR(2,NEL) - suppermentary membrane modulus for orthotropic (D13,D23)
627c O HFOR(2,NEL) - suppermentary bending modulus for orthotropic (D13,D23)
628c O HMFOR(6,NEL) - suppermentary membrane-bending coupling modulus for orthotropic
629c (1:C11,2:C22,3:C12,4:G,5:C13,6:C23)
630C-----------------------------------------------
631C L o c a l V a r i a b l e s
632C-----------------------------------------------
633 INTEGER I,MX,IPID,J,J2,J3,JJ,L,IR,IS,IT,IPLAS,IR4(4),IS4(4),NEL
634C REAL
635 my_real
636 . nu,g,ym,a11,a12,beta,
637 . theta1,theta2,hk(mvsiz),hh(mvsiz),dhk(mvsiz),dhh(mvsiz),
638 . gama(mvsiz),c11(mvsiz),c12(mvsiz),c33(mvsiz),sig(mvsiz,3),
639 . sigm(mvsiz,3),coef,wm0,wf0,aa,b11,b12,d11,d12,det,f_y2,sps,
640 . norm,cep11,cep12,cep13,cep23,cep22,cep33,fac(mvsiz),
641 . norm_1(mvsiz)
642 TYPE(L_KTBUFEP_) , POINTER :: LBUF
643 TYPE(MLAW_TAG_) , POINTER :: MTAG
644 DATA ir4/1,2,2,1/,is4/1,1,2,2/
645C----[C]=|A11 A12 0| [C]^-1=|B11 B12 0 | [P]=|2/3 -1/3 0 |
646C--------|A12 A11 0| |B12 B11 0 | |-1/3 2/3 0 |
647C--------| 0 0 G| | 0 0 G_1| | 0 0 2 |
648C----[C]eff=[ C^-1+a*P]^-1 = |C11 C12 0 |
649C--------- |C12 C11 0 |
650C------- | 0 0 C33|
651C-----------------------------------------------
652 IF (ikt==0 .OR.(mtn /= 2 .AND. mtn /= 36)) RETURN
653C
654 nel = jlt-jft+1
655 CALL get_etfac_s(nel,fac,mtn)
656 iplas =0
657 DO i=jft,jlt
658 IF(fac(i) < one ) iplas =1
659 ENDDO
660c --- make the 0-th iteration always elastic
661 IF(iplas==0 .OR. iter_nl==0 ) RETURN
662C
663 mx =mat(jft)
664 ym =pm(20,mx)
665 nu =pm(21,mx)
666 g =pm(22,mx)
667 a11 =pm(24,mx)
668 a12 =pm(25,mx)
669 IF(mtn>=24)THEN
670 a12 =nu*a11
671 ENDIF
672C---------- or IORTH=2 in this case to dispense HMFOR
673 DO i=jft,jlt
674 hm(i,1)=zero
675 hm(i,2)=zero
676 hm(i,3)=zero
677 hm(i,4)=zero
678 hf(i,1)=zero
679 hf(i,2)=zero
680 hf(i,3)=zero
681 hf(i,4)=zero
682 hmor(i,1)=zero
683 hmor(i,2)=zero
684 hfor(i,1)=zero
685 hfor(i,2)=zero
686 hmfor(i,1)=zero
687 hmfor(i,2)=zero
688 hmfor(i,3)=zero
689 hmfor(i,4)=zero
690 hmfor(i,5)=zero
691 hmfor(i,6)=zero
692 ENDDO
693C-----------------------------------------------
694 mtag => ktbuf_str(ng_imp)%MLAW_TAG(mtn)
695c IR = IR4(IPG)
696c IS = IS4(IPG)
697 ir = 1
698 is = ipg
699C-------------tag plastified elements->using fac(I)----
700C------------still elastic-----
701 DO i=jft,jlt
702 IF (fac(i)==one ) THEN
703 hm(i,1)=a11
704 hm(i,2)=a11
705 hm(i,3)=a12
706 hm(i,4)=g
707 hf(i,1)=one_over_12*hm(i,1)
708 hf(i,2)=one_over_12*hm(i,2)
709 hf(i,3)=one_over_12*hm(i,3)
710 hf(i,4)=one_over_12*hm(i,4)
711 END IF !(FAC(I)==ONE ) THEN
712 ENDDO
713C-------------through thickness-----
714 DO it = 1 ,npt
715 lbuf => ktbuf_str(ng_imp)%KTBUFEP(ir,is,it)
716 IF (mtag%L_A_KT>0) THEN
717 DO i=jft,jlt
718c ...... SIG contains normalized deviatoric stresses ...
719 gama(i)= lbuf%A_KT(i)
720 IF (gama(i) > zero) THEN
721 j=5*(i-1)
722 sig(i,1)= lbuf%SIGE(j+1)
723 sig(i,2)= lbuf%SIGE(j+2)
724 sig(i,3)= lbuf%SIGE(j+3)
725 hk(i)= lbuf%SIGE(j+4)
726 hh(i)= lbuf%SIGE(j+5)
727 dhk(i)= two_third*hk(i)
728 dhh(i)= two_third*hh(i)
729 END IF
730 ENDDO
731 ELSE
732 DO i=jft,jlt
733 gama(i)= zero
734 ENDDO
735 END IF !(MTAG%L_A_KT>0) THEN
736C----calcul [C]^-1(<-B),[C]eff------------------
737 DO i=jft,jlt
738 IF (gama(i) >zero) THEN
739 b11=one/ym
740 b12=-nu/ym
741 aa = gama(i)/(one+gama(i)*dhk(i))
742 d11= b11+two_third*aa
743 d12= b12-third*aa
744 det=one/(d11*d11-d12*d12)
745 c11(i)=det*d11
746 c12(i)=-det*d12
747 c33(i)=g/(one+g*aa*two)
748C calcul beta, {n}
749 f_y2= sig(i,1)*(two*sig(i,1)+sig(i,2))+
750 . sig(i,2)*(sig(i,1)+two*sig(i,2))+
751 . half*sig(i,3)*sig(i,3)
752 sigm(i,1)= c11(i)*sig(i,1)+c12(i)*sig(i,2)
753 sigm(i,2)= c12(i)*sig(i,1)+c11(i)*sig(i,2)
754 sigm(i,3)= c33(i)*sig(i,3)
755 sps =sig(i,1)*sigm(i,1)+sig(i,2)*sigm(i,2)+sig(i,3)*sigm(i,3)
756C----------------BETA
757 theta1=one+dhk(i)*gama(i)
758 theta2=one-dhh(i)*gama(i)
759 coef=f_y2*theta1/theta2
760 beta=coef*(dhh(i)*theta1+dhk(i)*theta2)+sps
761C----------factor norm----
762 IF (abs(beta)<=em20) THEN
763 norm_1(i)=zero
764 ELSE
765 norm_1(i)= one/beta
766 END IF
767 END IF
768 ENDDO
769c update HM,HMOR,HF,HFOR
770 wf0 = wf(it,npt)
771 wm0 = z0(it,npt)*wm(it,npt)
772 DO i=jft,jlt
773 IF (gama(i) >zero) THEN
774 det=norm_1(i)
775 cep11=c11(i)-sigm(i,1)*sigm(i,1)*det
776 cep22=c11(i)-sigm(i,2)*sigm(i,2)*det
777 cep12=c12(i)-sigm(i,1)*sigm(i,2)*det
778 cep13= -sigm(i,1)*sigm(i,3)*det
779 cep23= -sigm(i,2)*sigm(i,3)*det
780 cep33=c33(i)-sigm(i,3)*sigm(i,3)*det
781 hm(i,1)=hm(i,1)+wf0*cep11
782 hm(i,2)=hm(i,2)+wf0*cep22
783 hm(i,3)=hm(i,3)+wf0*cep12
784 hm(i,4)=hm(i,4)+wf0*cep33
785 hmor(i,1)=hmor(i,1)+wf0*cep13
786 hmor(i,2)=hmor(i,2)+wf0*cep23
787 hf(i,1)=hf(i,1)+wm0*cep11
788 hf(i,2)=hf(i,2)+wm0*cep22
789 hf(i,3)=hf(i,3)+wm0*cep12
790 hf(i,4)=hf(i,4)+wm0*cep33
791 hfor(i,1)=hfor(i,1)+wm0*cep13
792 hfor(i,2)=hfor(i,2)+wm0*cep23
793 IF (iorth == 0) iorth = 1
794 ELSEIF (fac(i)/= one) THEN
795 hm(i,1)=hm(i,1)+wf0*a11
796 hm(i,2)=hm(i,2)+wf0*a11
797 hm(i,3)=hm(i,3)+wf0*a12
798 hm(i,4)=hm(i,4)+wf0*g
799 hf(i,1)=hf(i,1)+wm0*a11
800 hf(i,2)=hf(i,2)+wm0*a11
801 hf(i,3)=hf(i,3)+wm0*a12
802 hf(i,4)=hf(i,4)+wm0*g
803 END IF
804 ENDDO
805C
806 END DO !IT = 1 ,NPT
807
808 RETURN
norm
norm(diag(diag(diag(inv(mat))) -id.SOL), 2) % destroy mumps instance id.JOB
imp_ktan::ktbuf_str
type(ktbuf_struct_), dimension(:), allocatable, target ktbuf_str
Definition impbufdef_mod.F:680

◆ gepm_lc()

subroutine gepm_lc ( integer jft,
integer jlt,
integer, dimension(*) mat,
pm,
shf,
hm,
hc )

Definition at line 467 of file cmatc3.F.

468C-----------------------------------------------
469C I m p l i c i t T y p e s
470C-----------------------------------------------
471#include "implicit_f.inc"
472C-----------------------------------------------
473C G l o b a l P a r a m e t e r s
474C-----------------------------------------------
475#include "mvsiz_p.inc"
476C-----------------------------------------------
477C C o m m o n B l o c k s
478C-----------------------------------------------
479#include "param_c.inc"
480C-----------------------------------------------
481C D u m m y A r g u m e n t s
482C-----------------------------------------------
483 INTEGER JFT, JLT,MAT(*)
484 my_real
485 . hm(mvsiz,4),hc(mvsiz,2), pm(npropm,*), shf(*)
486C-----------------------------------------------
487C L o c a l V a r i a b l e s
488C-----------------------------------------------
489 INTEGER I,J,MX
490 my_real
491 . g,a11,a12,e11,e22,nu12,g31,g23,a22
492C-----------------------------------------------
493 mx =mat(jft)
494 nu12=(one-pm(35,mx)*pm(36,mx))
495 e11 =pm(33,mx)
496 e22 =pm(34,mx)
497 a11 =e11/nu12
498 a22 = e22/nu12
499 a12 =pm(36,mx)*a11
500 g =pm(37,mx)
501 g23 =pm(38,mx)
502 g31 =pm(39,mx)
503 DO i=jft,jlt
504 hm(i,1)=a11
505 hm(i,2)=a22
506 hm(i,3)=a12
507 hm(i,4)=g
508 hc(i,1)=g23*shf(i)
509 hc(i,2)=g31*shf(i)
510 ENDDO
511C
512 RETURN

◆ putsignorc3()

subroutine putsignorc3 ( integer jft,
integer jlt,
integer ir,
integer is,
integer it,
g_imp,
signor )

Definition at line 523 of file cmatc3.F.

524C-----------------------------------------------
525C M o d u l e s
526C-----------------------------------------------
527 USE imp_ktan
528 USE imp_ktan_def
529C-----------------------------------------------
530C I m p l i c i t T y p e s
531C-----------------------------------------------
532#include "implicit_f.inc"
533C-----------------------------------------------
534C G l o b a l P a r a m e t e r s
535C-----------------------------------------------
536#include "mvsiz_p.inc"
537C-----------------------------------------------
538C C o m m o n B l o c k s
539C-----------------------------------------------
540#include "impl1_c.inc"
541C-----------------------------------------------
542C D u m m y A r g u m e n t s
543C-----------------------------------------------
544 INTEGER JFT, JLT ,IR,IS,IT
545 my_real
546 . g_imp(*),signor(mvsiz,5)
547C-----------------------------------------------
548C L o c a l V a r i a b l e s
549C-----------------------------------------------
550 INTEGER I,MX,J,K
551 TYPE(L_KTBUFEP_) , POINTER :: SKBUF
552C-----------------------------------------------
553 IF (ikt==0) RETURN
554 skbuf => ktbuf_str(ng_imp)%KTBUFEP(ir,is,it)
555 DO i=jft ,jlt
556 j=5*(i-1)
557 skbuf%A_KT(i)=g_imp(i)
558 skbuf%SIGE(j+1)=signor(i,1)
559 skbuf%SIGE(j+2)=signor(i,2)
560 skbuf%SIGE(j+3)=signor(i,3)
561 skbuf%SIGE(j+4)=signor(i,4)
562 skbuf%SIGE(j+5)=signor(i,5)
563 END DO
564C
565 RETURN