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

Go to the source code of this file.

Functions/Subroutines

subroutine cncoef3b (jft, jlt, pm, mat, geo, pid, area, shf, thk0, thk02, nu, g, ym, a11, a12, thk, thke, ssp, rho, volg, gs, mtn, ithk, npt, dt1c, dt1, ihbe, amu, gsr, a11sr, a12sr, nusr, shfsr, krz, igeo, a11r, isubstack, pm_stack, uparam, dira, dirb, uvar, fac58, nel, zoffset)
subroutine cncoef3 (jft, jlt, pm, mat, geo, pid, off, area, shf, thk0, thk02, nu, g, ym, a11, a12, thk, thke, ssp, rho, volg, gs, mtn, ithk, npt, dt1c, dt1, ihbe, amu, krz, igeo, a11r, isubstack, pm_stack, nel, zoffset)
subroutine c3coefrz3 (jft, jlt, g, krz, area, thk)
subroutine cncoefort (jft, jlt, pm, mat, geo, pid, mtn, npt, hm, hf, hc, hmfor, iorth, dir, igeo, isubstack, stack, elbuf_str, nlay, thk, drape, nft, nel, indx_drape, thke, sedrape, numel_drape, mat_elem)

Function/Subroutine Documentation

◆ c3coefrz3()

subroutine c3coefrz3 ( integer jft,
integer jlt,
g,
krz,
area,
thk )

Definition at line 467 of file cncoef3.F.

468C-----------------------------------------------
469C I m p l i c i t T y p e s
470C-----------------------------------------------
471#include "implicit_f.inc"
472C-----------------------------------------------
473C C o m m o n B l o c k s
474C-----------------------------------------------
475#include "impl1_c.inc"
476#include "impl2_c.inc"
477C-----------------------------------------------
478C D u m m y A r g u m e n t s
479C-----------------------------------------------
480 INTEGER JFT, JLT
481 my_real
482 . g(*),krz(*),area(*),thk(*)
483C-----------------------------------------------
484C L o c a l V a r i a b l e s
485C-----------------------------------------------
486 INTEGER I
487 my_real kfac ,lmax
488C-----------------------------------------------
489 IF(impl_s>0)THEN
490 kfac= em01*min(one,kz_tol*2000)
491 ELSE
492 kfac= em02
493 ENDIF
494C
495 DO i=jft,jlt
496 krz(i) =kfac*g(i)
497 ENDDO
498
499 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
area
subroutine area(d1, x, x2, y, y2, eint, stif0)
Definition hm_read_prop32.F:567
min
#define min(a, b)
Definition macros.h:20

◆ cncoef3()

subroutine cncoef3 ( integer jft,
integer jlt,
pm,
integer, dimension(*) mat,
geo,
integer, dimension(*) pid,
off,
area,
shf,
thk0,
thk02,
nu,
g,
ym,
a11,
a12,
thk,
thke,
ssp,
rho,
volg,
gs,
integer mtn,
integer ithk,
integer npt,
dt1c,
dt1,
integer ihbe,
amu,
krz,
integer, dimension(npropgi,*) igeo,
a11r,
integer isubstack,
pm_stack,
integer, intent(in) nel,
intent(out) zoffset )

Definition at line 295 of file cncoef3.F.

