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
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,MX,IPID,IGTYP,IPGMAT,IGMAT,IPOS
330C REAL
331 my_real 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*thk0(i)
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,MX,IPID,IGTYP,IPGMAT,IGMAT,IPOS
72 my_real fac1tmp,kfac,dn,k58(3),
73 . rfac,rfat,r1,r2,s1,s2,t1,t2,t3,rs1,rs2,
74 . r12,s12,r22,s22,e11,e22,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*thk0(i)
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,J,J1,J2,J3,JJ,IGTYP,
584 . ISUBSTACK,IGMAT,IPOS,IPT_ALL,ILAY,IPT,IT,NPTT,
585 . LAYNPT_MAX, NLAY_MAX,ILAW_PLY
586 INTEGER, DIMENSION(:) , ALLOCATABLE :: MATLY !!
587 my_real, DIMENSION(:) , ALLOCATABLE :: thkly !!
588 my_real, DIMENSION(:,:) , ALLOCATABLE :: posly,thk_ly
589 my_real
590 . wmc,wm,a11,nu,a12,g
591 my_real
592 . hmor(mvsiz,2),hmly(mvsiz,4),hcly(mvsiz,2),
593 . hmorly(mvsiz,2),shf(mvsiz),izz(mvsiz),iz(mvsiz)
594C--------IORTH=2 -> HMFOR couplage non-null----------------
595 igtyp = igeo(11,pid(1))
596 igmat = igeo(98,pid(1))
597 ipos = igeo(99,pid(1))
598 iorth = 0
599 ! Npt_max
600 laynpt_max = 1
601 IF(igtyp == 51 .OR. igtyp == 52) THEN
602 DO ilay=1,nlay
603 laynpt_max = max(laynpt_max , elbuf_str%BUFLY(ilay)%NPTT)
604 ENDDO
605 ENDIF
606 nlay_max = max(nlay,npt, elbuf_str%NLAY)
607 ALLOCATE(matly(mvsiz*nlay_max), thkly(mvsiz*nlay_max*laynpt_max),
608 . posly(mvsiz,nlay_max*laynpt_max),thk_ly(nel,nlay_max*laynpt_max))
609 IF (igtyp == 11 .OR. igtyp == 17 ) THEN
610 CALL layini(elbuf_str,jft ,jlt ,geo ,igeo ,
611 . mat ,pid ,thkly ,matly ,posly ,
612 . igtyp ,0 ,0 ,nlay ,npt ,
613 . isubstack,stack ,drape ,nft ,thke ,
614 . jlt ,thk_ly ,indx_drape, sedrape,numel_drape)
615 DO j=1,npt
616 j2=1+(j-1)*jlt
617 mx = matly(j2)
618 ilaw_ply = mat_elem%MAT_PARAM(mx)%ILAW
619 IF(ilaw_ply == 15. or. ilaw_ply == 25 .or. ilaw_ply == 125 .or. ilaw_ply == 127) THEN
620 iorth = 1
621 EXIT
622 ENDIF
623 ENDDO
624 ELSEIF( igtyp == 51 .OR. igtyp == 52) THEN
625 CALL layini(elbuf_str,jft ,jlt ,geo ,igeo ,
626 . mat ,pid ,thkly ,matly ,posly ,
627 . igtyp ,0 ,0 ,nlay ,npt ,
628 . isubstack,stack ,drape ,nft ,thke ,
629 . jlt ,thk_ly ,indx_drape, sedrape,numel_drape)
630 DO ilay=1,nlay
631 j1 = 1+(ilay-1)*jlt ! JMLY
632 mx = matly(j1)
633 ilaw_ply = mat_elem%MAT_PARAM(mx)%ILAW
634 IF(ilaw_ply == 15. or. ilaw_ply == 25 .or. ilaw_ply == 125 .or. ilaw_ply == 127) THEN
635 iorth = 1
636 EXIT
637 ENDIF
638 ENDDO
639 ELSEIF(mtn == 19 .OR. mtn == 15 .OR. mtn == 25 .OR. mtn == 119 .OR. mtn == 125 .OR. mtn == 127) THEN
640 iorth=1
641 ELSE
642 iorth=0
643 ENDIF
644C----------unify the factor ONE_OVER_12 after
645 IF (iorth == 1) THEN
646 hmfor(jft:jlt,1:6)=zero
647 IF (npt == 1) THEN
648 DO i=jft,jlt
649 shf(i)=zero
650 ENDDO
651 ELSE
652 DO i=jft,jlt
653 shf(i)=geo(38,pid(i))
654 ENDDO
655 ENDIF
656 IF ((mtn == 19).OR.(mtn == 119)) THEN
657 CALL gepm_lc(jft,jlt,mat,pm,shf,hmly,hc)
658 CALL cctoglob(jft,jlt,hmly,hc,hmor,dir,nel)
659 DO i=jft,jlt
660 hm(i,1)=hmly(i,1)
661 hm(i,2)=hmly(i,2)
662 hm(i,3)=hmly(i,3)
663 hm(i,4)=hmly(i,4)
664 hm(i,5)=hmor(i,1)
665 hm(i,6)=hmor(i,2)
666 hf(i,1)=one_over_12*hmly(i,1)
667 hf(i,2)=one_over_12*hmly(i,2)
668 hf(i,3)=one_over_12*hmly(i,3)
669 hf(i,4)=one_over_12*hmly(i,4)
670 hf(i,5)=one_over_12*hmor(i,1)
671 hf(i,6)=one_over_12*hmor(i,2)
672 ENDDO
673 ELSEIF ((mtn == 15 .OR. mtn == 25 .OR. mtn == 125. or. mtn == 127) .AND.
674 . igtyp == 9 .OR. igtyp == 10 ) THEN
675 SELECT CASE (igtyp)
676 CASE(9)
677 CALL gepm_lc(jft,jlt,mat,pm,shf,hm,hc)
678 CALL cctoglob(jft,jlt,hm,hc,hmor,dir,nel)
679 DO i=jft,jlt
680 hm(i,5)=hmor(i,1)
681 hm(i,6)=hmor(i,2)
682 hf(i,1)=one_over_12*hm(i,1)
683 hf(i,2)=one_over_12*hm(i,2)
684 hf(i,3)=one_over_12*hm(i,3)
685 hf(i,4)=one_over_12*hm(i,4)
686 hf(i,5)=one_over_12*hmor(i,1)
687 hf(i,6)=one_over_12*hmor(i,2)
688 ENDDO
689 CASE(10)
690 CALL layini(elbuf_str,jft ,jlt ,geo ,igeo ,
691 . mat ,pid ,thkly ,matly ,posly ,
692 . igtyp ,0 ,0 ,nlay ,npt ,
693 . isubstack,stack ,drape ,nft ,thke ,
694 . jlt ,thk_ly ,indx_drape, sedrape,numel_drape)
695 hm(jft:jlt,1:6)=zero
696 hf(jft:jlt,1:6)=zero
697 hc(jft:jlt,1:2)=zero
698 DO j=1,npt
699 j2=1+(j-1)*jlt
700 j3=1+(j-1)*jlt*2
701 CALL gepm_lc(jft,jlt,matly(j2),pm,shf,hmly,hcly)
702 CALL cctoglob(jft,jlt,hmly,hcly,hmorly,dir(j3),nel)
703 DO i=jft,jlt
704 jj = j2 - 1 + i
705 wmc=posly(i,j)*posly(i,j)*thkly(jj)
706 hm(i,1)=hm(i,1)+thkly(jj)*hmly(i,1)
707 hm(i,2)=hm(i,2)+thkly(jj)*hmly(i,2)
708 hm(i,3)=hm(i,3)+thkly(jj)*hmly(i,3)
709 hm(i,4)=hm(i,4)+thkly(jj)*hmly(i,4)
710 hc(i,1)=hc(i,1)+thkly(jj)*hcly(i,1)
711 hc(i,2)=hc(i,2)+thkly(jj)*hcly(i,2)
712 hm(i,5)=hm(i,5)+thkly(jj)*hmorly(i,1)
713 hm(i,6)=hm(i,6)+thkly(jj)*hmorly(i,2)
714 hf(i,1)=hf(i,1)+wmc*hmly(i,1)
715 hf(i,2)=hf(i,2)+wmc*hmly(i,2)
716 hf(i,3)=hf(i,3)+wmc*hmly(i,3)
717 hf(i,4)=hf(i,4)+wmc*hmly(i,4)
718 hf(i,5)=hf(i,5)+wmc*hmorly(i,1)
719 hf(i,6)=hf(i,6)+wmc*hmorly(i,2)
720 ENDDO
721 ENDDO
722 END SELECT ! IGTYP = 9, 10, 16
723 ELSEIF(igtyp == 11 .OR. igtyp == 17 .OR. igtyp == 51 .OR. igtyp == 52) THEN
724 hm(jft:jlt,1:6)=zero
725 hf(jft:jlt,1:6)=zero
726 hc(jft:jlt,1:2)=zero
727 iorth=2
728 IF ((igtyp == 11 .OR. igtyp == 17).AND. igmat > 0) THEN
729 DO i=jft,jlt
730 izz(i) = zero
731 iz(i) = zero
732 ENDDO
733C
734 DO j=1,npt
735 j2=1+(j-1)*jlt
736 j3=1+(j-1)*jlt*2
737 mx = matly(j2)
738 ilaw_ply = mat_elem%MAT_PARAM(mx)%ILAW
739 IF(ilaw_ply == 15 .OR. ilaw_ply == 25 .OR. ilaw_ply == 125 .or. ilaw_ply == 127 ) THEN
740 CALL gepm_lc(jft,jlt,matly(j2),pm,shf,hmly,hcly)
741 ELSE
742 nu =pm(21,mx)
743 !! E =PM(21,MX)
744 g =pm(22,mx)
745 a11 =pm(24,mx) ! E/(one - nu*nu)
746 a12 = nu*a11
747 DO i=jft,jlt
748 hmly(i,1)=a11
749 hmly(i,2)=a11
750 hmly(i,3)=a12
751 hmly(i,4)=g
752 hcly(i,1)=g*shf(i)
753 hcly(i,2)=g*shf(i)
754 ENDDO
755 ENDIF
756 CALL cctoglob(jft,jlt,hmly,hcly,hmorly,dir(j3),nel)
757 DO i=jft,jlt
758 jj = j2 - 1 + i
759 wm = posly(i,j)*thkly(jj)
760 wmc= posly(i,j)*wm + one_over_12*thkly(jj)**3
761 hm(i,1)=hm(i,1)+thkly(jj)*hmly(i,1)
762 hm(i,2)=hm(i,2)+thkly(jj)*hmly(i,2)
763 hm(i,3)=hm(i,3)+thkly(jj)*hmly(i,3)
764 hm(i,4)=hm(i,4)+thkly(jj)*hmly(i,4)
765 hc(i,1)=hc(i,1)+thkly(jj)*hcly(i,1)
766 hc(i,2)=hc(i,2)+thkly(jj)*hcly(i,2)
767 hm(i,5)=hm(i,5)+thkly(jj)*hmorly(i,1)
768 hm(i,6)=hm(i,6)+thkly(jj)*hmorly(i,2)
769 izz(i) = izz(i) + wmc
770 iz(i) = iz(i) + wm
771C
772 hf(i,1)=hf(i,1)+wmc*hmly(i,1)
773 hf(i,2)=hf(i,2)+wmc*hmly(i,2)
774 hf(i,3)=hf(i,3)+wmc*hmly(i,3)
775 hf(i,4)=hf(i,4)+wmc*hmly(i,4)
776 hf(i,5)=hf(i,5)+wmc*hmorly(i,1)
777 hf(i,6)=hf(i,6)+wmc*hmorly(i,2)
778C-----------
779 hmfor(i,1)=hmfor(i,1)+wm*hmly(i,1)
780 hmfor(i,2)=hmfor(i,2)+wm*hmly(i,2)
781 hmfor(i,3)=hmfor(i,3)+wm*hmly(i,3)
782 hmfor(i,4)=hmfor(i,4)+wm*hmly(i,4)
783 hmfor(i,5)=hmfor(i,5)+wm*hmorly(i,1)
784 hmfor(i,6)=hmfor(i,6)+wm*hmorly(i,2)
785 ENDDO
786 ENDDO
787C----------HM is calculated as mean value not need be modified when IPOS >0 (HF supposed the same)
788 ELSEIF(igtyp == 11 .OR. igtyp == 17) THEN
789C
790 DO j=1,npt
791 j2=1+(j-1)*jlt
792 j3=1+(j-1)*jlt*2
793 mx = matly(j2)
794 ilaw_ply = mat_elem%MAT_PARAM(mx)%ILAW
795 IF(ilaw_ply == 15 .OR. ilaw_ply == 25 .OR. ilaw_ply == 125 .or. ilaw_ply == 127 ) THEN
796 CALL gepm_lc(jft,jlt,matly(j2),pm,shf,hmly,hcly)
797 ELSE
798 nu =pm(21,mx)
799 !! E =PM(21,MX)
800 g =pm(22,mx)
801 a11 =pm(24,mx) ! E/(one - nu*nu)
802 a12 = nu*a11
803 DO i=jft,jlt
804 hmly(i,1)=a11
805 hmly(i,2)=a11
806 hmly(i,3)=a12
807 hmly(i,4)=g
808 hcly(i,1)=g*shf(i)
809 hcly(i,2)=g*shf(i)
810 ENDDO
811 ENDIF
812 CALL cctoglob(jft,jlt,hmly,hcly,hmorly,dir(j3),nel)
813 DO i=jft,jlt
814 jj = j2 - 1 + i
815 wm = posly(i,j)*thkly(jj)
816 wmc= posly(i,j)*wm + one_over_12*thkly(jj)**3
817 hm(i,1)=hm(i,1)+thkly(jj)*hmly(i,1)
818 hm(i,2)=hm(i,2)+thkly(jj)*hmly(i,2)
819 hm(i,3)=hm(i,3)+thkly(jj)*hmly(i,3)
820 hm(i,4)=hm(i,4)+thkly(jj)*hmly(i,4)
821 hc(i,1)=hc(i,1)+thkly(jj)*hcly(i,1)
822 hc(i,2)=hc(i,2)+thkly(jj)*hcly(i,2)
823 hm(i,5)=hm(i,5)+thkly(jj)*hmorly(i,1)
824 hm(i,6)=hm(i,6)+thkly(jj)*hmorly(i,2)
825C
826 hf(i,1)=hf(i,1)+wmc*hmly(i,1)
827 hf(i,2)=hf(i,2)+wmc*hmly(i,2)
828 hf(i,3)=hf(i,3)+wmc*hmly(i,3)
829 hf(i,4)=hf(i,4)+wmc*hmly(i,4)
830 hf(i,5)=hf(i,5)+wmc*hmorly(i,1)
831 hf(i,6)=hf(i,6)+wmc*hmorly(i,2)
832C-----------
833 hmfor(i,1)=hmfor(i,1)+wm*hmly(i,1)
834 hmfor(i,2)=hmfor(i,2)+wm*hmly(i,2)
835 hmfor(i,3)=hmfor(i,3)+wm*hmly(i,3)
836 hmfor(i,4)=hmfor(i,4)+wm*hmly(i,4)
837 hmfor(i,5)=hmfor(i,5)+wm*hmorly(i,1)
838 hmfor(i,6)=hmfor(i,6)+wm*hmorly(i,2)
839 ENDDO
840 ENDDO
841C
842 ELSEIF(igtyp == 52 .OR. (igtyp == 51 .AND. igmat > 0)) THEN
843
844 ipt_all = 0
845 DO i=jft,jlt
846 izz(i) = zero
847 iz(i) = zero
848 ENDDO
849 DO ilay=1,nlay
850 nptt = elbuf_str%BUFLY(ilay)%NPTT
851 DO it=1,nptt
852 ipt = ipt_all + it
853 j1 = 1+(ilay-1)*jlt ! JMLY
854 j2 = 1+(ipt-1)*jlt ! THKLY
855 j3 = 1+(ilay-1)*jlt*2 ! JDIR
856 j = ipt ! JPOS
857 mx = matly(j1)
858 ilaw_ply = mat_elem%MAT_PARAM(mx)%ILAW
859 IF(ilaw_ply == 15 .OR. ilaw_ply == 25 .OR. ilaw_ply == 125 .or. ilaw_ply == 127 ) THEN
860 CALL gepm_lc(jft,jlt,matly(j1),pm,shf,hmly,hcly)
861 ELSE
862 nu =pm(21,mx)
863 !! E =PM(21,MX)
864 g =pm(22,mx)
865 a11 =pm(24,mx) ! E/(one - nu*nu)
866 a12 = nu*a11
867 DO i=jft,jlt
868 hmly(i,1)=a11
869 hmly(i,2)=a11
870 hmly(i,3)=a12
871 hmly(i,4)=g
872 hcly(i,1)=g*shf(i)
873 hcly(i,2)=g*shf(i)
874 ENDDO
875 ENDIF
876 CALL cctoglob(jft,jlt,hmly,hcly,hmorly,dir(j3),nel)
877C
878 DO i=jft,jlt
879 jj = j2 - 1 + i
880 wm = posly(i,j)*thkly(jj)
881 wmc= posly(i,j)*wm
882 hm(i,1)=hm(i,1)+thkly(jj)*hmly(i,1)
883 hm(i,2)=hm(i,2)+thkly(jj)*hmly(i,2)
884 hm(i,3)=hm(i,3)+thkly(jj)*hmly(i,3)
885 hm(i,4)=hm(i,4)+thkly(jj)*hmly(i,4)
886 hc(i,1)=hc(i,1)+thkly(jj)*hcly(i,1)
887 hc(i,2)=hc(i,2)+thkly(jj)*hcly(i,2)
888 hm(i,5)=hm(i,5)+thkly(jj)*hmorly(i,1)
889 hm(i,6)=hm(i,6)+thkly(jj)*hmorly(i,2)
890C
891 hf(i,1)=hf(i,1)+wmc*hmly(i,1)
892 hf(i,2)=hf(i,2)+wmc*hmly(i,2)
893 hf(i,3)=hf(i,3)+wmc*hmly(i,3)
894 hf(i,4)=hf(i,4)+wmc*hmly(i,4)
895 hf(i,5)=hf(i,5)+wmc*hmorly(i,1)
896 hf(i,6)=hf(i,6)+wmc*hmorly(i,2)
897C-----------
898 hmfor(i,1)=hmfor(i,1)+wm*hmly(i,1)
899 hmfor(i,2)=hmfor(i,2)+wm*hmly(i,2)
900 hmfor(i,3)=hmfor(i,3)+wm*hmly(i,3)
901 hmfor(i,4)=hmfor(i,4)+wm*hmly(i,4)
902 hmfor(i,5)=hmfor(i,5)+wm*hmorly(i,1)
903 hmfor(i,6)=hmfor(i,6)+wm*hmorly(i,2)
904 izz(i) = izz(i) + wmc
905 iz(i) = iz(i) + wm
906 ENDDO
907 ENDDO ! DO J=1,NPTT
908 ipt_all = ipt_all + nptt
909 ENDDO ! DO ILAY=1,NLAY
910 ELSE ! IGTYP== 51
911 ipt_all = 0
912 DO ilay=1,nlay
913 nptt = elbuf_str%BUFLY(ilay)%NPTT
914 DO it=1,nptt
915 ipt = ipt_all + it
916 j1 = 1+(ilay-1)*jlt ! JMLY
917 j2 = 1+(ipt-1)*jlt ! THKY
918 j3 = 1+(ilay-1)*jlt*2 ! JDIR
919 j = ipt ! POS
920 mx = matly(j1)
921 ilaw_ply = mat_elem%MAT_PARAM(mx)%ILAW
922 IF(ilaw_ply == 15 .OR. ilaw_ply == 25 .OR. ilaw_ply == 125 .or. ilaw_ply == 127 ) THEN
923 CALL gepm_lc(jft,jlt,matly(j1),pm,shf,hmly,hcly)
924 ELSE
925 nu =pm(21,mx)
926 !! E =PM(21,MX)
927 g =pm(22,mx)
928 a11 =pm(24,mx) ! E/(one - nu*nu)
929 a12 = nu*a11
930 DO i=jft,jlt
931 hmly(i,1)=a11
932 hmly(i,2)=a11
933 hmly(i,3)=a12
934 hmly(i,4)=g
935 hcly(i,1)=g*shf(i)
936 hcly(i,2)=g*shf(i)
937 ENDDO
938 ENDIF
939 CALL cctoglob(jft,jlt,hmly,hcly,hmorly,dir(j3),nel)
940C
941 DO i=jft,jlt
942 jj = j2 - 1 + i
943 wm = posly(i,j)*thkly(jj)
944 wmc= posly(i,j)*wm
945 hm(i,1)=hm(i,1)+thkly(jj)*hmly(i,1)
946 hm(i,2)=hm(i,2)+thkly(jj)*hmly(i,2)
947 hm(i,3)=hm(i,3)+thkly(jj)*hmly(i,3)
948 hm(i,4)=hm(i,4)+thkly(jj)*hmly(i,4)
949 hc(i,1)=hc(i,1)+thkly(jj)*hcly(i,1)
950 hc(i,2)=hc(i,2)+thkly(jj)*hcly(i,2)
951 hm(i,5)=hm(i,5)+thkly(jj)*hmorly(i,1)
952 hm(i,6)=hm(i,6)+thkly(jj)*hmorly(i,2)
953C
954 hf(i,1)=hf(i,1)+wmc*hmly(i,1)
955 hf(i,2)=hf(i,2)+wmc*hmly(i,2)
956 hf(i,3)=hf(i,3)+wmc*hmly(i,3)
957 hf(i,4)=hf(i,4)+wmc*hmly(i,4)
958 hf(i,5)=hf(i,5)+wmc*hmorly(i,1)
959 hf(i,6)=hf(i,6)+wmc*hmorly(i,2)
960C-----------
961 hmfor(i,1)=hmfor(i,1)+wm*hmly(i,1)
962 hmfor(i,2)=hmfor(i,2)+wm*hmly(i,2)
963 hmfor(i,3)=hmfor(i,3)+wm*hmly(i,3)
964 hmfor(i,4)=hmfor(i,4)+wm*hmly(i,4)
965 hmfor(i,5)=hmfor(i,5)+wm*hmorly(i,1)
966 hmfor(i,6)=hmfor(i,6)+wm*hmorly(i,2)
967 ENDDO
968 ENDDO ! DO J=1,NPTT
969 ipt_all = ipt_all + nptt
970 ENDDO ! DO ILAY=1,NLAY
971 ENDIF ! igmat + igtyp == 11
972 ENDIF !IF (MTN==19)
973 ENDIF ! IF (IORTH==1) THEN
974 DEALLOCATE(matly, thkly, posly, thk_ly)
975C
976 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:75