303C-----------------------------------------------
304C I m p l i c i t T y p e s
305C-----------------------------------------------
306#include "implicit_f.inc"
307C-----------------------------------------------
308C C o m m o n B l o c k s
309C-----------------------------------------------
310#include "param_c.inc"
311#include "impl1_c.inc"
312#include "impl2_c.inc"
313C-----------------------------------------------
314C D u m m y A r g u m e n t s
315C-----------------------------------------------
316 INTEGER JFT, JLT,MTN,ITHK,NPT,IHBE,ISUBSTACK
317 INTEGER MAT(*), PID(*), IGEO(NPROPGI,*)
318 INTEGER , INTENT(IN) :: NEL
319C REAL
320 my_real geo(npropg,*), pm(npropm,*), off(*), area(*),
321 . shf(*),thk0(*),thk02(*),thk(*),thke(*),
322 . nu(*),g(*),ym(*),a11(*),a12(*),amu(*),
323 . volg(*),ssp(*),rho(*),gs(*),dt1c(*),dt1,krz(*),
324 . a11r(*),pm_stack(20,*)
325 my_real, DIMENSION(NEL) , INTENT(OUT) :: zoffset
326C-----------------------------------------------
327C L o c a l V a r i a b l e s
328C-----------------------------------------------
329 INTEGER I,ISH,MX,IPID,J,IGTYP,IPGMAT,IGMAT,IPOS
330C REAL
331 my_real fsh,viscdef,fac1tmp,kfac,dn , z0
332C-----------------------------------------------
333 IF(ithk>0.AND.ismdisp==0)THEN
334 DO i=jft,jlt
335 thk0(i)=thk(i)
336 ENDDO
337 ELSE
338 DO i=jft,jlt
339 thk0(i)=thke(i)
340 ENDDO
341 ENDIF
342C
343 IF(impl_s>0)THEN
344 kfac= em01*min(one,kz_tol*2000)
345 ELSE
346 kfac= em03
347 ENDIF
348C
349 igtyp = igeo(11,pid(1))
350 igmat = igeo(98,pid(1))
351 ipgmat = 700
352 IF(igtyp == 11 .AND. igmat > 0) THEN
353 DO i=jft,jlt
354 thk02(i) = thk0(i)*thk0(i)
355 volg(i) = thk0(i)*area(i)
356 dt1c(i) = dt1
357 ipid=pid(i)
358 rho(i) = geo(ipgmat +1 ,ipid)
359 ym(i) = geo(ipgmat +2 ,ipid)
360 nu(i) = geo(ipgmat +3 ,ipid)
361 g(i) = geo(ipgmat +4 ,ipid)
362 a11(i) = geo(ipgmat +5 ,ipid)
363 a12(i) = geo(ipgmat +6 ,ipid)
364 a11r(i)= geo(ipgmat +7 ,ipid)
365 ssp(i) = geo(ipgmat +9 ,ipid)
366 krz(i) =kfac*g(i)
367 ENDDO
368 ELSEIF(igtyp == 52 .OR.
369 . ((igtyp == 17 .OR. igtyp == 51 ) .AND. igmat > 0)) THEN
370 DO i=jft,jlt
371 thk02(i) = thk0(i)*thk0(i)
372 volg(i) = thk0(i)*area(i)
373 dt1c(i) = dt1
374 rho(i) = pm_stack(1 ,isubstack)
375 ym(i) = pm_stack(2 ,isubstack)
376 nu(i) = pm_stack(3 ,isubstack)
377 g(i) = pm_stack(4 ,isubstack)
378 a11(i) = pm_stack(5 ,isubstack)
379 a12(i) = pm_stack(6 ,isubstack)
380 a11r(i)= pm_stack(7 ,isubstack)
381 ssp(i) = pm_stack(9 ,isubstack)
382 krz(i) =kfac*g(i)
383 ENDDO
384
385 ELSE
386 mx =mat(jft)
387 DO i=jft,jlt
388 thk02(i) = thk0(i)*thk0(i)
389 volg(i) = thk0(i)*area(i)
390 dt1c(i) = dt1
391 rho(i)=pm(1,mx)
392 ipid=pid(i)
393 ym(i) =pm(20,mx)
394 nu(i) =pm(21,mx)
395 g(i) =pm(22,mx)
396 a11(i) =pm(24,mx)
397 a12(i) =pm(25,mx)
398 ssp(i) =pm(27,mx)
399 krz(i) =kfac*g(i)
400 ENDDO
401
402 ENDIF
403 IF(npt==1) THEN
404 DO i=jft,jlt
405 shf(i)=zero
406 ENDDO
407 ELSE
408 DO i=jft,jlt
409 shf(i)=geo(38,pid(i))
410 ENDDO
411 ENDIF
412 DO i=jft,jlt
413 gs(i)=g(i)*shf(i)
414 ENDDO
415 IF(mtn>=24)THEN
416 DO i=jft,jlt
417 a12(i) =nu(i)*a11(i)
418 ENDDO
419 ENDIF
420c
421c--- Coefficient Visco => DN should be defined in starter already
422c
423 IF (impl_s == 1) THEN
424 dn = zero
425 ELSE
426 dn = geo(13,pid(1))
427 IF(dn == zero ) THEN
428 IF (ihbe == 11)THEN
429 dn = em3
430 ELSEIF(ihbe == 30)THEN
431 dn = em4
432 ENDIF
433 ENDIF
434 ENDIF
435 amu(jft:jlt) = dn
436 z0 = geo(199,pid(1))
437 zoffset(jft:jlt) = zero
438 SELECT CASE(igtyp)
439 CASE (1,9,10,11,16)
440 DO i=jft,jlt
441 zoffset(i) = z0
442 ENDDO
443 CASE (17,51,52)
444 ipos = igeo(99,pid(1))
445 IF(ipos == 2) THEN
446 DO i=jft,jlt
447 zoffset(i) = z0 - half*thk0(i)
448 ENDDO
449 ELSEIF (ipos== 3 .OR. ipos == 4) THEN
450 DO i=jft,jlt
451 z0= half*thk0(i)
452 zoffset(i) = z0
453 ENDDO
454 ENDIF
455 CASE DEFAULT
456 zoffset(jft:jlt) = zero
457 END SELECT
458c-----------
459 RETURN

◆ cncoef3b()

subroutine cncoef3b ( integer jft,
integer jlt,
pm,
integer, dimension(*) mat,
geo,
integer, dimension(*) pid,
area,
shf,
thk0,
thk02,
nu,
g,
ym,
a11,
a12,
thk,
thke,
ssp,
rho,
volg,
gs,
integer mtn,
integer ithk,
integer npt,
dt1c,
dt1,
integer ihbe,
amu,
gsr,
a11sr,
a12sr,
nusr,
shfsr,
krz,
integer, dimension(npropgi,*) igeo,
a11r,
integer isubstack,
pm_stack,
uparam,
dira,
dirb,
uvar,
fac58,
integer, intent(in) nel,
dimension(nel) zoffset )

Definition at line 29 of file cncoef3.F.

39C-----------------------------------------------
40C I m p l i c i t T y p e s
41C-----------------------------------------------
42#include "implicit_f.inc"
43C-----------------------------------------------
44C G l o b a l P a r a m e t e r s
45C-----------------------------------------------
46#include "mvsiz_p.inc"
47C-----------------------------------------------
48C C o m m o n B l o c k s
49C-----------------------------------------------
50#include "param_c.inc"
51#include "impl1_c.inc"
52#include "impl2_c.inc"
53C-----------------------------------------------
54C D u m m y A r g u m e n t s
55C-----------------------------------------------
56 INTEGER JFT, JLT,MTN,ITHK,NPT,IHBE,ISUBSTACK
57 INTEGER , INTENT(IN) :: NEL
58 INTEGER MAT(*), PID(*), IGEO(NPROPGI,*)
59 my_real
60 . geo(npropg,*), pm(npropm,*), area(*),
61 . shf(*),thk0(*),thk02(*),thk(*),thke(*),
62 . nu(*),g(*),ym(*),a11(*),a12(*),amu(*),
63 . volg(*),ssp(*),rho(*),gs(*),dt1c(*),dt1,
64 . gsr(*), a11sr(*), a12sr(*), nusr(*), shfsr(*),krz(*),
65 . a11r(*),pm_stack(20,*),uparam(*),
66 . dira(jlt,*),dirb(jlt,*),uvar(jlt,*),fac58(mvsiz,2)
67 my_real , INTENT(OUT) , DIMENSION(NEL):: zoffset
68C-----------------------------------------------
69C L o c a l V a r i a b l e s
70C-----------------------------------------------
71 INTEGER I,J,ISH,MX,IPID,IGTYP,IPGMAT,IGMAT,IPOS
72 my_real fsh,viscdef,fac1tmp,kfac,dn,k58(3),
73 . rfac,rfat,r1,r2,r3,s1,s2,s3,t1,t2,t3,rs1,rs2,rs3,
74 . r12,s12,r22,s22,r3r3,s3s3,e11,e22,emin,k58i, z0
75C-----------------------------------------------
76 IF(ithk>0.AND.ismdisp==0)THEN
77 DO i=jft,jlt
78 thk0(i)=max(em20,thk(i))
79 ENDDO
80 ELSE
81 DO i=jft,jlt
82 thk0(i)=thke(i)
83 ENDDO
84 ENDIF
85C------explicit KFAC=1.0e-3 for quad 1.0e-2 for T3(could be 1.0e-2 for all)--
86C------implicit KFAC=0.1 for all----
87 IF(impl_s>0)THEN
88 kfac= em01*min(one,kz_tol*2000)
89 ELSE
90 kfac= em03
91 ENDIF
92C
93 igtyp = igeo(11,pid(1))
94 igmat = igeo(98,pid(1))
95 ipgmat = 700
96 IF(igtyp == 11 .AND. igmat > 0) THEN
97 DO i=jft,jlt
98 thk02(i) = thk0(i)*thk0(i)
99 volg(i) = thk0(i)*area(i)
100 dt1c(i) = dt1
101 ipid=pid(i)
102 mx = pid(i)
103 rho(i) = geo(ipgmat +1 ,mx)
104 ym(i) = geo(ipgmat +2 ,mx)
105 nu(i) = geo(ipgmat +3 ,mx)
106 g(i) = geo(ipgmat +4 ,mx)
107 a11(i) = geo(ipgmat +5 ,mx)
108 a12(i) = geo(ipgmat +6 ,mx)
109 a11r(i)= geo(ipgmat +7 ,mx)
110 ssp(i) = geo(ipgmat +9 ,mx)
111 gsr(i) =geo(ipgmat +10 ,mx)
112 a11sr(i)=geo(ipgmat +11 ,mx)
113 a12sr(i)=geo(ipgmat +12 ,mx)
114 nusr(i) =geo(ipgmat +13 ,mx)
115 krz(i) =kfac*g(i)
116!! IZ(I) = GEO(198,PID(I)) ! ---> sum(ti*(ti/2 + zi**2)
117 ENDDO
118 ELSEIF(igtyp == 52 .OR.
119 . ((igtyp == 17 .OR. igtyp == 51) .AND. igmat > 0 )) THEN
120 DO i=jft,jlt
121 thk02(i) = thk0(i)*thk0(i)
122 volg(i) = thk0(i)*area(i)
123 dt1c(i) = dt1
124 ipid=pid(i)
125 rho(i) = pm_stack(1 ,isubstack)
126 ym(i) = pm_stack(2 ,isubstack)
127 nu(i) = pm_stack(3 ,isubstack)
128 g(i) = pm_stack(4 ,isubstack)
129 a11(i) = pm_stack(5 ,isubstack)
130 a12(i) = pm_stack(6 ,isubstack)
131 a11r(i)= pm_stack(7 ,isubstack)
132 ssp(i) = pm_stack(9 ,isubstack)
133 gsr(i) =pm_stack(10 ,isubstack)
134 a11sr(i)=pm_stack(11 ,isubstack)
135 a12sr(i)=pm_stack(12 ,isubstack)
136 nusr(i) =pm_stack(13 ,isubstack)
137 krz(i) =kfac*g(i)
138 ENDDO
139 ELSEIF(mtn == 58 .or. mtn == 158) THEN
140 mx =mat(jft)
141C---- due to too high young update (Starter) w/ input func
142 fac1tmp = pm(23,mx)/pm(20,mx)
143 k58(1) = uparam( 9) ! young dir1
144 k58(2) = uparam(10) ! young dir2
145 k58(3) = max(uparam(13),uparam(14))
146 k58i = em02
147 IF (fac1tmp <one) k58i = half*k58i
148 fac58(jft:jlt,1:2) = k58i
149 IF(npt==1) THEN
150 DO i=jft,jlt
151 r1 = dira(i,1)
152 s1 = dira(i,2)
153 r2 = dirb(i,1)
154 s2 = dirb(i,2)
155 rs1= r1*s1
156 rs2= r2*s2
157 r12= r1*r1
158 r22= r2*r2
159 s12= s1*s1
160 s22= s2*s2
161 t1 = k58(1)
162 t2 = k58(2)
163 t3 = k58(3)
164 e11 = r12*t1 + r22*t2
165 e22 = s12*t1 + s22*t2
166 ym(i) = max(e11,e22)
167 g(i) = half*fac1tmp*ym(i)
168 nu(i) = zero
169 nusr(i) =em01
170C---- for dt compute -> will be updated by cndt in case of dtnoda
171 a11(i) = ym(i)
172 a12(i) = nu(i)*a11(i)
173 rfac = exp(uvar(i,4))
174 rfat = exp(uvar(i,5))
175C---- FAC58(I,1:2) could be different values, but too complicated
176 IF (uvar(i,11)/=zero.AND.uvar(i,12)/=zero) THEN
177 fac58(i,1:2) = em01*k58i
178 ELSEIF (min(rfac,rfat)>one) THEN
179 fac58(i,1:2) = 1.2*k58i
180 END IF
181 ENDDO
182 ELSE
183 DO i=jft,jlt
184 e11 = k58(1)
185 e22 = k58(2)
186 ym(i) = max(e11,e22)
187 g(i) = half*ym(i)
188 nu(i) = zero
189 nusr(i) =em01
190C---- for dt compute
191 a11(i) = ym(i)
192 a12(i) = nu(i)*a11(i)
193 ENDDO
194 END IF
195 mx =mat(jft)
196 DO i=jft,jlt
197 thk02(i) = thk0(i)*thk0(i)
198 volg(i) = thk0(i)*area(i)
199 dt1c(i) = dt1
200 rho(i)=pm(1,mx)
201 krz(i) =kfac*g(i)
202 gsr(i) =sqrt(g(i))
203C----- used in mem damping
204 rfac = max(fac58(i,1),fac58(i,2))
205 a11sr(i)=sqrt(rfac*ym(i))
206 a12sr(i)=nusr(i)*a11sr(i)
207 ENDDO
208
209 ELSE
210 mx =mat(jft)
211 DO i=jft,jlt
212 thk02(i) = thk0(i)*thk0(i)
213 volg(i) = thk0(i)*area(i)
214 dt1c(i) = dt1
215 rho(i)=pm(1,mx)
216 ipid=pid(i)
217 ym(i) =pm(20,mx)
218 nu(i) =pm(21,mx)
219 g(i) =pm(22,mx)
220 a11(i) =pm(24,mx)
221 a12(i) =pm(25,mx)
222 ssp(i) =pm(27,mx)
223 gsr(i) =pm(12,mx)
224 a11sr(i)=pm(13,mx)
225 a12sr(i)=pm(14,mx)
226 nusr(i) =pm(190,mx)
227 krz(i) =kfac*g(i)
228 ENDDO
229 ENDIF
230 IF(npt==1) THEN
231 DO i=jft,jlt
232 shf(i)=zero
233 shfsr(i)=zero
234 ENDDO
235 ELSE
236 DO i=jft,jlt
237 shf(i)=geo(38,pid(i))
238 shfsr(i)=geo(100,pid(i))
239 ENDDO
240 ENDIF
241 DO i=jft,jlt
242 gs(i)=g(i)*shf(i)
243 ENDDO
244 IF (mtn == 58 .or. mtn == 158) THEN
245 CONTINUE
246 ELSEIF(mtn>=24)THEN
247 DO i=jft,jlt
248 a12(i) =nu(i)*a11(i)
249 a12sr(i)=nusr(i)*a11sr(i)
250 ENDDO
251 ENDIF
252c
253c--- Coefficient Visco
254c
255 IF (impl_s == 1) THEN
256 dn = zero
257 ELSE
258 dn = geo(13,pid(1))
259 IF(dn == zero) dn = zep01 + fiveem3 ! 0.015 default value
260 ENDIF
261 amu(jft:jlt) = dn
262 z0 = geo(199,pid(1))
263 zoffset(jft:jlt) = zero
264 SELECT CASE(igtyp)
265 CASE (1,9,10,11,16)
266 DO i=jft,jlt
267 zoffset(i) = z0
268 ENDDO
269 CASE (17,51,52)
270 ipos = igeo(99,pid(1))
271 IF(ipos == 2) THEN
272 DO i=jft,jlt
273 zoffset(i) = z0 - half*thk0(i)
274 ENDDO
275 ELSEIF (ipos== 3 .OR. ipos == 4) THEN
276 DO i=jft,jlt
277 z0= half*thk0(i)
278 zoffset(i) = z0
279 ENDDO
280 ENDIF
281 CASE DEFAULT
282 zoffset(jft:jlt) = zero
283 END SELECT
284c-----------
285 RETURN
max
#define max(a, b)
Definition macros.h:21

◆ cncoefort()

subroutine cncoefort ( integer jft,
integer jlt,
pm,
integer, dimension(*) mat,
geo,
integer, dimension(*) pid,
integer mtn,
integer npt,
hm,
hf,
hc,
hmfor,
integer iorth,
dir,
integer, dimension(npropgi,*) igeo,
integer isubstack,
type (stack_ply) stack,
type(elbuf_struct_) elbuf_str,
integer nlay,
thk,
type (drape_), dimension(numel_drape) drape,
integer nft,
integer nel,
integer, dimension(sedrape) indx_drape,
intent(in) thke,
integer, intent(in) sedrape,
integer, intent(in) numel_drape,
type (mat_elem_), intent(in) mat_elem )

Definition at line 516 of file cncoef3.F.

522C-----------------------------------------------
523C M o d u l e s
524C-----------------------------------------------
525 USE elbufdef_mod
526 USE stack_mod
527 USE drape_mod
528 USE mat_elem_mod
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 "param_c.inc"
541C-----------------------------------------------
542C D u m m y A r g u m e n t s
543C-----------------------------------------------
544 INTEGER JFT, JLT ,MTN , NPT,IORTH,NLAY,NEL,NFT
545 INTEGER , INTENT(IN) :: SEDRAPE,NUMEL_DRAPE
546 INTEGER MAT(*), PID(*) ,IGEO(NPROPGI,*)
547 INTEGER, DIMENSION(SEDRAPE) :: INDX_DRAPE
548C REAL
549 my_real
550 . geo(npropg,*), pm(npropm,*), dir(*),
551 . hm(mvsiz,6),hf(mvsiz,6),hc(mvsiz,2),hmfor(mvsiz,6),thk(*)
552 my_real, DIMENSION(NEL), INTENT(IN) :: thke
553 TYPE (STACK_PLY) :: STACK
554 TYPE(ELBUF_STRUCT_) :: ELBUF_STR
555 TYPE (DRAPE_) :: DRAPE(NUMEL_DRAPE)
556 TYPE (MAT_ELEM_) ,INTENT(IN) :: MAT_ELEM
557C-----------------------------------------------
558c FUNCTION: stiffness modulus matrix build For hourglass stress compute
559c
560c Note:
561c ARGUMENTS: (I: input, O: output, IO: input * output, W: workspace)
562c
563c TYPE NAME FUNCTION
564c I JFT,JLT - element id limit
565c I PM(NPROPM,MID) - input Material data
566c I MAT(NEL) ,MTN - Material id :Mid and Material type id
567c I GEO(NPROPG,PID) - input geometrical property data
568c I IGEO(NPROPGI,PID) - input geometrical property data (integer)
569c I PID(NEL) - Pid
570c I IGTYP,IORTH - Geo. property type
571c I NPT - num. integrating point in thickness
572c I DIR - orthotropic directions
573c O IORTH - flag for orthopic material (full matrix)
574c O HM(NEL,6) - membrane stiffness modulus (plane stress)
575c HM(1:D11,2:D22,3:D12,4:G 5:D13,6:D23);
576c O HF(NEL,6) - bending stiffness modulus (plane stress) same than HM
577c -HF=integration(t^2*HM) explicitly of thickness
578c O HC(NEL,2) - transverse shear modulus HC(1:G23,2:G13)
579c O HMFOR(NEL,6) - suppermentary membrane-bending coupling modulus for orthotropic
580C-----------------------------------------------
581C L o c a l V a r i a b l e s
582C-----------------------------------------------
583 INTEGER I,MX,IPID,J,J1,J2,J3,JJ,L,IGTYP,
584 . ISUBSTACK,IGMAT,IPOS,IPT_ALL,ILAY,IPT,IT,NPTT,
585 . LAYNPT_MAX, NLAY_MAX,ILAW_PLY
586 INTEGER MAT_IPLY(MVSIZ,NPT)
587 INTEGER, DIMENSION(:) , ALLOCATABLE :: MATLY !!
588 my_real, DIMENSION(:) , ALLOCATABLE :: thkly !!
589 my_real, DIMENSION(:,:) , ALLOCATABLE :: posly,thk_ly
590 my_real
591 . wmc,facg,coef,wm,a11,e11,nu,a12,g
592 my_real
593 . hmor(mvsiz,2),hmly(mvsiz,4),hcly(mvsiz,2),
594 . hmorly(mvsiz,2),shf(mvsiz),izz(mvsiz),iz(mvsiz)
595C--------IORTH=2 -> HMFOR couplage non-null----------------
596 igtyp = igeo(11,pid(1))
597 igmat = igeo(98,pid(1))
598 ipos = igeo(99,pid(1))
599 iorth = 0
600 ! Npt_max
601 laynpt_max = 1
602 IF(igtyp == 51 .OR. igtyp == 52) THEN
603 DO ilay=1,nlay
604 laynpt_max = max(laynpt_max , elbuf_str%BUFLY(ilay)%NPTT)
605 ENDDO
606 ENDIF
607 nlay_max = max(nlay,npt, elbuf_str%NLAY)
608 ALLOCATE(matly(mvsiz*nlay_max), thkly(mvsiz*nlay_max*laynpt_max),
609 . posly(mvsiz,nlay_max*laynpt_max),thk_ly(nel,nlay_max*laynpt_max))
610 IF (igtyp == 11 .OR. igtyp == 17 ) THEN
611 CALL layini(elbuf_str,jft ,jlt ,geo ,igeo ,
612 . mat ,pid ,thkly ,matly ,posly ,
613 . igtyp ,0 ,0 ,nlay ,npt ,
614 . isubstack,stack ,drape ,nft ,thke ,
615 . jlt ,thk_ly ,indx_drape, sedrape,numel_drape)
616 DO j=1,npt
617 j2=1+(j-1)*jlt
618 mx = matly(j2)
619 ilaw_ply = mat_elem%MAT_PARAM(mx)%ILAW
620 IF(ilaw_ply == 15. or. ilaw_ply == 25) THEN
621 iorth = 1
622 EXIT
623 ENDIF
624 ENDDO
625 ELSEIF( igtyp == 51 .OR. igtyp == 52) THEN
626 CALL layini(elbuf_str,jft ,jlt ,geo ,igeo ,
627 . mat ,pid ,thkly ,matly ,posly ,
628 . igtyp ,0 ,0 ,nlay ,npt ,
629 . isubstack,stack ,drape ,nft ,thke ,
630 . jlt ,thk_ly ,indx_drape, sedrape,numel_drape)
631 DO ilay=1,nlay
632 j1 = 1+(ilay-1)*jlt ! JMLY
633 mx = matly(j1)
634 ilaw_ply = mat_elem%MAT_PARAM(mx)%ILAW
635 IF(ilaw_ply == 15 .OR. ilaw_ply == 25 ) THEN
636 iorth = 1
637 EXIT
638 ENDIF
639 ENDDO
640 ELSEIF(mtn == 19 .OR. mtn == 15 .OR. mtn == 25 .OR. mtn == 119) THEN
641 iorth=1
642 ELSE
643 iorth=0
644 ENDIF
645C----------unify the factor ONE_OVER_12 after
646 IF (iorth == 1) THEN
647 hmfor(jft:jlt,1:6)=zero
648 IF (npt == 1) THEN
649 DO i=jft,jlt
650 shf(i)=zero
651 ENDDO
652 ELSE
653 DO i=jft,jlt
654 shf(i)=geo(38,pid(i))
655 ENDDO
656 ENDIF
657 IF ((mtn == 19).OR.(mtn == 119)) THEN
658 CALL gepm_lc(jft,jlt,mat,pm,shf,hmly,hc)
659 CALL cctoglob(jft,jlt,hmly,hc,hmor,dir,nel)
660 DO i=jft,jlt
661 hm(i,1)=hmly(i,1)
662 hm(i,2)=hmly(i,2)
663 hm(i,3)=hmly(i,3)
664 hm(i,4)=hmly(i,4)
665 hm(i,5)=hmor(i,1)
666 hm(i,6)=hmor(i,2)
667 hf(i,1)=one_over_12*hmly(i,1)
668 hf(i,2)=one_over_12*hmly(i,2)
669 hf(i,3)=one_over_12*hmly(i,3)
670 hf(i,4)=one_over_12*hmly(i,4)
671 hf(i,5)=one_over_12*hmor(i,1)
672 hf(i,6)=one_over_12*hmor(i,2)
673 ENDDO
674 ELSEIF ((mtn == 15 .OR. mtn == 25 ) .AND.
675 . igtyp == 9 .OR. igtyp == 10 ) THEN
676 SELECT CASE (igtyp)
677 CASE(9)
678 CALL gepm_lc(jft,jlt,mat,pm,shf,hm,hc)
679 CALL cctoglob(jft,jlt,hm,hc,hmor,dir,nel)
680 DO i=jft,jlt
681 hm(i,5)=hmor(i,1)
682 hm(i,6)=hmor(i,2)
683 hf(i,1)=one_over_12*hm(i,1)
684 hf(i,2)=one_over_12*hm(i,2)
685 hf(i,3)=one_over_12*hm(i,3)
686 hf(i,4)=one_over_12*hm(i,4)
687 hf(i,5)=one_over_12*hmor(i,1)
688 hf(i,6)=one_over_12*hmor(i,2)
689 ENDDO
690 CASE(10)
691 CALL layini(elbuf_str,jft ,jlt ,geo ,igeo ,
692 . mat ,pid ,thkly ,matly ,posly ,
693 . igtyp ,0 ,0 ,nlay ,npt ,
694 . isubstack,stack ,drape ,nft ,thke ,
695 . jlt ,thk_ly ,indx_drape, sedrape,numel_drape)
696 hm(jft:jlt,1:6)=zero
697 hf(jft:jlt,1:6)=zero
698 hc(jft:jlt,1:2)=zero
699 DO j=1,npt
700 j2=1+(j-1)*jlt
701 j3=1+(j-1)*jlt*2
702 CALL gepm_lc(jft,jlt,matly(j2),pm,shf,hmly,hcly)
703 CALL cctoglob(jft,jlt,hmly,hcly,hmorly,dir(j3),nel)
704 DO i=jft,jlt
705 jj = j2 - 1 + i
706 wmc=posly(i,j)*posly(i,j)*thkly(jj)
707 hm(i,1)=hm(i,1)+thkly(jj)*hmly(i,1)
708 hm(i,2)=hm(i,2)+thkly(jj)*hmly(i,2)
709 hm(i,3)=hm(i,3)+thkly(jj)*hmly(i,3)
710 hm(i,4)=hm(i,4)+thkly(jj)*hmly(i,4)
711 hc(i,1)=hc(i,1)+thkly(jj)*hcly(i,1)
712 hc(i,2)=hc(i,2)+thkly(jj)*hcly(i,2)
713 hm(i,5)=hm(i,5)+thkly(jj)*hmorly(i,1)
714 hm(i,6)=hm(i,6)+thkly(jj)*hmorly(i,2)
715 hf(i,1)=hf(i,1)+wmc*hmly(i,1)
716 hf(i,2)=hf(i,2)+wmc*hmly(i,2)
717 hf(i,3)=hf(i,3)+wmc*hmly(i,3)
718 hf(i,4)=hf(i,4)+wmc*hmly(i,4)
719 hf(i,5)=hf(i,5)+wmc*hmorly(i,1)
720 hf(i,6)=hf(i,6)+wmc*hmorly(i,2)
721 ENDDO
722 ENDDO
723 END SELECT ! IGTYP = 9, 10, 16
724 ELSEIF(igtyp == 11 .OR. igtyp == 17 .OR. igtyp == 51 .OR. igtyp == 52) THEN
725 hm(jft:jlt,1:6)=zero
726 hf(jft:jlt,1:6)=zero
727 hc(jft:jlt,1:2)=zero
728 iorth=2
729 IF ((igtyp == 11 .OR. igtyp == 17).AND. igmat > 0) THEN
730 DO i=jft,jlt
731 izz(i) = zero
732 iz(i) = zero
733 ENDDO
734C
735 DO j=1,npt
736 j2=1+(j-1)*jlt
737 j3=1+(j-1)*jlt*2
738 mx = matly(j2)
739 ilaw_ply = mat_elem%MAT_PARAM(mx)%ILAW
740 IF(ilaw_ply == 15 .OR. ilaw_ply == 25 ) THEN
741 CALL gepm_lc(jft,jlt,matly(j2),pm,shf,hmly,hcly)
742 ELSE
743 nu =pm(21,mx)
744 !! E =PM(21,MX)
745 g =pm(22,mx)
746 a11 =pm(24,mx) ! E/(one - nu*nu)
747 a12 = nu*a11
748 DO i=jft,jlt
749 hmly(i,1)=a11
750 hmly(i,2)=a11
751 hmly(i,3)=a12
752 hmly(i,4)=g
753 hcly(i,1)=g*shf(i)
754 hcly(i,2)=g*shf(i)
755 ENDDO
756 ENDIF
757 CALL cctoglob(jft,jlt,hmly,hcly,hmorly,dir(j3),nel)
758 DO i=jft,jlt
759 jj = j2 - 1 + i
760 wm = posly(i,j)*thkly(jj)
761 wmc= posly(i,j)*wm + one_over_12*thkly(jj)**3
762 hm(i,1)=hm(i,1)+thkly(jj)*hmly(i,1)
763 hm(i,2)=hm(i,2)+thkly(jj)*hmly(i,2)
764 hm(i,3)=hm(i,3)+thkly(jj)*hmly(i,3)
765 hm(i,4)=hm(i,4)+thkly(jj)*hmly(i,4)
766 hc(i,1)=hc(i,1)+thkly(jj)*hcly(i,1)
767 hc(i,2)=hc(i,2)+thkly(jj)*hcly(i,2)
768 hm(i,5)=hm(i,5)+thkly(jj)*hmorly(i,1)
769 hm(i,6)=hm(i,6)+thkly(jj)*hmorly(i,2)
770 izz(i) = izz(i) + wmc
771 iz(i) = iz(i) + wm
772C
773 hf(i,1)=hf(i,1)+wmc*hmly(i,1)
774 hf(i,2)=hf(i,2)+wmc*hmly(i,2)
775 hf(i,3)=hf(i,3)+wmc*hmly(i,3)
776 hf(i,4)=hf(i,4)+wmc*hmly(i,4)
777 hf(i,5)=hf(i,5)+wmc*hmorly(i,1)
778 hf(i,6)=hf(i,6)+wmc*hmorly(i,2)
779C-----------
780 hmfor(i,1)=hmfor(i,1)+wm*hmly(i,1)
781 hmfor(i,2)=hmfor(i,2)+wm*hmly(i,2)
782 hmfor(i,3)=hmfor(i,3)+wm*hmly(i,3)
783 hmfor(i,4)=hmfor(i,4)+wm*hmly(i,4)
784 hmfor(i,5)=hmfor(i,5)+wm*hmorly(i,1)
785 hmfor(i,6)=hmfor(i,6)+wm*hmorly(i,2)
786 ENDDO
787 ENDDO
788C----------HM is calculated as mean value not need be modified when IPOS >0 (HF supposed the same)
789 ELSEIF(igtyp == 11 .OR. igtyp == 17) THEN
790C
791 DO j=1,npt
792 j2=1+(j-1)*jlt
793 j3=1+(j-1)*jlt*2
794 mx = matly(j2)
795 ilaw_ply = mat_elem%MAT_PARAM(mx)%ILAW
796 IF(ilaw_ply == 15 .OR. ilaw_ply == 25 ) THEN
797 CALL gepm_lc(jft,jlt,matly(j2),pm,shf,hmly,hcly)
798 ELSE
799 nu =pm(21,mx)
800 !! E =PM(21,MX)
801 g =pm(22,mx)
802 a11 =pm(24,mx) ! E/(one - nu*nu)
803 a12 = nu*a11
804 DO i=jft,jlt
805 hmly(i,1)=a11
806 hmly(i,2)=a11
807 hmly(i,3)=a12
808 hmly(i,4)=g
809 hcly(i,1)=g*shf(i)
810 hcly(i,2)=g*shf(i)
811 ENDDO
812 ENDIF
813 CALL cctoglob(jft,jlt,hmly,hcly,hmorly,dir(j3),nel)
814 DO i=jft,jlt
815 jj = j2 - 1 + i
816 wm = posly(i,j)*thkly(jj)
817 wmc= posly(i,j)*wm + one_over_12*thkly(jj)**3
818 hm(i,1)=hm(i,1)+thkly(jj)*hmly(i,1)
819 hm(i,2)=hm(i,2)+thkly(jj)*hmly(i,2)
820 hm(i,3)=hm(i,3)+thkly(jj)*hmly(i,3)
821 hm(i,4)=hm(i,4)+thkly(jj)*hmly(i,4)
822 hc(i,1)=hc(i,1)+thkly(jj)*hcly(i,1)
823 hc(i,2)=hc(i,2)+thkly(jj)*hcly(i,2)
824 hm(i,5)=hm(i,5)+thkly(jj)*hmorly(i,1)
825 hm(i,6)=hm(i,6)+thkly(jj)*hmorly(i,2)
826C
827 hf(i,1)=hf(i,1)+wmc*hmly(i,1)
828 hf(i,2)=hf(i,2)+wmc*hmly(i,2)
829 hf(i,3)=hf(i,3)+wmc*hmly(i,3)
830 hf(i,4)=hf(i,4)+wmc*hmly(i,4)
831 hf(i,5)=hf(i,5)+wmc*hmorly(i,1)
832 hf(i,6)=hf(i,6)+wmc*hmorly(i,2)
833C-----------
834 hmfor(i,1)=hmfor(i,1)+wm*hmly(i,1)
835 hmfor(i,2)=hmfor(i,2)+wm*hmly(i,2)
836 hmfor(i,3)=hmfor(i,3)+wm*hmly(i,3)
837 hmfor(i,4)=hmfor(i,4)+wm*hmly(i,4)
838 hmfor(i,5)=hmfor(i,5)+wm*hmorly(i,1)
839 hmfor(i,6)=hmfor(i,6)+wm*hmorly(i,2)
840 ENDDO
841 ENDDO
842C
843 ELSEIF(igtyp == 52 .OR. (igtyp == 51 .AND. igmat > 0)) THEN
844
845 ipt_all = 0
846 DO i=jft,jlt
847 izz(i) = zero
848 iz(i) = zero
849 ENDDO
850 DO ilay=1,nlay
851 nptt = elbuf_str%BUFLY(ilay)%NPTT
852 DO it=1,nptt
853 ipt = ipt_all + it
854 j1 = 1+(ilay-1)*jlt ! JMLY
855 j2 = 1+(ipt-1)*jlt ! THKLY
856 j3 = 1+(ilay-1)*jlt*2 ! JDIR
857 j = ipt ! JPOS
858 mx = matly(j1)
859 ilaw_ply = mat_elem%MAT_PARAM(mx)%ILAW
860 IF(ilaw_ply == 15 .OR. ilaw_ply == 25 ) THEN
861 CALL gepm_lc(jft,jlt,matly(j1),pm,shf,hmly,hcly)
862 ELSE
863 nu =pm(21,mx)
864 !! E =PM(21,MX)
865 g =pm(22,mx)
866 a11 =pm(24,mx) ! E/(one - nu*nu)
867 a12 = nu*a11
868 DO i=jft,jlt
869 hmly(i,1)=a11
870 hmly(i,2)=a11
871 hmly(i,3)=a12
872 hmly(i,4)=g
873 hcly(i,1)=g*shf(i)
874 hcly(i,2)=g*shf(i)
875 ENDDO
876 ENDIF
877 CALL cctoglob(jft,jlt,hmly,hcly,hmorly,dir(j3),nel)
878C
879 DO i=jft,jlt
880 jj = j2 - 1 + i
881 wm = posly(i,j)*thkly(jj)
882 wmc= posly(i,j)*wm
883 hm(i,1)=hm(i,1)+thkly(jj)*hmly(i,1)
884 hm(i,2)=hm(i,2)+thkly(jj)*hmly(i,2)
885 hm(i,3)=hm(i,3)+thkly(jj)*hmly(i,3)
886 hm(i,4)=hm(i,4)+thkly(jj)*hmly(i,4)
887 hc(i,1)=hc(i,1)+thkly(jj)*hcly(i,1)
888 hc(i,2)=hc(i,2)+thkly(jj)*hcly(i,2)
889 hm(i,5)=hm(i,5)+thkly(jj)*hmorly(i,1)
890 hm(i,6)=hm(i,6)+thkly(jj)*hmorly(i,2)
891C
892 hf(i,1)=hf(i,1)+wmc*hmly(i,1)
893 hf(i,2)=hf(i,2)+wmc*hmly(i,2)
894 hf(i,3)=hf(i,3)+wmc*hmly(i,3)
895 hf(i,4)=hf(i,4)+wmc*hmly(i,4)
896 hf(i,5)=hf(i,5)+wmc*hmorly(i,1)
897 hf(i,6)=hf(i,6)+wmc*hmorly(i,2)
898C-----------
899 hmfor(i,1)=hmfor(i,1)+wm*hmly(i,1)
900 hmfor(i,2)=hmfor(i,2)+wm*hmly(i,2)
901 hmfor(i,3)=hmfor(i,3)+wm*hmly(i,3)
902 hmfor(i,4)=hmfor(i,4)+wm*hmly(i,4)
903 hmfor(i,5)=hmfor(i,5)+wm*hmorly(i,1)
904 hmfor(i,6)=hmfor(i,6)+wm*hmorly(i,2)
905 izz(i) = izz(i) + wmc
906 iz(i) = iz(i) + wm
907 ENDDO
908 ENDDO ! DO J=1,NPTT
909 ipt_all = ipt_all + nptt
910 ENDDO ! DO ILAY=1,NLAY
911 ELSE ! IGTYP== 51
912 ipt_all = 0
913 DO ilay=1,nlay
914 nptt = elbuf_str%BUFLY(ilay)%NPTT
915 DO it=1,nptt
916 ipt = ipt_all + it
917 j1 = 1+(ilay-1)*jlt ! JMLY
918 j2 = 1+(ipt-1)*jlt ! THKY
919 j3 = 1+(ilay-1)*jlt*2 ! JDIR
920 j = ipt ! POS
921 mx = matly(j1)
922 ilaw_ply = mat_elem%MAT_PARAM(mx)%ILAW
923 IF(ilaw_ply == 15 .OR. ilaw_ply == 25 ) THEN
924 CALL gepm_lc(jft,jlt,matly(j1),pm,shf,hmly,hcly)
925 ELSE
926 nu =pm(21,mx)
927 !! E =PM(21,MX)
928 g =pm(22,mx)
929 a11 =pm(24,mx) ! E/(one - nu*nu)
930 a12 = nu*a11
931 DO i=jft,jlt
932 hmly(i,1)=a11
933 hmly(i,2)=a11
934 hmly(i,3)=a12
935 hmly(i,4)=g
936 hcly(i,1)=g*shf(i)
937 hcly(i,2)=g*shf(i)
938 ENDDO
939 ENDIF
940 CALL cctoglob(jft,jlt,hmly,hcly,hmorly,dir(j3),nel)
941C
942 DO i=jft,jlt
943 jj = j2 - 1 + i
944 wm = posly(i,j)*thkly(jj)
945 wmc= posly(i,j)*wm
946 hm(i,1)=hm(i,1)+thkly(jj)*hmly(i,1)
947 hm(i,2)=hm(i,2)+thkly(jj)*hmly(i,2)
948 hm(i,3)=hm(i,3)+thkly(jj)*hmly(i,3)
949 hm(i,4)=hm(i,4)+thkly(jj)*hmly(i,4)
950 hc(i,1)=hc(i,1)+thkly(jj)*hcly(i,1)
951 hc(i,2)=hc(i,2)+thkly(jj)*hcly(i,2)
952 hm(i,5)=hm(i,5)+thkly(jj)*hmorly(i,1)
953 hm(i,6)=hm(i,6)+thkly(jj)*hmorly(i,2)
954C
955 hf(i,1)=hf(i,1)+wmc*hmly(i,1)
956 hf(i,2)=hf(i,2)+wmc*hmly(i,2)
957 hf(i,3)=hf(i,3)+wmc*hmly(i,3)
958 hf(i,4)=hf(i,4)+wmc*hmly(i,4)
959 hf(i,5)=hf(i,5)+wmc*hmorly(i,1)
960 hf(i,6)=hf(i,6)+wmc*hmorly(i,2)
961C-----------
962 hmfor(i,1)=hmfor(i,1)+wm*hmly(i,1)
963 hmfor(i,2)=hmfor(i,2)+wm*hmly(i,2)
964 hmfor(i,3)=hmfor(i,3)+wm*hmly(i,3)
965 hmfor(i,4)=hmfor(i,4)+wm*hmly(i,4)
966 hmfor(i,5)=hmfor(i,5)+wm*hmorly(i,1)
967 hmfor(i,6)=hmfor(i,6)+wm*hmorly(i,2)
968 ENDDO
969 ENDDO ! DO J=1,NPTT
970 ipt_all = ipt_all + nptt
971 ENDDO ! DO ILAY=1,NLAY
972 ENDIF ! igmat + igtyp == 11
973 ENDIF !IF (MTN==19)
974 ENDIF ! IF (IORTH==1) THEN
975 DEALLOCATE(matly, thkly, posly, thk_ly)
976C
977 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
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
drape_mod
Definition drape_mod.F:54
stack_mod
Definition stack_mod.F:72