OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
h3d_shell_tensor.F
Go to the documentation of this file.
1Copyright> OpenRadioss
2Copyright> Copyright (C) 1986-2025 Altair Engineering Inc.
3Copyright>
4Copyright> This program is free software: you can redistribute it and/or modify
5Copyright> it under the terms of the GNU Affero General Public License as published by
6Copyright> the Free Software Foundation, either version 3 of the License, or
7Copyright> (at your option) any later version.
8Copyright>
9Copyright> This program is distributed in the hope that it will be useful,
10Copyright> but WITHOUT ANY WARRANTY; without even the implied warranty of
11Copyright> MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12Copyright> GNU Affero General Public License for more details.
13Copyright>
14Copyright> You should have received a copy of the GNU Affero General Public License
15Copyright> along with this program. If not, see <https://www.gnu.org/licenses/>.
16Copyright>
17Copyright>
18Copyright> Commercial Alternative: Altair Radioss Software
19Copyright>
20Copyright> As an alternative to this open-source version, Altair also offers Altair Radioss
21Copyright> software under a commercial license. Contact Altair to discuss further if the
22Copyright> commercial version may interest you: https://www.altair.com/radioss/.
23!||====================================================================
24!|| h3d_shell_tensor ../engine/source/output/h3d/h3d_results/h3d_shell_tensor.F
25!||--- called by ------------------------------------------------------
26!|| genh3d ../engine/source/output/h3d/h3d_results/genh3d.F
27!||--- calls -----------------------------------------------------
28!|| h3d_write_sh_tensor ../engine/source/output/h3d/h3d_results/h3d_write_sh_tensor.F
29!|| h3d_write_sh_tensor_array ../engine/source/output/h3d/h3d_results/h3d_write_sh_tensor_array.F
30!|| layini ../engine/source/elements/shell/coque/layini.F
31!|| roto_tens2d ../engine/source/materials/tools/roto_tens2d.F
32!|| roto_tens2d_aniso ../engine/source/materials/tools/roto_tens2d_aniso.F
33!|| sh3_tstrain ../engine/source/output/h3d/h3d_results/h3d_shell_tensor.F
34!|| sh4_tstrain ../engine/source/output/h3d/h3d_results/h3d_shell_tensor.F
35!|| uroto_tens2d ../engine/source/materials/tools/uroto_tens2d.F
36!|| uroto_tens2d_aniso ../engine/source/materials/tools/uroto_tens2d_aniso.F
37!||--- uses -----------------------------------------------------
38!|| drape_mod ../engine/share/modules/drape_mod.F
39!|| elbufdef_mod ../common_source/modules/mat_elem/elbufdef_mod.F90
40!|| matparam_def_mod ../common_source/modules/mat_elem/matparam_def_mod.F90
41!|| names_and_titles_mod ../common_source/modules/names_and_titles_mod.F
42!|| stack_mod ../engine/share/modules/stack_mod.F
43!||====================================================================
44 SUBROUTINE h3d_shell_tensor(ELBUF_TAB,SHELL_TENSOR,IPARG ,ITENS ,INVERT,NELCUT,
45 2 EL2FA ,NBF ,TENS ,EPSDOT,IADP ,
46 3 NBF_L ,NBPART,IADG ,X ,IXC ,
47 4 IGEO ,IXTG ,IPM ,STACK,ID_ELEM ,ITY_ELEM ,INFO1,
48 5 INFO2 ,IS_WRITTEN_SHELL,IPARTC ,IPARTTG ,LAYER_INPUT ,IPT_INPUT ,
49 6 PLY_INPUT,GAUSS_INPUT,IUVAR_INPUT,H3D_PART, KEYWORD,D ,
50 7 ID ,BUFMAT ,MAT_PARAM,GEO, DRAPE_SH4N, DRAPE_SH3N, DRAPEG)
51C-----------------------------------------------
52C M o d u l e s
53C-----------------------------------------------
54 USE elbufdef_mod
55 USE stack_mod
56 USE matparam_def_mod
57 USE names_and_titles_mod, ONLY: ncharline100
58 USE drape_mod
59C-----------------------------------------------
60C I m p l i c i t T y p e s
61C-----------------------------------------------
62#include "implicit_f.inc"
63C-----------------------------------------------
64C C o m m o n B l o c k s
65C-----------------------------------------------
66#include "mvsiz_p.inc"
67C-----------------------------------------------
68#include "com01_c.inc"
69#include "com04_c.inc"
70#include "param_c.inc"
71#include "tabsiz_c.inc"
72C-----------------------------------------------
73C D u m m y A r g u m e n t s
74C-----------------------------------------------
75 INTEGER IPARG(NPARG,*),ITENS,INVERT(*),IUVAR_INPUT,
76 . EL2FA(*),IXC(NIXC,*), IGEO(NPROPGI,*),
77 . NELCUT,NBF,IADP(*),NBF_L,NBPART,IADG(NSPMD,*),
78 . IXTG(NIXTG,*),IPM(NPROPMI,*),ID_ELEM(*),ITY_ELEM(*),
79 . INFO1,INFO2,IS_WRITTEN_SHELL(*),IPARTC(*),IPARTTG(*),H3D_PART(*),
80 . LAYER_INPUT ,IPT_INPUT,GAUSS_INPUT,PLY_INPUT,ID
81 my_real, INTENT(IN),TARGET :: bufmat(sbufmat)
82 my_real
83 . tens(3,*),epsdot(6,*),x(3,*),shell_tensor(3,*),d(3,*)
84 my_real, INTENT(IN) :: geo(npropg,numgeo)
85 TYPE (ELBUF_STRUCT_), DIMENSION(NGROUP), TARGET :: ELBUF_TAB
86 TYPE (STACK_PLY) :: STACK
87 TYPE (MATPARAM_STRUCT_) ,DIMENSION(NUMMAT) ,INTENT(IN) :: MAT_PARAM
88 CHARACTER(LEN=NCHARLINE100):: KEYWORD
89 TYPE (DRAPE_) , INTENT(IN) :: DRAPE_SH4N(NUMELC_DRAPE), DRAPE_SH3N(NUMELTG_DRAPE)
90 TYPE (DRAPEG_), INTENT(IN) :: DRAPEG
91C-----------------------------------------------
92C L o c a l V a r i a b l e s
93C-----------------------------------------------
94 my_real :: a1,a2,a3,thk,chard,factor
95 my_real :: value(5)
96 INTEGER I,J,K,N,NG,NEL,NFT,ITY,NPT,MPT,IPT,NBFUNCT,NCHARD,MLW,
97 . ILAY,IR,IS,IT,NPTR,NPTS,NPTT,NLAY,NPG,IPLY,IDRAPE,
98 . IPID,NS1,NS2,ISTRE,IADBUF,NUPARAM,IMAT,NNI,N0,
99 . IHBE,IREP,BUF,ISROT,IVISC,IGTYP,ISUBSTACK,
100 . id_ply,ipang,ippos,ipthk,offset,iselect,mat_orth,
101 . ixlay,ixfem,laynpt_max,numel_drape,sedrape,nlay_max,
102 . ipt_all,islice,pts,ipg,lens,mpt0
103 INTEGER NN1,NN2,NN3,NN4,NN5,NN6,NN7,NN8,NN9,NN10,I1
104 INTEGER PID(MVSIZ),MAT(MVSIZ),IOK_PART(MVSIZ),JJ(15)
105 my_real ,DIMENSION(3,MVSIZ) :: STRAIN
106 my_real ,DIMENSION(4*MVSIZ) :: XN,YN,ZN,DXN,DYN,DZN
107 my_real ,DIMENSION(:,:) , ALLOCATABLE :: SIGE,SIGM,EPSM
108
109 TYPE(buf_lay_) ,POINTER :: BUFLY
110 TYPE(g_bufel_) ,POINTER :: GBUF
111 TYPE(l_bufel_) ,POINTER :: LBUF
112 my_real, DIMENSION(:) ,POINTER :: uparam,dir_a,dir_b
113 !
114 INTEGER, DIMENSION(:) , ALLOCATABLE :: MATLY !! MATLY(MVSIZ*LAY_MAX)
115 my_real, DIMENSION(:) , ALLOCATABLE :: thkly !! THKLY(MVSIZ*LAY_MAX*LAYNPT_MAX)
116 my_real, DIMENSION(:,:), ALLOCATABLE :: posly,thk_ly
117C-----------------------------------------------
118 ! material orthotropy defined in MATPARAM data structure
119 ! MATPARAM%ORTHOTROPY
120 ! -> 1 : ISOTROPIC
121 ! -> 2 : IRTHOTROPIC
122 ! -> 3 : ANISOTROPIC
123
124 offset = 0
125 value(1:5) = zero
126 iselect = 1
127 id_ply = 0
128 npg = 1
129
130 nn1 = 1
131 nn2 = nn1
132 nn3 = nn2
133 nn4 = nn3 + numelq
134 nn5 = nn4 + numelc
135 nn6 = nn5 + numeltg
136 nn7 = nn6
137 nn8 = nn7
138 nn9 = nn8
139 nn10= nn9
140C
141 DO i=1,numelc+numeltg
142 is_written_shell(i) = 0
143 ENDDO
144C
145 DO 490 ng=1,ngroup
146C IF(ANIM_K == 0.AND.IPARG(8,NG) == 1)GOTO 490
147 mlw = iparg(1,ng)
148 nel = iparg(2,ng)
149 nft = iparg(3,ng)
150 ity = iparg(5,ng)
151 igtyp = iparg(38,ng)
152 isrot = iparg(41,ng)
153 ixfem = iparg(54,ng)
154 isubstack = iparg(71,ng)
155 idrape = elbuf_tab(ng)%IDRAPE
156 npt = iabs(iparg(6,ng))
157 iok_part(1:nel) = 0
158!
159 DO i=1,15
160 jj(i) = nel*(i-1)
161 ENDDO
162!
163 IF (mlw /= 13) THEN
164C-----------------------------------------------
165C QUAD
166C-----------------------------------------------
167 IF(ity == 2)THEN
168 DO i=1,nel
169 n = i + nft
170 shell_tensor(1,offset+nft+i) = zero
171 shell_tensor(2,offset+nft+i) = zero
172 shell_tensor(3,offset+nft+i) = zero
173 ENDDO
174C-----------------------------------------------
175C COQUES
176C-----------------------------------------------
177 ELSEIF (ity == 3 .OR. ity == 7) THEN
178 gbuf => elbuf_tab(ng)%GBUF
179 nptr = elbuf_tab(ng)%NPTR
180 npts = elbuf_tab(ng)%NPTS
181 nlay = elbuf_tab(ng)%NLAY
182 npg = nptr*npts
183C
184 ihbe = iparg(23,ng)
185 IF (ity == 3) THEN
186 n0 = 0
187 nni = nn4
188 IF (ihbe == 11) npg = 4
189 ELSE
190 n0 = numelc
191 nni = nn5
192 IF (ihbe == 30) npg = 3 !dkt18
193 ENDIF
194c
195 IF (ity == 3) offset = 0
196 IF (ity == 7) offset = numelc
197c
198 DO i=1,nel
199 IF (ity == 3) THEN
200 id_elem(offset+nft+i) = ixc(nixc,nft+i)
201 ity_elem(offset+nft+i) = 3
202 IF( h3d_part(ipartc(nft+i)) == 1) iok_part(i) = 1
203 ELSEIF (ity == 7) THEN
204 id_elem(offset+nft+i) = ixtg(nixtg,nft+i)
205 ity_elem(offset+nft+i) = 7
206 IF( h3d_part(iparttg(nft+i)) == 1) iok_part(i) = 1
207 ENDIF
208 ENDDO
209c
210 IF (mlw == 0) GOTO 490
211C
212 a1 = zero
213 a2 = zero
214 a3 = zero
215 istre = 1
216 npt = iabs(iparg(6,ng))
217 mpt = max(1,npt)
218 mpt0 = mpt
219 IF (npt == 0) mpt = 0
220C
221 IF (igtyp == 10 .OR. igtyp == 11 .OR. igtyp == 16 .OR. igtyp == 17) THEN
222 npt = 1
223 mpt = npt
224 ELSEIF (igtyp == 51 .OR. igtyp == 52) THEN
225 IF(layer_input == -2) THEN
226 npt= elbuf_tab(ng)%BUFLY(1)%NPTT
227 ELSEIF(layer_input == -3) THEN
228 npt= elbuf_tab(ng)%BUFLY(nlay)%NPTT
229 ELSEIF(layer_input > 0 .AND. layer_input <= nlay) THEN
230 npt= elbuf_tab(ng)%BUFLY(layer_input)%NPTT
231 ENDIF
232 IF (ply_input > 0) THEN
233 DO j=1,nlay
234 id_ply = 0
235 IF (igtyp == 51) THEN
236 id_ply = igeo(1,stack%IGEO(2+j,isubstack))
237 ELSEIF (igtyp == 52) THEN
238 id_ply = ply_info(1,stack%IGEO(2+j,isubstack)-numstack)
239 ENDIF
240 IF (id_ply == ply_input ) THEN
241 npt= elbuf_tab(ng)%BUFLY(j)%NPTT
242 EXIT
243 ENDIF
244 ENDDO
245 ENDIF
246 mpt = max(1,npt)
247 ENDIF
248c
249 ilay = layer_input
250 ipt = ipt_input
251 iply = ply_input
252 IF (ilay == -2) ilay = 1 ! Lower
253 IF (ilay == -3) ilay = nlay ! Upper
254 IF (ipt == -2) ipt = 1 ! Lower
255 IF (igtyp == 51 .OR. igtyp == 52) THEN
256 IF (ipt == -3 .AND. ilay > 0) ipt = max(1,elbuf_tab(ng)%BUFLY(ilay)%NPTT) ! Upper
257 ELSE
258 IF (ipt == -3) ipt = max(1,npt) ! Upper
259 ENDIF
260C------------------------
261C STRESS
262C------------------------
263 IF (keyword == 'TENS/STRESS/MEMB' .OR.
264 . keyword == 'TENS/STRESS/BEND' .OR.
265 . keyword == 'TENS/STRESS' .OR.
266 . keyword == 'TENS/STRAIN' .OR.
267 . keyword == 'TENS/MSTRAIN' ) THEN
268 IF (ity == 3) THEN
269 ipid = ixc(6,nft+1)
270 DO i=1,nel
271 mat(i)=ixc(1,nft+i)
272 pid(i)=ixc(6,nft+i)
273 ENDDO
274 ELSE ! ITY == 7
275 ipid = ixtg(5,nft+1)
276 DO i=1,nel
277 mat(i)=ixtg(1,nft+i)
278 pid(i)=ixtg(5,nft+i)
279 ENDDO
280 ENDIF
281c
282 irep = igeo(6,ipid)
283 ENDIF
284 IF( keyword == 'TENS/STRAIN' .OR. keyword == 'tens/mstrain') THEN
285 !Npt_max
286 LAYNPT_MAX = 1
287 IXLAY = 0
288.OR. IF(IGTYP == 51 IGTYP == 52) THEN
289 DO ILAY=1,NLAY
290 LAYNPT_MAX = MAX(LAYNPT_MAX ,ELBUF_TAB(NG)%BUFLY(ILAY)%NPTT)
291 ENDDO
292 ENDIF
293 NLAY_MAX = MAX(NLAY,NPT)
294 ALLOCATE(MATLY(MVSIZ*NLAY_MAX), THKLY(MVSIZ*NLAY_MAX*LAYNPT_MAX),
295 . POSLY(MVSIZ,NLAY_MAX*LAYNPT_MAX),THK_LY(NEL,NLAY_MAX*LAYNPT_MAX))
296 MATLY = 0
297 THKLY = ZERO
298 POSLY = ZERO
299 THK_LY = ZERO
300c
301 ! computing position of slice or Ply
302 IF(ITY == 7) THEN
303 NUMEL_DRAPE = NUMELTG_DRAPE
304 SEDRAPE = STDRAPE
305 CALL LAYINI(
306 . ELBUF_TAB(NG),1 ,NEL ,GEO ,IGEO ,
307 . MAT ,PID ,THKLY ,MATLY ,POSLY ,
308 . IGTYP ,IXFEM ,IXLAY ,NLAY ,MPT0 ,
309 . ISUBSTACK ,STACK ,DRAPE_SH3N ,NFT ,GBUF%THK,
310 . NEL ,THK_LY ,DRAPEG%INDX_SH3N ,SEDRAPE,NUMEL_DRAPE )
311 ELSE ! ITY = 3
312 NUMEL_DRAPE = NUMELC_DRAPE
313 SEDRAPE = SCDRAPE
314 CALL LAYINI(
315 . ELBUF_TAB(NG),1 ,NEL ,GEO ,IGEO ,
316 . MAT ,PID ,THKLY ,MATLY ,POSLY ,
317 . IGTYP ,IXFEM ,IXLAY ,NLAY ,MPT0 ,
318 . ISUBSTACK ,STACK ,DRAPE_SH4N ,NFT ,GBUF%THK ,
319 . NEL ,THK_LY ,DRAPEG%INDX_SH4N,SEDRAPE ,NUMEL_DRAPE )
320 ENDIF
321 ENDIF
322C--------------------------------------------------
323 IF (KEYWORD == 'tens/stress/memb') THEN
324C--------------------------------------------------
325 DO I=1,NEL
326 VALUE(1) = GBUF%FOR(JJ(1)+I)
327 VALUE(2) = GBUF%FOR(JJ(2)+I)
328 VALUE(3) = GBUF%FOR(JJ(3)+I)
329 CALL H3D_WRITE_SH_TENSOR(IOK_PART,ISELECT,IS_WRITTEN_SHELL,SHELL_TENSOR,I,OFFSET,NFT,
330 . VALUE)
331 ENDDO
332C--------------------------------------------------
333 ELSEIF (KEYWORD == 'tens/stress/bend') THEN
334C--------------------------------------------------
335 DO I=1,NEL
336 VALUE(1) = GBUF%MOM(JJ(1)+I)
337 VALUE(2) = GBUF%MOM(JJ(2)+I)
338 VALUE(3) = GBUF%MOM(JJ(3)+I)
339 CALL H3D_WRITE_SH_TENSOR(IOK_PART,ISELECT,IS_WRITTEN_SHELL,SHELL_TENSOR,I,OFFSET,NFT,
340 . VALUE)
341 ENDDO
342
343C--------------------------------------------------
344 ELSEIF (KEYWORD == 'tens/stress') THEN ! stress output in element coordinate system
345C--------------------------------------------------
346c
347 ISELECT = 0
348 ALLOCATE (SIGE(NEL,3))
349 SIGE(1:NEL,1:3) = ZERO
350c
351 IF (MPT == 0) THEN ! ILAYER=NULL, NPT=NULL
352 ISELECT = 1
353 IF (IPT_INPUT == -2 ) THEN
354 FACTOR = -SIX ! lower
355 ELSEIF (IPT_INPUT == -3) THEN
356 FACTOR = SIX ! upper
357 ELSE
358 FACTOR = ZERO ! mem
359 END IF
360 DO I=1,NEL
361 SIGE(I,1) = GBUF%FOR(JJ(1)+I) + GBUF%MOM(JJ(1)+I) * FACTOR
362 SIGE(I,2) = GBUF%FOR(JJ(2)+I) + GBUF%MOM(JJ(2)+I) * FACTOR
363 SIGE(I,3) = GBUF%FOR(JJ(3)+I) + GBUF%MOM(JJ(3)+I) * FACTOR
364 ENDDO
365c
366.AND..AND. ELSE IF (ILAY == -1 IPLY == -1 IPT == -1) THEN
367 ISELECT = 1
368 DO I=1,NEL
369 SIGE(I,1) = GBUF%FOR(JJ(1)+I)
370 SIGE(I,2) = GBUF%FOR(JJ(2)+I)
371 SIGE(I,3) = GBUF%FOR(JJ(3)+I)
372 ENDDO
373c
374.AND..AND. ELSEIF (ILAY == -1 IPLY > 0 IPT > 0) THEN
375c /TENS/STRESS/PLY=.../NPT=...
376 DO J=1,NLAY ! shells type 17,19,51 and 52 only
377.OR..OR. IF (IGTYP == 17 IGTYP == 19 IGTYP == 51) THEN
378 ID_PLY = IGEO(1,STACK%IGEO(2+J,ISUBSTACK))
379 ELSE IF (IGTYP == 52) THEN
380 ID_PLY = PLY_INFO(1,STACK%IGEO(2+J,ISUBSTACK) - NUMSTACK)
381 END IF
382 ILAY = J
383.AND. IF (ID_PLY == IPLY IPT <= ELBUF_TAB(NG)%BUFLY(ILAY)%NPTT) THEN
384 IMAT = ELBUF_TAB(NG)%BUFLY(ILAY)%IMAT
385 IVISC = MAT_PARAM(IMAT)%IVISC
386 ISELECT = 1
387 DO I=1,NEL
388 DO IR=1,NPTR
389 DO IS=1,NPTS
390 LBUF => ELBUF_TAB(NG)%BUFLY(ILAY)%LBUF(IR,IS,IPT)
391 SIGE(I,1) = SIGE(I,1) + LBUF%SIG(JJ(1) + I) / NPG
392 SIGE(I,2) = SIGE(I,2) + LBUF%SIG(JJ(2) + I) / NPG
393 SIGE(I,3) = SIGE(I,3) + LBUF%SIG(JJ(3) + I) / NPG
394 ENDDO
395 ENDDO
396 ENDDO
397 IF (IVISC > 0) THEN
398 DO I=1,NEL
399 DO IR=1,NPTR
400 DO IS=1,NPTS
401 LBUF => ELBUF_TAB(NG)%BUFLY(ILAY)%LBUF(IR,IS,IPT)
402 SIGE(I,1) = SIGE(I,1) + LBUF%VISC(JJ(1) + I) / NPG
403 SIGE(I,2) = SIGE(I,2) + LBUF%VISC(JJ(2) + I) / NPG
404 SIGE(I,3) = SIGE(I,3) + LBUF%VISC(JJ(3) + I) / NPG
405 ENDDO
406 ENDDO
407 ENDDO
408 END IF
409 MAT_ORTH = MAT_PARAM(IMAT)%ORTHOTROPY
410 IF (MAT_ORTH > 0) THEN
411.AND..OR. IF (IDRAPE > 0 (IGTYP == 51 IGTYP == 52) ) THEN
412 DIR_A => ELBUF_TAB(NG)%BUFLY(ILAY)%LBUF_DIR(IPT)%DIRA
413 DIR_B => ELBUF_TAB(NG)%BUFLY(ILAY)%LBUF_DIR(IPT)%DIRB
414 ELSE
415 DIR_A => ELBUF_TAB(NG)%BUFLY(ILAY)%DIRA
416 DIR_B => ELBUF_TAB(NG)%BUFLY(ILAY)%DIRB
417 ENDIF
418 END IF
419 IF (MAT_ORTH == 2) THEN
420 CALL UROTO_TENS2D(NEL,SIGE,DIR_A)
421 ELSE IF (MAT_ORTH == 3) THEN ! anisotropic (law 58,158 only)
422 CALL UROTO_TENS2D_ANISO(NEL,SIGE,DIR_A,DIR_B)
423 END IF
424 EXIT
425 ENDIF ! ID_PLY & ipt
426 ENDDO ! NLAY
427c
428.AND..AND. ELSEIF (ILAY > 0 ILAY <= NLAY IPLY == -1) THEN
429 ! /TENS/STRESS/LAYER=
430.OR..OR. IF (IGTYP == 10 IGTYP == 11 IGTYP == 16) THEN ! shells type 10,11,16 only
431 ISELECT = 1
432 IMAT = ELBUF_TAB(NG)%BUFLY(ILAY)%IMAT
433 IVISC = MAT_PARAM(IMAT)%IVISC
434 DO I=1,NEL
435 DO IR=1,NPTR
436 DO IS=1,NPTS
437 LBUF => ELBUF_TAB(NG)%BUFLY(ILAY)%LBUF(IR,IS,1)
438 SIGE(I,1) = SIGE(I,1) + LBUF%SIG(JJ(1) + I) / NPG
439 SIGE(I,2) = SIGE(I,2) + LBUF%SIG(JJ(2) + I) / NPG
440 SIGE(I,3) = SIGE(I,3) + LBUF%SIG(JJ(3) + I) / NPG
441 ENDDO
442 ENDDO
443 ENDDO
444 IF (IVISC > 0) THEN
445 DO I=1,NEL
446 DO IR=1,NPTR
447 DO IS=1,NPTS
448 LBUF => ELBUF_TAB(NG)%BUFLY(ILAY)%LBUF(IR,IS,1)
449 SIGE(I,1) = SIGE(I,1) + LBUF%VISC(JJ(1) + I) / NPG
450 SIGE(I,2) = SIGE(I,2) + LBUF%VISC(JJ(2) + I) / NPG
451 SIGE(I,3) = SIGE(I,3) + LBUF%VISC(JJ(3) + I) / NPG
452 ENDDO
453 ENDDO
454 ENDDO
455 END IF
456 MAT_ORTH = MAT_PARAM(IMAT)%ORTHOTROPY
457 IF (MAT_ORTH > 0) THEN
458 DIR_A => ELBUF_TAB(NG)%BUFLY(ILAY)%DIRA
459 DIR_B => ELBUF_TAB(NG)%BUFLY(ILAY)%DIRB
460 END IF
461 IF (MAT_ORTH == 2) THEN ! standard orthotropic rotation
462 CALL UROTO_TENS2D(NEL,SIGE,DIR_A)
463 ELSE IF (MAT_ORTH == 3) THEN ! anisotropic (law 58,158 only)
464 CALL UROTO_TENS2D_ANISO(NEL,SIGE,DIR_A,DIR_B)
465 END IF
466 ENDIF
467
468.AND..AND. ELSEIF (IPT > 0 ILAY ==-1 IPLY == -1) THEN ! shells type 1,9 only
469c /TENS/STRESS/NPT=
470.OR. IF (IGTYP == 1 IGTYP == 9) THEN
471 IF (IPT <= ELBUF_TAB(NG)%BUFLY(1)%NPTT) THEN
472 ISELECT = 1
473 IMAT = ELBUF_TAB(NG)%BUFLY(1)%IMAT
474 IVISC = MAT_PARAM(IMAT)%IVISC
475 DO I=1,NEL
476 DO IR=1,NPTR
477 DO IS=1,NPTS
478 LBUF => ELBUF_TAB(NG)%BUFLY(1)%LBUF(IR,IS,IPT)
479 SIGE(I,1) = SIGE(I,1) + LBUF%SIG(JJ(1) + I) / NPG
480 SIGE(I,2) = SIGE(I,2) + LBUF%SIG(JJ(2) + I) / NPG
481 SIGE(I,3) = SIGE(I,3) + LBUF%SIG(JJ(3) + I) / NPG
482 ENDDO
483 ENDDO
484 ENDDO
485 IF (IVISC > 0) THEN
486 DO I=1,NEL
487 DO IR=1,NPTR
488 DO IS=1,NPTS
489 LBUF => ELBUF_TAB(NG)%BUFLY(1)%LBUF(IR,IS,IPT)
490 SIGE(I,1) = SIGE(I,1) + LBUF%VISC(JJ(1) + I) / NPG
491 SIGE(I,2) = SIGE(I,2) + LBUF%VISC(JJ(2) + I) / NPG
492 SIGE(I,3) = SIGE(I,3) + LBUF%VISC(JJ(3) + I) / NPG
493 ENDDO
494 ENDDO
495 ENDDO
496 END IF
497 MAT_ORTH = MAT_PARAM(IMAT)%ORTHOTROPY
498 IF (MAT_ORTH == 2) THEN
499 DIR_A => ELBUF_TAB(NG)%BUFLY(1)%DIRA
500 CALL UROTO_TENS2D(NEL,SIGE,DIR_A)
501 END IF
502 ENDIF
503 ENDIF
504 ENDIF
505c---
506 IF (ISELECT == 1) THEN
507 CALL H3D_WRITE_SH_TENSOR_ARRAY(
508 . IOK_PART ,ISELECT ,NEL ,OFFSET ,NFT ,
509 . IS_WRITTEN_SHELL,SHELL_TENSOR,SIGE )
510 END IF
511c
512 DEALLOCATE (SIGE)
513c--------------------------------------------------
514 ELSEIF (KEYWORD == 'tens/mstress') THEN ! stress output in material (orthotropic) coordinates
515c--------------------------------------------------
516 ISELECT = 0
517 ALLOCATE (SIGM(NEL,3))
518 SIGM(1:NEL,1:3) = ZERO
519c
520.AND..AND. IF (ILAY == -1 IPLY > 0 IPT > 0) THEN
521c /TENS/MSTRESS/PLY=.../NPT=...
522 DO J=1,NLAY ! shells type 17,19,51 and 52 only
523.OR..OR. IF (IGTYP == 17 IGTYP == 19 IGTYP == 51) THEN
524 ID_PLY = IGEO(1,STACK%IGEO(2+J,ISUBSTACK))
525 ELSE IF (IGTYP == 52) THEN
526 ID_PLY = PLY_INFO(1,STACK%IGEO(2+J,ISUBSTACK) - NUMSTACK)
527 END IF
528
529 IF (ID_PLY == IPLY) THEN
530 ILAY = J
531 IMAT = ELBUF_TAB(NG)%BUFLY(ILAY)%IMAT
532 IVISC = MAT_PARAM(IMAT)%IVISC
533 IF (IPT <= ELBUF_TAB(NG)%BUFLY(ILAY)%NPTT) THEN
534 ISELECT = 1
535 DO I=1,NEL
536 DO IR=1,NPTR
537 DO IS=1,NPTS
538 LBUF => ELBUF_TAB(NG)%BUFLY(ILAY)%LBUF(IR,IS,IPT)
539 SIGM(I,1) = SIGM(I,1) + LBUF%SIG(JJ(1) + I) / NPG
540 SIGM(I,2) = SIGM(I,2) + LBUF%SIG(JJ(2) + I) / NPG
541 SIGM(I,3) = SIGM(I,3) + LBUF%SIG(JJ(3) + I) / NPG
542 ENDDO
543 ENDDO
544 ENDDO
545 IF (IVISC > 0) THEN
546 DO I=1,NEL
547 DO IR=1,NPTR
548 DO IS=1,NPTS
549 LBUF => ELBUF_TAB(NG)%BUFLY(ILAY)%LBUF(IR,IS,IPT)
550 SIGM(I,1) = SIGM(I,1) + LBUF%VISC(JJ(1) + I) / NPG
551 SIGM(I,2) = SIGM(I,2) + LBUF%VISC(JJ(2) + I) / NPG
552 SIGM(I,3) = SIGM(I,3) + LBUF%VISC(JJ(3) + I) / NPG
553 ENDDO
554 ENDDO
555 ENDDO
556 END IF
557 ENDIF
558 ENDIF
559 ENDDO ! NLAY
560c
561.AND..AND..AND. ELSEIF (ILAY > 0 ILAY <= NLAY IPLY == -1 IPT == -1) THEN
562c /TENS/MSTRESS/LAYER=
563.OR..OR. IF (IGTYP == 10 IGTYP == 11 IGTYP == 16) THEN ! shells type 10,11,16 only
564 ISELECT = 1
565 IMAT = ELBUF_TAB(NG)%BUFLY(ILAY)%IMAT
566 IVISC = MAT_PARAM(IMAT)%IVISC
567 DO I=1,NEL
568 DO IR=1,NPTR
569 DO IS=1,NPTS
570 LBUF => ELBUF_TAB(NG)%BUFLY(ILAY)%LBUF(IR,IS,1)
571 SIGM(I,1) = SIGM(I,1) + LBUF%SIG(JJ(1) + I) / NPG
572 SIGM(I,2) = SIGM(I,2) + LBUF%SIG(JJ(2) + I) / NPG
573 SIGM(I,3) = SIGM(I,3) + LBUF%SIG(JJ(3) + I) / NPG
574 ENDDO
575 ENDDO
576 ENDDO
577 IF (IVISC > 0) THEN
578 DO I=1,NEL
579 DO IR=1,NPTR
580 DO IS=1,NPTS
581 LBUF => ELBUF_TAB(NG)%BUFLY(ILAY)%LBUF(IR,IS,IPT)
582 SIGM(I,1) = SIGM(I,1) + LBUF%VISC(JJ(1) + I) / NPG
583 SIGM(I,2) = SIGM(I,2) + LBUF%VISC(JJ(2) + I) / NPG
584 SIGM(I,3) = SIGM(I,3) + LBUF%VISC(JJ(3) + I) / NPG
585 ENDDO
586 ENDDO
587 ENDDO
588 END IF
589 ENDIF
590
591.AND..AND. ELSEIF (IPT > 0 ILAY ==-1 IPLY == -1) THEN ! shells type 1,9 only
592c /TENS/MSTRESS/NPT=
593.OR. IF (IGTYP == 1 IGTYP == 9) THEN
594 IF (IPT <= ELBUF_TAB(NG)%BUFLY(1)%NPTT) THEN
595 ISELECT = 1
596 IMAT = ELBUF_TAB(NG)%BUFLY(ILAY)%IMAT
597 IVISC = MAT_PARAM(IMAT)%IVISC
598 DO I=1,NEL
599 DO IR=1,NPTR
600 DO IS=1,NPTS
601 LBUF => ELBUF_TAB(NG)%BUFLY(1)%LBUF(IR,IS,IPT)
602 SIGM(I,1) = SIGM(I,1) + LBUF%SIG(JJ(1) + I) / NPG
603 SIGM(I,2) = SIGM(I,2) + LBUF%SIG(JJ(2) + I) / NPG
604 SIGM(I,3) = SIGM(I,3) + LBUF%SIG(JJ(3) + I) / NPG
605 ENDDO
606 ENDDO
607 ENDDO
608 IF (IVISC > 0) THEN
609 DO I=1,NEL
610 DO IR=1,NPTR
611 DO IS=1,NPTS
612 LBUF => ELBUF_TAB(NG)%BUFLY(1)%LBUF(IR,IS,IPT)
613 SIGM(I,1) = SIGM(I,1) + LBUF%VISC(JJ(1) + I) / NPG
614 SIGM(I,2) = SIGM(I,2) + LBUF%VISC(JJ(2) + I) / NPG
615 SIGM(I,3) = SIGM(I,3) + LBUF%VISC(JJ(3) + I) / NPG
616 ENDDO
617 ENDDO
618 ENDDO
619 END IF
620
621 ENDIF
622 ENDIF
623 ENDIF
624c---
625 CALL H3D_WRITE_SH_TENSOR_ARRAY(
626 . IOK_PART ,ISELECT ,NEL ,OFFSET ,NFT ,
627 . IS_WRITTEN_SHELL,SHELL_TENSOR,SIGM )
628
629 DEALLOCATE (SIGM)
630C--------------------------------------------------
631 ELSE IF (KEYWORD == 'tens/strain/memb') THEN
632C--------------------------------------------------
633 DO I=1,NEL
634 N = I + NFT
635 THK = GBUF%THK(I)
636 J = EL2FA(NNI+N)
637 VALUE(1) = GBUF%STRA(JJ(1)+I)
638 VALUE(2) = GBUF%STRA(JJ(2)+I)
639 VALUE(3) = GBUF%STRA(JJ(3)+I)
640 VALUE(3) = VALUE(3) * HALF
641 CALL H3D_WRITE_SH_TENSOR(IOK_PART,ISELECT,IS_WRITTEN_SHELL,
642 . SHELL_TENSOR,I,OFFSET,NFT,VALUE)
643 ENDDO
644C--------------------------------------------------
645 ELSEIF (KEYWORD == 'tens/strain/bend') THEN ! bend
646C--------------------------------------------------
647 DO I=1,NEL
648 N = I + NFT
649 THK = GBUF%THK(I)
650 J = EL2FA(NNI+N)
651 VALUE(1) = GBUF%STRA(JJ(6)+I) * THK
652 VALUE(2) = GBUF%STRA(JJ(7)+I) * THK
653 VALUE(3) = GBUF%STRA(JJ(8)+I) * THK
654 VALUE(3) = VALUE(3) * HALF
655 CALL H3D_WRITE_SH_TENSOR(IOK_PART,ISELECT,IS_WRITTEN_SHELL,
656 . SHELL_TENSOR,I,OFFSET,NFT,VALUE)
657 ENDDO
658C--------------------------------------------------
659 ELSEIF (KEYWORD == 'tens/strain') THEN ! strain tensor output in element coordinate system
660C--------------------------------------------------
661 IF (MPT == 0) THEN ! ILAYER=NULL, NPT=NULL
662 ISELECT = 1
663 DO I=1,NEL
664 IF (IPT == 1) THEN
665 FACTOR = -HALF*GBUF%THK(I)
666 ELSE
667 FACTOR = HALF*GBUF%THK(I)
668 ENDIF
669 VALUE(1) = GBUF%STRA(JJ(1)+I) + FACTOR*GBUF%STRA(JJ(6)+I)
670 VALUE(2) = GBUF%STRA(JJ(2)+I) + FACTOR*GBUF%STRA(JJ(7)+I)
671 VALUE(3) = GBUF%STRA(JJ(3)+I) + FACTOR*GBUF%STRA(JJ(8)+I)
672 VALUE(3) = VALUE(3) * HALF
673 CALL H3D_WRITE_SH_TENSOR(IOK_PART,ISELECT,IS_WRITTEN_SHELL,
674 . SHELL_TENSOR,I,OFFSET,NFT,VALUE)
675 ENDDO
676c
677.AND..AND. ELSE IF (ILAY == -1 IPLY == -1 IPT == -1) THEN
678 DO I=1,NEL
679 VALUE(1) = GBUF%STRA(JJ(1)+I)
680 VALUE(2) = GBUF%STRA(JJ(2)+I)
681 VALUE(3) = GBUF%STRA(JJ(3)+I)
682 VALUE(3) = VALUE(3) * HALF
683 CALL H3D_WRITE_SH_TENSOR(IOK_PART,ISELECT,IS_WRITTEN_SHELL,
684 . SHELL_TENSOR,I,OFFSET,NFT,VALUE)
685 ENDDO
686c
687c PLY=IPLY NPT=IPT
688
689.AND. ELSE IF (IPLY > 0 IPT > 0) THEN
690.OR..OR..OR. IF (IGTYP == 17 IGTYP == 19 IGTYP == 51 IGTYP == 52) THEN
691 IPANG = 1
692 IPTHK = IPANG + NLAY
693 IPPOS = IPTHK + NLAY
694 IPT_ALL = 0
695 DO J=1,NLAY
696 BUFLY => ELBUF_TAB(NG)%BUFLY(J)
697 NPTT = BUFLY%NPTT
698.OR. IF (IGTYP == 17 IGTYP == 51) THEN
699 ID_PLY = IGEO(1,STACK%IGEO(2+J,ISUBSTACK))
700 ELSEIF (IGTYP == 52) THEN
701 ID_PLY = PLY_INFO(1,STACK%IGEO(2+J,ISUBSTACK)-NUMSTACK)
702 ENDIF
703.AND. IF (ID_PLY == IPLY IPT <= NPTT) THEN
704 ISLICE = IPT_ALL + IPT
705 IF(NPG > 1) THEN
706 LENS = NEL*GBUF%G_STRPG/NPG
707 DO I=1,NEL
708 N = I + NFT
709 THK = GBUF%THK(I)
710 FACTOR = POSLY(I,ISLICE)
711 VALUE(1:3) = ZERO
712 DO IPG = 1, NPG
713 PTS = (IPG -1)*LENS
714 VALUE(1) = VALUE(1)+ GBUF%STRPG(PTS + JJ(1)+I) + FACTOR*GBUF%STRPG(PTS + JJ(6)+I) * THK
715 VALUE(2) = VALUE(2)+ GBUF%STRPG(PTS + JJ(2)+I) + FACTOR*GBUF%STRPG(PTS + JJ(7)+I) * THK
716 VALUE(3) = VALUE(3)+ GBUF%STRPG(PTS + JJ(3)+I) + FACTOR*GBUF%STRPG(PTS + JJ(8)+I) * THK
717 ENDDO
718 VALUE(3) = VALUE(3) * HALF
719 CALL H3D_WRITE_SH_TENSOR(IOK_PART,ISELECT,IS_WRITTEN_SHELL,
720 . SHELL_TENSOR,I,OFFSET,NFT,VALUE)
721 ENDDO
722 ELSE
723 DO I=1,NEL
724 N = I + NFT
725 THK = GBUF%THK(I)
726 FACTOR = POSLY(I,ISLICE)
727 VALUE(1) = GBUF%STRA(JJ(1)+I) + FACTOR*GBUF%STRA(JJ(6)+I) * THK
728 VALUE(2) = GBUF%STRA(JJ(2)+I) + FACTOR*GBUF%STRA(JJ(7)+I) * THK
729 VALUE(3) = GBUF%STRA(JJ(3)+I) + FACTOR*GBUF%STRA(JJ(8)+I) * THK
730 VALUE(3) = VALUE(3) * HALF
731 CALL H3D_WRITE_SH_TENSOR(IOK_PART,ISELECT,IS_WRITTEN_SHELL,
732 . SHELL_TENSOR,I,OFFSET,NFT,VALUE)
733 ENDDO
734 ENDIF ! NPG
735 ENDIF
736 IPT_ALL = IPT_ALL + NPTT
737 ENDDO
738 ENDIF
739c
740.AND..AND. ELSEIF (ILAY > 0 ILAY <= NLAY IPLY == -1) THEN
741c ILAYER=IL PLY=NULL NPT=NULL
742.OR..OR. IF (IGTYP == 10 IGTYP == 11 IGTYP == 16) THEN
743 IF (NPG > 1) THEN
744 LENS = NEL*GBUF%G_STRPG/NPG
745 DO I=1,NEL
746 N = I + NFT
747 THK = GBUF%THK(I)
748 FACTOR = POSLY(I,ILAY)
749 J = EL2FA(NNI+N)
750 VALUE(1:3) = ZERO
751 DO IPG = 1, NPG
752 PTS = (IPG -1)*LENS
753 VALUE(1) = VALUE(1)+ GBUF%STRPG(PTS + JJ(1)+I) + FACTOR*GBUF%STRPG(PTS + JJ(6)+I) * THK
754 VALUE(2) = VALUE(2)+ GBUF%STRPG(PTS + JJ(2)+I) + FACTOR*GBUF%STRPG(PTS + JJ(7)+I) * THK
755 VALUE(3) = VALUE(3)+ GBUF%STRPG(PTS + JJ(3)+I) + FACTOR*GBUF%STRPG(PTS + JJ(8)+I) * THK
756 ENDDO
757 VALUE(1) = VALUE(1)/NPG
758 VALUE(2) = VALUE(2)/NPG
759 VALUE(3) = VALUE(3)/NPG
760 VALUE(3) = VALUE(3) * HALF
761 CALL H3D_WRITE_SH_TENSOR(IOK_PART,ISELECT,IS_WRITTEN_SHELL,
762 . SHELL_TENSOR,I,OFFSET,NFT,VALUE)
763 ENDDO
764 ELSE
765 DO I=1,NEL
766 N = I + NFT
767 THK = GBUF%THK(I)
768 FACTOR = POSLY(I,ILAY)
769 J = EL2FA(NNI+N)
770 VALUE(1) = GBUF%STRA(JJ(1)+I) + FACTOR*GBUF%STRA(JJ(6)+I) * THK
771 VALUE(2) = GBUF%STRA(JJ(2)+I) + FACTOR*GBUF%STRA(JJ(7)+I) * THK
772 VALUE(3) = GBUF%STRA(JJ(3)+I) + FACTOR*GBUF%STRA(JJ(8)+I) * THK
773 VALUE(3) = VALUE(3) * HALF
774 CALL H3D_WRITE_SH_TENSOR(IOK_PART,ISELECT,IS_WRITTEN_SHELL,
775 . SHELL_TENSOR,I,OFFSET,NFT,VALUE)
776 ENDDO
777 ENDIF ! NPG
778 ENDIF
779c
780.AND. ELSEIF (IPT <= MPT IPT > 0) THEN
781c NPT=IPT PLY=NULL ILAYER=NULL
782.OR. IF (IGTYP == 1 IGTYP == 9) THEN
783 IF(NPG > 1) THEN
784 LENS = NEL*GBUF%G_STRPG/NPG
785 DO I=1,NEL
786 N = I + NFT
787 THK = GBUF%THK(I)
788 FACTOR = POSLY(I,IPT)
789 J = EL2FA(NNI+N)
790 VALUE(1:3) = ZERO
791 DO IPG =1,NPG
792 PTS = (IPG -1)*LENS
793 VALUE(1) = VALUE(1)+ GBUF%STRPG(PTS + JJ(1)+I) + FACTOR*GBUF%STRPG(PTS + JJ(6)+I) * THK
794 VALUE(2) = VALUE(2)+ GBUF%STRPG(PTS + JJ(2)+I) + FACTOR*GBUF%STRPG(PTS + JJ(7)+I) * THK
795 VALUE(3) = VALUE(3)+ GBUF%STRPG(PTS + JJ(3)+I) + FACTOR*GBUF%STRPG(PTS + JJ(8)+I) * THK
796 ENDDO
797 VALUE(3) = VALUE(3) * HALF
798 CALL H3D_WRITE_SH_TENSOR(IOK_PART,ISELECT,IS_WRITTEN_SHELL,
799 . SHELL_TENSOR,I,OFFSET,NFT,VALUE)
800 ENDDO
801 ELSE
802 DO I=1,NEL
803 N = I + NFT
804 THK = GBUF%THK(I)
805 FACTOR = POSLY(I,IPT)
806 J = EL2FA(NNI+N)
807 VALUE(1) = GBUF%STRA(JJ(1)+I) + FACTOR*GBUF%STRA(JJ(6)+I) * THK
808 VALUE(2) = GBUF%STRA(JJ(2)+I) + FACTOR*GBUF%STRA(JJ(7)+I) * THK
809 VALUE(3) = GBUF%STRA(JJ(3)+I) + FACTOR*GBUF%STRA(JJ(8)+I) * THK
810 VALUE(3) = VALUE(3) * HALF
811 CALL H3D_WRITE_SH_TENSOR(IOK_PART,ISELECT,IS_WRITTEN_SHELL,
812 . SHELL_TENSOR,I,OFFSET,NFT,VALUE)
813 ENDDO
814 ENDIF ! NPG
815 ENDIF
816 ENDIF
817 DEALLOCATE(MATLY, THKLY,POSLY,THK_LY)
818C--------------------------------------------------
819 ELSEIF (KEYWORD == 'tens/mstrain') THEN ! strain tensor output in material coordinate system
820C--------------------------------------------------
821 ALLOCATE (EPSM(NEL,3))
822 EPSM(:,:) = ZERO
823c
824.AND. IF (IPLY > 0 IPT > 0) THEN
825
826.OR..OR..OR. IF (IGTYP == 17 IGTYP == 19 IGTYP == 51 IGTYP == 52) THEN
827 IPANG = 1
828 IPTHK = IPANG + NLAY
829 IPPOS = IPTHK + NLAY
830 IPT_ALl = 0
831 DO J=1,NLAY
832 BUFLY => ELBUF_TAB(NG)%BUFLY(J)
833 NPTT = BUFLY%NPTT
834.OR..OR. IF (IGTYP == 17 IGTYP == 19 IGTYP == 51) THEN
835 ID_PLY = IGEO(1,STACK%IGEO(2+J,ISUBSTACK))
836 ELSEIF (IGTYP == 52) THEN
837 ID_PLY = PLY_INFO(1,STACK%IGEO(2+J,ISUBSTACK)-NUMSTACK)
838 ENDIF
839.AND. IF (ID_PLY == IPLY IPT <= NPTT) THEN
840 ILAY = J
841 ISLICE = IPT_ALL + IPT
842 IF(NPG > 1) THEN
843 LENS = NEL*GBUF%G_STRPG/NPG
844 DO I=1,NEL
845 THK = GBUF%THK(I)
846 FACTOR = POSLY(I,ISLICE)
847 EPSM(I,1:3) = ZERO
848 DO IPG = 1, NPG
849 PTS = (IPG -1)*LENS
850 EPSM(I,1) = EPSM(I,1)+ GBUF%STRPG(PTS + JJ(1)+I) + FACTOR*GBUF%STRPG(PTS + JJ(6)+I) * THK
851 EPSM(I,2) = EPSM(I,2)+ GBUF%STRPG(PTS + JJ(2)+I) + FACTOR*GBUF%STRPG(PTS + JJ(7)+I) * THK
852 EPSM(I,3) = EPSM(I,3)+ GBUF%STRPG(PTS + JJ(3)+I) + FACTOR*GBUF%STRPG(PTS + JJ(8)+I) * THK
853 ENDDO
854 EPSM(I,1) = EPSM(I,1)/NPG
855 EPSM(I,2) = EPSM(I,2)/NPG
856 EPSM(I,3) = HALF*EPSM(I,3)/NPG
857 ENDDO
858 ELSE
859 DO I=1,NEL
860 THK = GBUF%THK(I)
861 FACTOR = POSLY(I,ISLICE)
862 EPSM(I,1) = GBUF%STRA(JJ(1)+I) + FACTOR*GBUF%STRA(JJ(6)+I) * THK
863 EPSM(I,2) = GBUF%STRA(JJ(2)+I) + FACTOR*GBUF%STRA(JJ(7)+I) * THK
864 EPSM(I,3) = GBUF%STRA(JJ(3)+I) + FACTOR*GBUF%STRA(JJ(8)+I) * THK
865 EPSM(I,3) = EPSM(I,3) * HALF
866 ENDDO
867 ENDIF ! NPG
868 IMAT = ELBUF_TAB(NG)%BUFLY(ILAY)%IMAT
869 MAT_ORTH = MAT_PARAM(IMAT)%ORTHOTROPY
870 IF (MAT_ORTH > 0) THEN
871.AND..OR. IF (IDRAPE > 0 (IGTYP == 51 IGTYP == 52) ) THEN
872 DIR_A => ELBUF_TAB(NG)%BUFLY(ILAY)%LBUF_DIR(IPT)%DIRA
873 DIR_B => ELBUF_TAB(NG)%BUFLY(ILAY)%LBUF_DIR(IPT)%DIRB
874 ELSE
875 DIR_A => ELBUF_TAB(NG)%BUFLY(ILAY)%DIRA
876 DIR_B => ELBUF_TAB(NG)%BUFLY(ILAY)%DIRB
877 ENDIF
878 END IF
879 IF (MAT_ORTH == 2) THEN
880 CALL ROTO_TENS2D(NEL,EPSM,DIR_A)
881 ELSE IF (MAT_ORTH == 3) THEN ! anisotropic (law 58,158 only)
882 CALL ROTO_TENS2D_ANISO(NEL,EPSM,DIR_A,DIR_B)
883 END IF
884 ENDIF
885 IPT_ALL = IPT_ALL + NPTT
886 ENDDO
887 ENDIF
888c
889.AND..AND..AND. ELSEIF (ILAY > 0 ILAY <= NLAY IPLY == -1 IPT == -1) THEN
890c PLY=NULL ILAYER=IL NPT=NULL
891.OR..OR. IF (IGTYP == 10 IGTYP == 11 IGTYP == 16) THEN
892 IF(NPG > 1) THEN
893 LENS = NEL*GBUF%G_STRPG/NPG
894 DO I=1,NEL
895 THK = GBUF%THK(I)
896 FACTOR = POSLY(I,ILAY)
897 EPSM(I,1:3) = ZERO
898 DO IPG = 1, NPG
899 PTS = (IPG -1)*LENS
900 EPSM(I,1) = EPSM(I,1)+ GBUF%STRPG(PTS + JJ(1)+I) + FACTOR*GBUF%STRPG(PTS + JJ(6)+I) * THK
901 EPSM(I,2) = EPSM(I,2)+ GBUF%STRPG(PTS + JJ(2)+I) + FACTOR*GBUF%STRPG(PTS + JJ(7)+I) * THK
902 EPSM(I,3) = EPSM(I,3)+ GBUF%STRPG(PTS + JJ(3)+I) + FACTOR*GBUF%STRPG(PTS + JJ(8)+I) * THK
903 ENDDO
904 EPSM(I,1) = EPSM(I,1)/NPG
905 EPSM(I,2) = EPSM(I,2)/NPG
906 EPSM(I,3) = HALF*EPSM(I,3)/NPG
907 ENDDO
908 ELSE
909 DO I=1,NEL
910 THK = GBUF%THK(I)
911 FACTOR = POSLY(I,ILAY)
912 EPSM(I,1) = GBUF%STRA(JJ(1)+I) + FACTOR*GBUF%STRA(JJ(6)+I) * THK
913 EPSM(I,2) = GBUF%STRA(JJ(2)+I) + FACTOR*GBUF%STRA(JJ(7)+I) * THK
914 EPSM(I,3) = GBUF%STRA(JJ(3)+I) + FACTOR*GBUF%STRA(JJ(8)+I) * THK
915 EPSM(I,3) = EPSM(I,3) * HALF
916 ENDDO
917 ENDIF
918 IMAT = ELBUF_TAB(NG)%BUFLY(ILAY)%IMAT
919 MAT_ORTH = MAT_PARAM(IMAT)%ORTHOTROPY
920 IF (MAT_ORTH > 0) THEN
921 DIR_A => ELBUF_TAB(NG)%BUFLY(ILAY)%DIRA
922 DIR_B => ELBUF_TAB(NG)%BUFLY(ILAY)%DIRB
923 END IF
924 IF (MAT_ORTH == 2) THEN
925 CALL ROTO_TENS2D(NEL,EPSM,DIR_A)
926 ELSE IF (MAT_ORTH == 3) THEN ! anisotropic (law 58,158 only)
927 CALL ROTO_TENS2D_ANISO(NEL,EPSM,DIR_A,DIR_B)
928 END IF
929 ENDIF
930c
931.AND..AND..AND. ELSEIF (IPT > 0 IPT <= MPT IPLY == -1 ILAY == -1) THEN
932c PLY=NULL ILAYER=NULL NPT=IPT
933.OR. IF (IGTYP == 1 IGTYP == 9) THEN
934 IF(NPG > 1) THEN
935 LENS = NEL*GBUF%G_STRPG/NPG
936 DO I=1,NEL
937 THK = GBUF%THK(I)
938 FACTOR = POSLY(I,IPT)
939 EPSM(I,1:3) = ZERO
940 DO IPG = 1, NPG
941 PTS = (IPG -1)*LENS
942 EPSM(I,1) = EPSM(I,1)+ GBUF%STRPG(PTS + JJ(1)+I) + FACTOR*GBUF%STRPG(PTS + JJ(6)+I) * THK
943 EPSM(I,2) = EPSM(I,2)+ GBUF%STRPG(PTS + JJ(2)+I) + FACTOR*GBUF%STRPG(PTS + JJ(7)+I) * THK
944 EPSM(I,3) = EPSM(I,3)+ GBUF%STRPG(PTS + JJ(3)+I) + FACTOR*GBUF%STRPG(PTS + JJ(8)+I) * THK
945 ENDDO
946 EPSM(I,1) = EPSM(I,1)/NPG
947 EPSM(I,2) = EPSM(I,2)/NPG
948 EPSM(I,3) = HALF*EPSM(I,3)/NPG
949 ENDDO
950 ELSE
951 DO I=1,NEL
952 THK = GBUF%THK(I)
953 FACTOR = POSLY(I,IPT)
954 EPSM(I,1) = GBUF%STRA(JJ(1)+I) + FACTOR*GBUF%STRA(JJ(6)+I) * THK
955 EPSM(I,2) = GBUF%STRA(JJ(2)+I) + FACTOR*GBUF%STRA(JJ(7)+I) * THK
956 EPSM(I,3) = GBUF%STRA(JJ(3)+I) + FACTOR*GBUF%STRA(JJ(8)+I) * THK
957 EPSM(I,3) = EPSM(I,3) * HALF
958 ENDDO
959 ENDIF
960 IMAT = ELBUF_TAB(NG)%BUFLY(1)%IMAT
961 MAT_ORTH = MAT_PARAM(IMAT)%ORTHOTROPY
962 IF (MAT_ORTH == 2) THEN
963 DIR_A => ELBUF_TAB(NG)%BUFLY(1)%DIRA
964 CALL ROTO_TENS2D(NEL,EPSM,DIR_A)
965 END IF
966 ENDIF
967 ENDIF
968c---
969 CALL H3D_WRITE_SH_TENSOR_ARRAY(
970 . IOK_PART ,ISELECT ,NEL ,OFFSET ,NFT ,
971 . IS_WRITTEN_SHELL,SHELL_TENSOR,EPSM )
972
973 DEALLOCATE (EPSM)
974 DEALLOCATE(MATLY, THKLY,POSLY,THK_LY)
975C--------------------------------------------------
976 ELSEIF (KEYWORD == 'tens/epsdot/memb') THEN
977C--------------------------------------------------
978 A1 = ONE
979 A2 = ZERO
980 DO I=1,NEL
981 THK = GBUF%THK(I)
982 VALUE(1) = A1*EPSDOT(1,I+NFT+OFFSET) + A2*EPSDOT(4,I+NFT+OFFSET)*THK
983 VALUE(2) = A1*EPSDOT(2,I+NFT+OFFSET) + A2*EPSDOT(5,I+NFT+OFFSET)*THK
984 VALUE(3) = (A1*EPSDOT(3,I+NFT+OFFSET) + A2*EPSDOT(6,I+NFT+OFFSET)*THK)* HALF
985 CALL H3D_WRITE_SH_TENSOR(IOK_PART,ISELECT,IS_WRITTEN_SHELL,SHELL_TENSOR,I,OFFSET,NFT,
986 . VALUE)
987 ENDDO
988C--------------------------------------------------
989 ELSEIF (KEYWORD == 'tens/epsdot/bend') THEN
990C--------------------------------------------------
991 DO I=1,NEL
992 THK = GBUF%THK(I)
993 VALUE(1) = EPSDOT(4,I+NFT+OFFSET)
994 VALUE(2) = EPSDOT(5,I+NFT+OFFSET)
995 VALUE(3) = EPSDOT(6,I+NFT+OFFSET) * HALF
996 CALL H3D_WRITE_SH_TENSOR(IOK_PART,ISELECT,IS_WRITTEN_SHELL,SHELL_TENSOR,I,OFFSET,NFT,
997 . VALUE)
998 ENDDO
999C--------------------------------------------------
1000 ELSEIF (KEYWORD == 'tens/epsdot') THEN
1001C--------------------------------------------------
1002c ILAYER=NULL NPT=NULL
1003.AND..AND. IF ( ILAY == -1 IPT == -1 IPLY == -1) THEN
1004 A1 = ONE
1005 A2 = ZERO
1006 DO I=1,NEL
1007 THK = GBUF%THK(I)
1008 VALUE(1) = A1*EPSDOT(1,I+NFT+OFFSET) + A2*EPSDOT(4,I+NFT+OFFSET)*THK
1009 VALUE(2) = A1*EPSDOT(2,I+NFT+OFFSET) + A2*EPSDOT(5,I+NFT+OFFSET)*THK
1010 VALUE(3) = (A1*EPSDOT(3,I+NFT+OFFSET) + A2*EPSDOT(6,I+NFT+OFFSET)*THK)* HALF
1011 CALL H3D_WRITE_SH_TENSOR(IOK_PART,ISELECT,IS_WRITTEN_SHELL,
1012 . SHELL_TENSOR,I,OFFSET,NFT,VALUE)
1013 ENDDO
1014c PLY=IPLY NPT=IPT
1015.AND..AND. ELSEIF ( IPLY > 0 IPT <= MPT IPT > 0 ) THEN
1016.OR..OR. IF (IGTYP == 17 IGTYP == 51 IGTYP == 52) THEN
1017 IPANG = 1
1018 IPTHK = IPANG + NLAY
1019 IPPOS = IPTHK + NLAY
1020 DO J=1,NLAY
1021.OR. IF (IGTYP == 17 IGTYP == 51) THEN
1022 ID_PLY = IGEO(1,STACK%IGEO(2+J,ISUBSTACK))
1023 ELSEIF (IGTYP == 52) THEN
1024 ID_PLY = PLY_INFO(1,STACK%IGEO(2+J,ISUBSTACK)-NUMSTACK)
1025 ENDIF
1026 BUFLY => ELBUF_TAB(NG)%BUFLY(J)
1027 NPTT = BUFLY%NPTT
1028.AND. IF (ID_PLY == IPLY IPT <= NPTT) THEN
1029 A2 = STACK%GEO(IPPOS+J,ISUBSTACK)+
1030 . HALF*(((2*IPT-ONE)/NPTT)-ONE) *
1031 . STACK%GEO(IPTHK+J,ISUBSTACK)
1032 DO I=1,NEL
1033 THK = GBUF%THK(I)
1034 VALUE(1) = EPSDOT(1,I+NFT+OFFSET) + A2*EPSDOT(4,I+NFT+OFFSET)*THK
1035 VALUE(2) = EPSDOT(2,I+NFT+OFFSET) + A2*EPSDOT(5,I+NFT+OFFSET)*THK
1036 VALUE(3) =(EPSDOT(3,I+NFT+OFFSET) + A2*EPSDOT(6,I+NFT+OFFSET)*THK)* HALF
1037 CALL H3D_WRITE_SH_TENSOR(IOK_PART,ISELECT,IS_WRITTEN_SHELL,
1038 . SHELL_TENSOR,I,OFFSET,NFT,VALUE)
1039 ENDDO
1040 ENDIF
1041 ENDDO
1042 ENDIF
1043
1044c PLY=NULL ILAYER=ILAY NPT=IPT
1045.AND..AND..AND..AND. ELSEIF (IPLY == -1 ILAY <= NLAY ILAY > 0 IPT <= MPT IPT > 0 ) THEN
1046.OR. IF (IGTYP == 51 IGTYP == 52) THEN
1047 A1 = ZERO
1048 A2 = ZERO
1049 NS1 = 8
1050 NS2 = 8
1051 IPANG = 1
1052 IPTHK = IPANG + NLAY
1053 IPPOS = IPTHK + NLAY
1054.OR. IF (IGTYP == 17 IGTYP == 51) THEN
1055 ID_PLY = IGEO(1,STACK%IGEO(2+ILAY,ISUBSTACK))
1056 ELSEIF (IGTYP == 52) THEN
1057 ID_PLY = PLY_INFO(1,STACK%IGEO(2+ILAY,ISUBSTACK)-NUMSTACK)
1058 ENDIF
1059 BUFLY => ELBUF_TAB(NG)%BUFLY(ILAY)
1060 NPTT = BUFLY%NPTT
1061 IF (IPT <= NPTT) THEN
1062 A1 = ONE
1063 A2 = STACK%GEO(IPPOS+ILAY,ISUBSTACK)+
1064 . HALF*(((2*IPT-ONE)/NPTT)-ONE) *
1065 . STACK%GEO(IPTHK+ILAY,ISUBSTACK)
1066 DO I=1,NEL
1067 N = I + NFT
1068 THK = GBUF%THK(I)
1069 VALUE(1) = A1*EPSDOT(1,I+NFT+OFFSET) + A2*EPSDOT(4,I+NFT+OFFSET)*THK
1070 VALUE(2) = A1*EPSDOT(2,I+NFT+OFFSET) + A2*EPSDOT(5,I+NFT+OFFSET)*THK
1071 VALUE(3) = (A1*EPSDOT(3,I+NFT+OFFSET) + A2*EPSDOT(6,I+NFT+OFFSET)*THK)* HALF
1072 CALL H3D_WRITE_SH_TENSOR(IOK_PART,ISELECT,IS_WRITTEN_SHELL,SHELL_TENSOR,I,OFFSET,NFT,
1073 . VALUE)
1074 ENDDO
1075 ENDIF
1076 ENDIF
1077c PLY=NULL ILAYER=IL NPT=NULL
1078.AND..AND..AND. ELSEIF (IPLY == -1 ILAY <= NLAY ILAY > 0 IPT == -1 ) THEN
1079.OR..OR..OR. IF (IGTYP == 10 IGTYP == 11 IGTYP == 16 IGTYP == 17) THEN
1080 A1 = ONE
1081 A2 = HALF*(((2*ILAY-ONE)/NLAY)-ONE)
1082 DO I=1,NEL
1083 N = I + NFT
1084 THK = GBUF%THK(I)
1085 VALUE(1) = A1*EPSDOT(1,I+NFT+OFFSET) + A2*EPSDOT(4,I+NFT+OFFSET)*THK
1086 VALUE(2) = A1*EPSDOT(2,I+NFT+OFFSET) + A2*EPSDOT(5,I+NFT+OFFSET)*THK
1087 VALUE(3) = (A1*EPSDOT(3,I+NFT+OFFSET) + A2*EPSDOT(6,I+NFT+OFFSET)*THK)* HALF
1088 CALL H3D_WRITE_SH_TENSOR(IOK_PART,ISELECT,IS_WRITTEN_SHELL,SHELL_TENSOR,I,OFFSET,NFT,
1089 . VALUE)
1090 ENDDO
1091.OR. ELSEIF (IGTYP == 51 IGTYP == 52) THEN
1092 A1 = ONE
1093 A2 = STACK%GEO(IPPOS+ILAY,ISUBSTACK)+
1094 . HALF*(((2*IPT-ONE)/NPTT)-ONE) *
1095 . STACK%GEO(IPTHK+ILAY,ISUBSTACK)
1096 DO I=1,NEL
1097 N = I + NFT
1098 THK = GBUF%THK(I)
1099 VALUE(1) = A1*EPSDOT(1,I+NFT+OFFSET) + A2*EPSDOT(4,I+NFT+OFFSET)*THK
1100 VALUE(2) = A1*EPSDOT(2,I+NFT+OFFSET) + A2*EPSDOT(5,I+NFT+OFFSET)*THK
1101 VALUE(3) = (A1*EPSDOT(3,I+NFT+OFFSET) + A2*EPSDOT(6,I+NFT+OFFSET)*THK)* HALF
1102 CALL H3D_WRITE_SH_TENSOR(IOK_PART,ISELECT,IS_WRITTEN_SHELL,SHELL_TENSOR,I,OFFSET,NFT,
1103 . VALUE)
1104 ENDDO
1105 ENDIF
1106c PLY=NULL ILAYER=NULL NPT=IPT
1107.AND. ELSEIF ( IPT <= MPT IPT > 0) THEN
1108 A1 = ONE
1109 A2 = HALF*(((2*IPT-ONE)/MPT)-ONE)
1110.OR. IF (IGTYP == 1 IGTYP == 9) THEN
1111 DO I=1,NEL
1112 THK = GBUF%THK(I)
1113 VALUE(1) = A1*EPSDOT(1,I+NFT+OFFSET) + A2*EPSDOT(4,I+NFT+OFFSET)*THK
1114 VALUE(2) = A1*EPSDOT(2,I+NFT+OFFSET) + A2*EPSDOT(5,I+NFT+OFFSET)*THK
1115 VALUE(3) = (A1*EPSDOT(3,I+NFT+OFFSET) + A2*EPSDOT(6,I+NFT+OFFSET)*THK)* HALF
1116 CALL H3D_WRITE_SH_TENSOR(IOK_PART,ISELECT,IS_WRITTEN_SHELL,SHELL_TENSOR,I,OFFSET,NFT,
1117 . VALUE)
1118 ENDDO
1119 ENDIF
1120 ENDIF
1121C--------------------------------------------------
1122 ELSE IF (KEYWORD == 'tens/strain_eng') THEN
1123C--------------------------------------------------
1124 IF (ITY == 3 ) THEN !4n
1125 DO I=1,NEL
1126 N = I + NFT
1127 NNI = IXC(2,N)
1128 J = 4*(I-1) +1
1129 XN(J)=X(1,NNI)
1130 YN(J)=X(2,NNI)
1131 ZN(J)=X(3,NNI)
1132 DXN(J)=D(1,NNI)
1133 DYN(J)=D(2,NNI)
1134 DZN(J)=D(3,NNI)
1135 NNI = IXC(3,N)
1136 XN(J+1)=X(1,NNI)
1137 YN(J+1)=X(2,NNI)
1138 ZN(J+1)=X(3,NNI)
1139 DXN(J+1)=D(1,NNI)
1140 DYN(J+1)=D(2,NNI)
1141 DZN(J+1)=D(3,NNI)
1142 NNI = IXC(4,N)
1143 XN(J+2)=X(1,NNI)
1144 YN(J+2)=X(2,NNI)
1145 ZN(J+2)=X(3,NNI)
1146 DXN(J+2)=D(1,NNI)
1147 DYN(J+2)=D(2,NNI)
1148 DZN(J+2)=D(3,NNI)
1149 NNI = IXC(5,N)
1150 XN(J+3)=X(1,NNI)
1151 YN(J+3)=X(2,NNI)
1152 ZN(J+3)=X(3,NNI)
1153 DXN(J+3)=D(1,NNI)
1154 DYN(J+3)=D(2,NNI)
1155 DZN(J+3)=D(3,NNI)
1156 STRAIN(1:3,I)=ZERO
1157 ENDDO
1158 CALL SH4_TSTRAIN(XN,YN,ZN,DXN,DYN,DZN,STRAIN,NEL)
1159 DO I=1,NEL
1160 VALUE(1:3)= STRAIN(1:3,I)
1161 CALL H3D_WRITE_SH_TENSOR(IOK_PART,ISELECT,IS_WRITTEN_SHELL,SHELL_TENSOR,I,OFFSET,NFT,
1162 . VALUE)
1163 ENDDO
1164 ELSEIF (ITY == 7) THEN
1165 DO I=1,NEL
1166 N = I + NFT
1167 NNI = IXTG(2,N)
1168 J = 3*(I-1) +1
1169 XN(J)=X(1,NNI)
1170 YN(J)=X(2,NNI)
1171 ZN(J)=X(3,NNI)
1172 DXN(J)=D(1,NNI)
1173 DYN(J)=D(2,NNI)
1174 DZN(J)=D(3,NNI)
1175 NNI = IXTG(3,N)
1176 XN(J+1)=X(1,NNI)
1177 YN(J+1)=X(2,NNI)
1178 ZN(J+1)=X(3,NNI)
1179 DXN(J+1)=D(1,NNI)
1180 DYN(J+1)=D(2,NNI)
1181 DZN(J+1)=D(3,NNI)
1182 NNI = IXTG(4,N)
1183 XN(J+2)=X(1,NNI)
1184 YN(J+2)=X(2,NNI)
1185 ZN(J+2)=X(3,NNI)
1186 DXN(J+2)=D(1,NNI)
1187 DYN(J+2)=D(2,NNI)
1188 DZN(J+2)=D(3,NNI)
1189 STRAIN(1:3,I)=ZERO
1190 ENDDO
1191 CALL SH3_TSTRAIN(XN,YN,ZN,DXN,DYN,DZN,STRAIN,NEL,IHBE)
1192 DO I=1,NEL
1193 VALUE(1:3)= STRAIN(1:3,I)
1194 CALL H3D_WRITE_SH_TENSOR(IOK_PART,ISELECT,IS_WRITTEN_SHELL,SHELL_TENSOR,I,OFFSET,NFT,
1195 . VALUE)
1196 ENDDO
1197 END IF
1198C--------------------------------------------------
1199C-----------------------------------------------
1200 ELSEIF (KEYWORD == 'tens/stress/tmax') THEN
1201C---------- -------------------------------------
1202 DO I=1,NEL
1203 VALUE(1:3) = GBUF%TM_SIG1(JJ(1:3) + I)
1204 CALL H3D_WRITE_SH_TENSOR(IOK_PART,ISELECT,IS_WRITTEN_SHELL,SHELL_TENSOR,I,OFFSET,NFT,
1205 . VALUE)
1206 ENDDO
1207C---------- -------------------------------------
1208 ELSEIF (KEYWORD == 'tens/stress/tmin') THEN
1209C---------- -------------------------------------
1210 DO I=1,NEL
1211 VALUE(1:3) = GBUF%TM_SIG3(JJ(1:3) + I)
1212 CALL H3D_WRITE_SH_TENSOR(IOK_PART,ISELECT,IS_WRITTEN_SHELL,SHELL_TENSOR,I,OFFSET,NFT,
1213 . VALUE)
1214 ENDDO
1215C---------- -------------------------------------
1216 ELSEIF (KEYWORD == 'tens/strain/tmax') THEN
1217C---------- -------------------------------------
1218 DO I=1,NEL
1219 VALUE(1:3) = GBUF%TM_STRA1(JJ(1:3) + I)
1220 CALL H3D_WRITE_SH_TENSOR(IOK_PART,ISELECT,IS_WRITTEN_SHELL,SHELL_TENSOR,I,OFFSET,NFT,
1221 . VALUE)
1222 ENDDO
1223C---------- -------------------------------------
1224 ELSEIF (KEYWORD == 'tens/strain/tmin') THEN
1225C---------- -------------------------------------
1226 DO I=1,NEL
1227 VALUE(1:3) = GBUF%TM_STRA3(JJ(1:3) + I)
1228 CALL H3D_WRITE_SH_TENSOR(IOK_PART,ISELECT,IS_WRITTEN_SHELL,SHELL_TENSOR,I,OFFSET,NFT,
1229 . VALUE)
1230 ENDDO
1231C--------------------------------------------------
1232 ELSEIF (KEYWORD == 'tens/bstress') THEN
1233C--------------------------------------------------
1234 IF (MLW == 87) THEN
1235 IMAT = IXC(1,NFT+1)
1236 IADBUF = IPM(7,IMAT)
1237 NUPARAM= IPM(9,IMAT)
1238 UPARAM => BUFMAT(IADBUF:IADBUF+NUPARAM)
1239 NBFUNCT = UPARAM(25)
1240 NCHARD = 34 + 2*NBFUNCT + 22
1241 CHARD = UPARAM (NCHARD)
1242 ELSEIF (MLW == 36) THEN
1243 IMAT = IXC(1,NFT+1)
1244 IADBUF = IPM(7,IMAT)
1245 NUPARAM= IPM(9,IMAT)
1246 UPARAM => BUFMAT(IADBUF:IADBUF+NUPARAM)
1247 NBFUNCT = UPARAM(1)
1248 NCHARD = 2*NBFUNCT + 14
1249 CHARD = UPARAM (NCHARD)
1250 ENDIF
1251.AND..AND. IF ( ILAY == -1 IPT == -1 IPLY == -1) THEN !global value = mean on gauss points IPs and layers
1252 IF(ID == -1) THEN ! sum of all backstresses
1253.AND. IF(MLW == 36 CHARD > ZERO) THEN
1254 DO I=1,NEL
1255 DO J=1,NLAY
1256 BUFLY => ELBUF_TAB(NG)%BUFLY(J)
1257 NPTT = BUFLY%NPTT
1258 DO IR=1,NPTR
1259 DO IS=1,NPTS
1260 DO IT=1,NPTT
1261 LBUF => ELBUF_TAB(NG)%BUFLY(J)%LBUF(IR,IS,IT)
1262 DO K=1,3
1263 VALUE(K) = VALUE(K) + LBUF%SIGB(JJ(K) + I)/NPG/NPTT/NLAY
1264 ENDDO !K
1265 ENDDO !IT
1266 ENDDO !IS
1267 ENDDO !IR
1268 ENDDO !Jlay
1269 CALL H3D_WRITE_SH_TENSOR(IOK_PART,ISELECT,IS_WRITTEN_SHELL,SHELL_TENSOR,I,OFFSET,NFT,VALUE )
1270 ENDDO !I
1271 ELSEIF(MLW == 78) THEN
1272 DO I=1,NEL
1273 DO J=1,NLAY
1274 BUFLY => ELBUF_TAB(NG)%BUFLY(J)
1275 NPTT = BUFLY%NPTT
1276 DO IR=1,NPTR
1277 DO IS=1,NPTS
1278 DO IT=1,NPTT
1279 LBUF => ELBUF_TAB(NG)%BUFLY(J)%LBUF(IR,IS,IT)
1280 DO K=1,3
1281 VALUE(K) = VALUE(K) + (LBUF%SIGA(JJ(K) + I)+LBUF%SIGB(JJ(K) + I))/NPG/NPTT/NLAY
1282 ENDDO !K
1283 ENDDO !IT
1284 ENDDO !IS
1285 ENDDO !IR
1286 ENDDO !Jlay
1287 CALL H3D_WRITE_SH_TENSOR(IOK_PART,ISELECT,IS_WRITTEN_SHELL,SHELL_TENSOR,I,OFFSET,NFT,VALUE )
1288 ENDDO !I
1289.AND. ELSEIF(MLW == 87 CHARD > ZERO) THEN
1290 !SIGBXX(I) = SIGB(I,1) + SIGB(I,4) + SIGB(I,7) + SIGB(I,10)
1291 !SIGBYY(I) = SIGB(I,2) + SIGB(I,5) + SIGB(I,8) + SIGB(I,11)
1292 !SIGBXY(I) = SIGB(I,3) + SIGB(I,6) + SIGB(I,9) + SIGB(I,12)
1293 DO I=1,NEL
1294 DO J=1,NLAY
1295 BUFLY => ELBUF_TAB(NG)%BUFLY(J)
1296 NPTT = BUFLY%NPTT
1297 DO IR=1,NPTR
1298 DO IS=1,NPTS
1299 DO IT=1,NPTT
1300 LBUF => ELBUF_TAB(NG)%BUFLY(J)%LBUF(IR,IS,IT)
1301 DO K=1,3
1302 VALUE(K) = VALUE(K) + (LBUF%SIGB(JJ(K) + I )
1303 . +LBUF%SIGB(JJ(K+3) + I )
1304 . +LBUF%SIGB(JJ(K+6) + I )
1305 . +LBUF%SIGB(JJ(K+9) + I ))/NPG/NPTT/NLAY
1306 ENDDO !K
1307 ENDDO !IT
1308 ENDDO !IS
1309 ENDDO !IR
1310 ENDDO !Jlay
1311 CALL H3D_WRITE_SH_TENSOR(IOK_PART,ISELECT,IS_WRITTEN_SHELL,SHELL_TENSOR,I,OFFSET,NFT,VALUE )
1312 ENDDO !I
1313 ENDIF ! MLW==
1314 ELSEIF(ID > 0) THEN !!
1315.AND. IF(MLW == 36 CHARD > ZERO) THEN ! forcement ID=1 y a qu une BS
1316 DO I=1,NEL
1317 DO J=1,NLAY
1318 BUFLY => ELBUF_TAB(NG)%BUFLY(J)
1319 NPTT = BUFLY%NPTT
1320 DO IR=1,NPTR
1321 DO IS=1,NPTS
1322 DO IT=1,NPTT
1323 LBUF => ELBUF_TAB(NG)%BUFLY(J)%LBUF(IR,IS,IT)
1324 DO K=1,3
1325 VALUE(K) = VALUE(K) + LBUF%SIGB(JJ(K) + I)/NPG/NPTT/NLAY
1326 ENDDO !K
1327 ENDDO !IT
1328 ENDDO !IS
1329 ENDDO !IR
1330 ENDDO !Jlay
1331 CALL H3D_WRITE_SH_TENSOR(IOK_PART,ISELECT,IS_WRITTEN_SHELL,SHELL_TENSOR,I,OFFSET,NFT,VALUE )
1332 ENDDO !I
1333 ELSEIF(MLW == 78) THEN
1334 IF(ID == 1) THEN
1335 DO I=1,NEL
1336 DO J=1,NLAY
1337 BUFLY => ELBUF_TAB(NG)%BUFLY(J)
1338 NPTT = BUFLY%NPTT
1339 DO IR=1,NPTR
1340 DO IS=1,NPTS
1341 DO IT=1,NPTT
1342 LBUF => ELBUF_TAB(NG)%BUFLY(J)%LBUF(IR,IS,IT)
1343 DO K=1,3
1344 VALUE(K) = VALUE(K) + LBUF%SIGA(JJ(K) + I) /NPG/NPTT/NLAY
1345 ENDDO !K
1346 ENDDO !IT
1347 ENDDO !IS
1348 ENDDO !IR
1349 ENDDO !Jlay
1350 CALL H3D_WRITE_SH_TENSOR(IOK_PART,ISELECT,IS_WRITTEN_SHELL,SHELL_TENSOR,I,OFFSET,NFT,VALUE )
1351 ENDDO !I
1352 ELSEIF(ID == 2) THEN
1353 DO I=1,NEL
1354 DO J=1,NLAY
1355 BUFLY => ELBUF_TAB(NG)%BUFLY(J)
1356 NPTT = BUFLY%NPTT
1357 DO IR=1,NPTR
1358 DO IS=1,NPTS
1359 DO IT=1,NPTT
1360 LBUF => ELBUF_TAB(NG)%BUFLY(J)%LBUF(IR,IS,IT)
1361 DO K=1,3
1362 VALUE(K) = VALUE(K) + LBUF%SIGB(JJ(K) + I) /NPG/NPTT/NLAY
1363 ENDDO !K
1364 ENDDO !IT
1365 ENDDO !IS
1366 ENDDO !IR
1367 ENDDO !Jlay
1368 CALL H3D_WRITE_SH_TENSOR(IOK_PART,ISELECT,IS_WRITTEN_SHELL,SHELL_TENSOR,I,OFFSET,NFT,VALUE )
1369 ENDDO !I
1370 ELSEIF(ID == 3) THEN
1371 DO I=1,NEL
1372 DO J=1,NLAY
1373 BUFLY => ELBUF_TAB(NG)%BUFLY(J)
1374 NPTT = BUFLY%NPTT
1375 DO IR=1,NPTR
1376 DO IS=1,NPTS
1377 DO IT=1,NPTT
1378 LBUF => ELBUF_TAB(NG)%BUFLY(J)%LBUF(IR,IS,IT)
1379 DO K=1,3
1380 VALUE(K) = VALUE(K) + LBUF%SIGC(JJ(K) + I) /NPG/NPTT/NLAY
1381 ENDDO !K
1382 ENDDO !IT
1383 ENDDO !IS
1384 ENDDO !IR
1385 ENDDO !Jlay
1386 CALL H3D_WRITE_SH_TENSOR(IOK_PART,ISELECT,IS_WRITTEN_SHELL,SHELL_TENSOR,I,OFFSET,NFT,VALUE )
1387 ENDDO !I
1388 ENDIF !ID ==
1389.AND. ELSEIF(MLW == 87 CHARD > ZERO) THEN
1390 IF(ID == 1) THEN
1391 DO I=1,NEL
1392 DO J=1,NLAY
1393 BUFLY => ELBUF_TAB(NG)%BUFLY(J)
1394 NPTT = BUFLY%NPTT
1395 DO IR=1,NPTR
1396 DO IS=1,NPTS
1397 DO IT=1,NPTT
1398 LBUF => ELBUF_TAB(NG)%BUFLY(J)%LBUF(IR,IS,IT)
1399 DO K=1,3
1400 VALUE(K) = VALUE(K) + LBUF%SIGB(JJ(K) + I ) /NPG/NPTT/NLAY
1401 ENDDO !K
1402 ENDDO !IT
1403 ENDDO !IS
1404 ENDDO !IR
1405 ENDDO !Jlay
1406 CALL H3D_WRITE_SH_TENSOR(IOK_PART,ISELECT,IS_WRITTEN_SHELL,SHELL_TENSOR,I,OFFSET,NFT,VALUE )
1407 ENDDO !I
1408 ELSEIF(ID == 2) THEN
1409 DO I=1,NEL
1410 DO J=1,NLAY
1411 BUFLY => ELBUF_TAB(NG)%BUFLY(J)
1412 NPTT = BUFLY%NPTT
1413 DO IR=1,NPTR
1414 DO IS=1,NPTS
1415 DO IT=1,NPTT
1416 LBUF => ELBUF_TAB(NG)%BUFLY(J)%LBUF(IR,IS,IT)
1417 DO K=1,3
1418 VALUE(K) = VALUE(K) + LBUF%SIGB(JJ(K+3) + I) /NPG/NPTT/NLAY
1419 ENDDO !K
1420 ENDDO !IT
1421 ENDDO !IS
1422 ENDDO !IR
1423 ENDDO !Jlay
1424 CALL H3D_WRITE_SH_TENSOR(IOK_PART,ISELECT,IS_WRITTEN_SHELL,SHELL_TENSOR,I,OFFSET,NFT,VALUE )
1425 ENDDO !I
1426 ELSEIF(ID == 3) THEN
1427 DO I=1,NEL
1428 DO J=1,NLAY
1429 BUFLY => ELBUF_TAB(NG)%BUFLY(J)
1430 NPTT = BUFLY%NPTT
1431 DO IR=1,NPTR
1432 DO IS=1,NPTS
1433 DO IT=1,NPTT
1434 LBUF => ELBUF_TAB(NG)%BUFLY(J)%LBUF(IR,IS,IT)
1435 DO K=1,3
1436 VALUE(K) = VALUE(K) + LBUF%SIGB(JJ(K+6) + I) /NPG/NPTT/NLAY
1437 ENDDO !K
1438 ENDDO !IT
1439 ENDDO !IS
1440 ENDDO !IR
1441 ENDDO !Jlay
1442 CALL H3D_WRITE_SH_TENSOR(IOK_PART,ISELECT,IS_WRITTEN_SHELL,SHELL_TENSOR,I,OFFSET,NFT,VALUE )
1443 ENDDO !I
1444 ELSEIF( ID == 4) THEN
1445 DO I=1,NEL
1446 DO J=1,NLAY
1447 BUFLY => ELBUF_TAB(NG)%BUFLY(J)
1448 NPTT = BUFLY%NPTT
1449 DO IR=1,NPTR
1450 DO IS=1,NPTS
1451 DO IT=1,NPTT
1452 LBUF => ELBUF_TAB(NG)%BUFLY(J)%LBUF(IR,IS,IT)
1453 DO K=1,3
1454 VALUE(K) = VALUE(K) + LBUF%SIGB(JJ(K+9) + I)/NPG/NPTT/NLAY
1455 ENDDO !K
1456 ENDDO !IT
1457 ENDDO !IS
1458 ENDDO !IR
1459 ENDDO !Jlay
1460 CALL H3D_WRITE_SH_TENSOR(IOK_PART,ISELECT,IS_WRITTEN_SHELL,SHELL_TENSOR,I,OFFSET,NFT,VALUE )
1461 ENDDO !I
1462 ENDIF !(ID == )
1463 ENDIF!(MLW ==
1464 ENDIF !(ID >0 )
1465C--------------------------------------------------
1466c PLY=IPLY NPT=IPT pour prop avec ply 17-51-52
1467C--------------------------------------------------
1468.AND..AND. ELSEIF ( IPLY > 0 IPT <= MPT IPT > 0 ) THEN
1469 DO J=1,NLAY
1470 ID_PLY = 0
1471.OR. IF (IGTYP == 17 IGTYP == 51) THEN
1472 ID_PLY = IGEO(1,STACK%IGEO(2+J,ISUBSTACK))
1473 ELSEIF (IGTYP == 52) THEN
1474 ID_PLY = PLY_INFO(1,STACK%IGEO(2+J,ISUBSTACK) - NUMSTACK)
1475 ENDIF
1476 IF (ID_PLY == IPLY) THEN
1477 BUFLY => ELBUF_TAB(NG)%BUFLY(J)
1478 !--------
1479 ! LAW36
1480 !--------
1481.AND..OR..AND. IF (MLW == 36 ( ID == -1 ID == 1) CHARD > ZERO) THEN
1482 DO I=1,NEL
1483 DO IR=1,NPTR
1484 DO IS=1,NPTS
1485 LBUF => ELBUF_TAB(NG)%BUFLY(J)%LBUF(IR,IS,IPT)
1486 DO K=1,3
1487 VALUE(K) = VALUE(K) + LBUF%SIGB(JJ(K) + I)/NPG
1488 ENDDO !k
1489 ENDDO !IS
1490 ENDDO !IR
1491 CALL H3D_WRITE_SH_TENSOR(IOK_PART,ISELECT,IS_WRITTEN_SHELL,SHELL_TENSOR,I,OFFSET,NFT,VALUE)
1492 ENDDO ! I
1493 !--------
1494 ! LAW78
1495 !--------
1496 ELSEIF (MLW == 78) THEN
1497 IF(ID == -1) THEN ! somme of all backstresses
1498 DO I=1,NEL
1499 DO IR=1,NPTR
1500 DO IS=1,NPTS
1501 LBUF => ELBUF_TAB(NG)%BUFLY(J)%LBUF(IR,IS,IPT)
1502 DO K=1,3
1503 VALUE(K) = VALUE(K) + (LBUF%SIGA(JJ(K) + I)+LBUF%SIGB(JJ(K) + I))/NPG
1504 ENDDO !k
1505 ENDDO !IS
1506 ENDDO !IR
1507 CALL H3D_WRITE_SH_TENSOR(IOK_PART,ISELECT,IS_WRITTEN_SHELL,SHELL_TENSOR,I,OFFSET,NFT,VALUE)
1508 ENDDO ! I
1509 ELSEIF(ID ==1 ) THEN
1510 DO I=1,NEL
1511 DO IR=1,NPTR
1512 DO IS=1,NPTS
1513 LBUF => ELBUF_TAB(NG)%BUFLY(J)%LBUF(IR,IS,IPT)
1514 DO K=1,3
1515 VALUE(K) = VALUE(K) + LBUF%SIGA(JJ(K) + I)/NPG
1516 ENDDO !k
1517 ENDDO !IS
1518 ENDDO !IR
1519 CALL H3D_WRITE_SH_TENSOR(IOK_PART,ISELECT,IS_WRITTEN_SHELL,SHELL_TENSOR,I,OFFSET,NFT,VALUE)
1520 ENDDO ! I
1521 ELSEIF(ID ==2 ) THEN
1522 DO I=1,NEL
1523 DO IR=1,NPTR
1524 DO IS=1,NPTS
1525 LBUF => ELBUF_TAB(NG)%BUFLY(J)%LBUF(IR,IS,IPT)
1526 DO K=1,3
1527 VALUE(K) = VALUE(K) + LBUF%SIGB(JJ(K) + I)/NPG
1528 ENDDO !k
1529 ENDDO !IS
1530 ENDDO !IR
1531 CALL H3D_WRITE_SH_TENSOR(IOK_PART,ISELECT,IS_WRITTEN_SHELL,SHELL_TENSOR,I,OFFSET,NFT,VALUE)
1532 ENDDO ! I
1533
1534 ELSEIF(ID ==3 ) THEN
1535 DO I=1,NEL
1536 DO IR=1,NPTR
1537 DO IS=1,NPTS
1538 LBUF => ELBUF_TAB(NG)%BUFLY(J)%LBUF(IR,IS,IPT)
1539 DO K=1,3
1540 VALUE(K) = VALUE(K) + LBUF%SIGC(JJ(K) + I)/NPG
1541 ENDDO !k
1542 ENDDO !IS
1543 ENDDO !IR
1544 CALL H3D_WRITE_SH_TENSOR(IOK_PART,ISELECT,IS_WRITTEN_SHELL,SHELL_TENSOR,I,OFFSET,NFT,VALUE)
1545 ENDDO ! I
1546 ENDIF !ID == -1
1547 !--------
1548 ! LAW87
1549 !--------
1550.AND. ELSEIF( MLW == 87 CHARD > ZERO) THEN
1551 IF(ID == -1) THEN ! somme of all backstresses
1552 DO I=1,NEL
1553 DO IR=1,NPTR
1554 DO IS=1,NPTS
1555 LBUF => ELBUF_TAB(NG)%BUFLY(J)%LBUF(IR,IS,IPT)
1556 DO K=1,3
1557 VALUE(K) = VALUE(K) + (LBUF%SIGB(JJ(K) + I )
1558 . +LBUF%SIGB(JJ(K+3) + I )
1559 . +LBUF%SIGB(JJ(K+6) + I )
1560 . +LBUF%SIGB(JJ(K+9) + I ))/NPG
1561
1562 ENDDO !k
1563 ENDDO !IS
1564 ENDDO !IR
1565 CALL H3D_WRITE_SH_TENSOR(IOK_PART,ISELECT,IS_WRITTEN_SHELL,SHELL_TENSOR,I,OFFSET,NFT,VALUE)
1566 ENDDO ! I
1567 ELSEIF(ID ==1 ) THEN
1568 DO I=1,NEL
1569 DO IR=1,NPTR
1570 DO IS=1,NPTS
1571 LBUF => ELBUF_TAB(NG)%BUFLY(J)%LBUF(IR,IS,IPT)
1572 DO K=1,3
1573 VALUE(K) = VALUE(K) + LBUF%SIGB(JJ(K) + I)/NPG
1574 ENDDO !k
1575 ENDDO !IS
1576 ENDDO !IR
1577 CALL H3D_WRITE_SH_TENSOR(IOK_PART,ISELECT,IS_WRITTEN_SHELL,SHELL_TENSOR,I,OFFSET,NFT,VALUE)
1578 ENDDO ! I
1579 ELSEIF(ID ==2 ) THEN
1580 DO I=1,NEL
1581 DO IR=1,NPTR
1582 DO IS=1,NPTS
1583 LBUF => ELBUF_TAB(NG)%BUFLY(J)%LBUF(IR,IS,IPT)
1584 DO K=1,3
1585 VALUE(K) = VALUE(K) + LBUF%SIGB(JJ(K+3) + I)/NPG
1586 ENDDO !k
1587 ENDDO !IS
1588 ENDDO !IR
1589 CALL H3D_WRITE_SH_TENSOR(IOK_PART,ISELECT,IS_WRITTEN_SHELL,SHELL_TENSOR,I,OFFSET,NFT,VALUE)
1590 ENDDO ! I
1591 ELSEIF(ID ==3 ) THEN
1592 DO I=1,NEL
1593 DO IR=1,NPTR
1594 DO IS=1,NPTS
1595 LBUF => ELBUF_TAB(NG)%BUFLY(J)%LBUF(IR,IS,IPT)
1596 DO K=1,3
1597 VALUE(K) = VALUE(K) + LBUF%SIGB(JJ(K+6) + I)/NPG
1598 ENDDO !k
1599 ENDDO !IS
1600 ENDDO !IR
1601 CALL H3D_WRITE_SH_TENSOR(IOK_PART,ISELECT,IS_WRITTEN_SHELL,SHELL_TENSOR,I,OFFSET,NFT,VALUE)
1602 ENDDO ! I
1603 ELSEIF(ID ==4 ) THEN
1604 DO I=1,NEL
1605 DO IR=1,NPTR
1606 DO IS=1,NPTS
1607 LBUF => ELBUF_TAB(NG)%BUFLY(J)%LBUF(IR,IS,IPT)
1608 DO K=1,3
1609 VALUE(K) = VALUE(K) + LBUF%SIGB(JJ(K+9) + I)/NPG
1610 ENDDO !k
1611 ENDDO !IS
1612 ENDDO !IR
1613 CALL H3D_WRITE_SH_TENSOR(IOK_PART,ISELECT,IS_WRITTEN_SHELL,SHELL_TENSOR,I,OFFSET,NFT,VALUE)
1614 ENDDO ! I
1615 ENDIF !ID == -1
1616 ENDIF !(MLW ==
1617 END IF !(ID_PLY == IPLY
1618 ENDDO !JLAY
1619C--------------------------------------------------
1620c PLY=NULL ILAYER=IL NPT=IPT
1621C--------------------------------------------------
1622.AND..AND..AND. ELSEIF (ILAY > 0 ILAY <= NLAY IPT <= MPT IPT > 0 ) THEN
1623 J = ILAY
1624 IF(IGTYP == 9) J = 1
1625 BUFLY => ELBUF_TAB(NG)%BUFLY(J)
1626 !--------
1627 ! LAW36
1628 !--------
1629.AND..AND. IF (MLW == 36 (ID==-1 . OR .ID==1) CHARD > ZERO) THEN
1630 DO I=1,NEL
1631 DO IR=1,NPTR
1632 DO IS=1,NPTS
1633 LBUF => ELBUF_TAB(NG)%BUFLY(J)%LBUF(IR,IS,IPT)
1634 DO K=1,3
1635 VALUE(K) = VALUE(K) + LBUF%SIGB(JJ(K) + I)/NPG
1636 ENDDO !k
1637 ENDDO !IS
1638 ENDDO !IR
1639 CALL H3D_WRITE_SH_TENSOR(IOK_PART,ISELECT,IS_WRITTEN_SHELL,SHELL_TENSOR,I,OFFSET,NFT,VALUE)
1640 ENDDO ! I
1641 !--------
1642 ! LAW78
1643 !--------
1644 ELSEIF (MLW == 78) THEN
1645 IF(ID == -1) THEN ! somme of all backstresses
1646 DO I=1,NEL
1647 DO IR=1,NPTR
1648 DO IS=1,NPTS
1649 LBUF => ELBUF_TAB(NG)%BUFLY(J)%LBUF(IR,IS,IPT)
1650 DO K=1,3
1651 VALUE(K) = VALUE(K) + (LBUF%SIGA(JJ(K) + I)+LBUF%SIGB(JJ(K) + I))/NPG
1652 ENDDO !k
1653 ENDDO !IS
1654 ENDDO !IR
1655 CALL H3D_WRITE_SH_TENSOR(IOK_PART,ISELECT,IS_WRITTEN_SHELL,SHELL_TENSOR,I,OFFSET,NFT,VALUE)
1656 ENDDO ! I
1657 ELSEIF(ID ==1 ) THEN
1658 DO I=1,NEL
1659 DO IR=1,NPTR
1660 DO IS=1,NPTS
1661 LBUF => ELBUF_TAB(NG)%BUFLY(J)%LBUF(IR,IS,IPT)
1662 DO K=1,3
1663 VALUE(K) = VALUE(K) + LBUF%SIGA(JJ(K) + I)/NPG
1664 ENDDO !k
1665 ENDDO !IS
1666 ENDDO !IR
1667 CALL H3D_WRITE_SH_TENSOR(IOK_PART,ISELECT,IS_WRITTEN_SHELL,SHELL_TENSOR,I,OFFSET,NFT,VALUE)
1668 ENDDO ! I
1669 ELSEIF(ID ==2 ) THEN
1670 DO I=1,NEL
1671 DO IR=1,NPTR
1672 DO IS=1,NPTS
1673 LBUF => ELBUF_TAB(NG)%BUFLY(J)%LBUF(IR,IS,IPT)
1674 DO K=1,3
1675 VALUE(K) = VALUE(K) + LBUF%SIGB(JJ(K) + I)/NPG
1676 ENDDO !k
1677 ENDDO !IS
1678 ENDDO !IR
1679 CALL H3D_WRITE_SH_TENSOR(IOK_PART,ISELECT,IS_WRITTEN_SHELL,SHELL_TENSOR,I,OFFSET,NFT,VALUE)
1680 ENDDO ! I
1681 ELSEIF(ID ==3 ) THEN
1682 DO I=1,NEL
1683 DO IR=1,NPTR
1684 DO IS=1,NPTS
1685 LBUF => ELBUF_TAB(NG)%BUFLY(J)%LBUF(IR,IS,IPT)
1686 DO K=1,3
1687 VALUE(K) = VALUE(K) + LBUF%SIGC(JJ(K) + I)/NPG
1688 ENDDO !k
1689 ENDDO !IS
1690 ENDDO !IR
1691 CALL H3D_WRITE_SH_TENSOR(IOK_PART,ISELECT,IS_WRITTEN_SHELL,SHELL_TENSOR,I,OFFSET,NFT,VALUE)
1692 ENDDO ! I
1693 ENDIF !ID == -1
1694 !--------
1695 ! LAW87
1696 !--------
1697.AND. ELSEIF( MLW == 87 CHARD > ZERO) THEN
1698 IF(ID == -1) THEN ! somme of all backstresses
1699 DO I=1,NEL
1700 DO IR=1,NPTR
1701 DO IS=1,NPTS
1702 LBUF => ELBUF_TAB(NG)%BUFLY(J)%LBUF(IR,IS,IPT)
1703 DO K=1,3
1704 VALUE(K) = VALUE(K) + (LBUF%SIGB(JJ(K) + I )
1705 . +LBUF%SIGB(JJ(K+3) + I )
1706 . +LBUF%SIGB(JJ(K+6) + I )
1707 . +LBUF%SIGB(JJ(K+9) + I ))/NPG
1708
1709 ENDDO !k
1710 ENDDO !IS
1711 ENDDO !IR
1712 CALL H3D_WRITE_SH_TENSOR(IOK_PART,ISELECT,IS_WRITTEN_SHELL,SHELL_TENSOR,I,OFFSET,NFT,VALUE)
1713 ENDDO ! I
1714 ELSEIF(ID ==1 ) THEN
1715 DO I=1,NEL
1716 DO IR=1,NPTR
1717 DO IS=1,NPTS
1718 LBUF => ELBUF_TAB(NG)%BUFLY(J)%LBUF(IR,IS,IPT)
1719 DO K=1,3
1720 VALUE(K) = VALUE(K) + LBUF%SIGB(JJ(K) + I)/NPG
1721 ENDDO !k
1722 ENDDO !IS
1723 ENDDO !IR
1724 CALL H3D_WRITE_SH_TENSOR(IOK_PART,ISELECT,IS_WRITTEN_SHELL,SHELL_TENSOR,I,OFFSET,NFT,VALUE)
1725 ENDDO ! I
1726 ELSEIF(ID ==2 ) THEN
1727 DO I=1,NEL
1728 DO IR=1,NPTR
1729 DO IS=1,NPTS
1730 LBUF => ELBUF_TAB(NG)%BUFLY(J)%LBUF(IR,IS,IPT)
1731 DO K=1,3
1732 VALUE(K) = VALUE(K) + LBUF%SIGB(JJ(K+3) + I)/NPG
1733 ENDDO !k
1734 ENDDO !IS
1735 ENDDO !IR
1736 CALL H3D_WRITE_SH_TENSOR(IOK_PART,ISELECT,IS_WRITTEN_SHELL,SHELL_TENSOR,I,OFFSET,NFT,VALUE)
1737 ENDDO ! I
1738 ELSEIF(ID ==3 ) THEN
1739 DO I=1,NEL
1740 DO IR=1,NPTR
1741 DO IS=1,NPTS
1742 LBUF => ELBUF_TAB(NG)%BUFLY(J)%LBUF(IR,IS,IPT)
1743 DO K=1,3
1744 VALUE(K) = VALUE(K) + LBUF%SIGB(JJ(K+6) + I)/NPG
1745 ENDDO !k
1746 ENDDO !IS
1747 ENDDO !IR
1748 CALL H3D_WRITE_SH_TENSOR(IOK_PART,ISELECT,IS_WRITTEN_SHELL,SHELL_TENSOR,I,OFFSET,NFT,VALUE)
1749 ENDDO ! I
1750 ELSEIF(ID ==4 ) THEN
1751 DO I=1,NEL
1752 DO IR=1,NPTR
1753 DO IS=1,NPTS
1754 LBUF => ELBUF_TAB(NG)%BUFLY(J)%LBUF(IR,IS,IPT)
1755 DO K=1,3
1756 VALUE(K) = VALUE(K) + LBUF%SIGB(JJ(K+9) + I)/NPG
1757 ENDDO !k
1758 ENDDO !IS
1759 ENDDO !IR
1760 CALL H3D_WRITE_SH_TENSOR(IOK_PART,ISELECT,IS_WRITTEN_SHELL,SHELL_TENSOR,I,OFFSET,NFT,VALUE)
1761 ENDDO ! I
1762 ENDIF !ID == -1
1763 ENDIF !(MLW ==
1764C--------------------------------------------------
1765c PLY=NULL ILAYER=IL NPT=NULL ! prop 9-10-11 have layers and not PLY
1766C--------------------------------------------------
1767.AND..AND..AND. ELSEIF (IPLY == -1 ILAY <= NLAY ILAY > 0 IPT == -1 ) THEN
1768.OR..OR. IF (IGTYP == 9 IGTYP == 10 IGTYP == 11 ) THEN
1769 ! output in orthotopic frame / elementary
1770 J = ILAY
1771 IF(IGTYP == 9) J = 1
1772 BUFLY => ELBUF_TAB(NG)%BUFLY(J)
1773 NPTT = BUFLY%NPTT
1774 !--------
1775 ! LAW36
1776 !--------
1777.AND..OR..AND. IF (MLW == 36 (ID==-1 ID==1) CHARD > ZERO) THEN ! only one Bstress
1778 DO I=1,NEL
1779 DO IR=1,NPTR
1780 DO IS=1,NPTS
1781 DO IT=1,NPTT
1782 LBUF => ELBUF_TAB(NG)%BUFLY(J)%LBUF(IR,IS,IT)
1783 DO K=1,3
1784 VALUE(K) = VALUE(K) + LBUF%SIGB(JJ(K) + I)/NPG/NPTT
1785 ENDDO !K
1786 ENDDO!IT
1787 ENDDO !IS
1788 ENDDO!IR
1789 CALL H3D_WRITE_SH_TENSOR(IOK_PART,ISELECT,IS_WRITTEN_SHELL,SHELL_TENSOR,I,OFFSET,NFT,VALUE)
1790 VALUE(1:3) = ZERO
1791 ENDDO !I
1792 !--------
1793 ! LAW78
1794 !--------
1795 ELSEIF (MLW == 78) THEN
1796 IF(ID == -1) THEN ! somme of all backstresses
1797 DO I=1,NEL
1798 DO IR=1,NPTR
1799 DO IS=1,NPTS
1800 DO IT=1,NPTT
1801 LBUF => ELBUF_TAB(NG)%BUFLY(J)%LBUF(IR,IS,IT)
1802 DO K=1,3
1803 VALUE(K) = VALUE(K) + (LBUF%SIGA(JJ(K) + I)+LBUF%SIGB(JJ(K) + I))/NPG/NPTT
1804 ENDDO !k
1805 ENDDO!IT
1806 ENDDO !IS
1807 ENDDO !IR
1808 CALL H3D_WRITE_SH_TENSOR(IOK_PART,ISELECT,IS_WRITTEN_SHELL,SHELL_TENSOR,I,OFFSET,NFT,VALUE)
1809 ENDDO ! I
1810 ELSEIF(ID ==1 ) THEN
1811 DO I=1,NEL
1812 DO IR=1,NPTR
1813 DO IS=1,NPTS
1814 DO IT=1,NPTT
1815 LBUF => ELBUF_TAB(NG)%BUFLY(J)%LBUF(IR,IS,IT)
1816 DO K=1,3
1817 VALUE(K) = VALUE(K) + LBUF%SIGA(JJ(K) + I)/NPG/NPTT
1818 ENDDO !k
1819 ENDDO!IT
1820 ENDDO !IS
1821 ENDDO !IR
1822 CALL H3D_WRITE_SH_TENSOR(IOK_PART,ISELECT,IS_WRITTEN_SHELL,SHELL_TENSOR,I,OFFSET,NFT,VALUE)
1823 ENDDO ! I
1824 ELSEIF(ID ==2 ) THEN
1825 DO I=1,NEL
1826 DO IR=1,NPTR
1827 DO IS=1,NPTS
1828 DO IT=1,NPTT
1829 LBUF => ELBUF_TAB(NG)%BUFLY(J)%LBUF(IR,IS,IT)
1830 DO K=1,3
1831 VALUE(K) = VALUE(K) + LBUF%SIGB(JJ(K) + I)/NPG/NPTT
1832 ENDDO !k
1833 ENDDO!IT
1834 ENDDO !IS
1835 ENDDO !IR
1836 CALL H3D_WRITE_SH_TENSOR(IOK_PART,ISELECT,IS_WRITTEN_SHELL,SHELL_TENSOR,I,OFFSET,NFT,VALUE)
1837 ENDDO ! I
1838 ELSEIF(ID ==3 ) THEN
1839 DO I=1,NEL
1840 DO IR=1,NPTR
1841 DO IS=1,NPTS
1842 DO IT=1,NPTT
1843 LBUF => ELBUF_TAB(NG)%BUFLY(J)%LBUF(IR,IS,IT)
1844 DO K=1,3
1845 VALUE(K) = VALUE(K) + LBUF%SIGC(JJ(K) + I)/NPG/NPTT
1846 ENDDO !k
1847 ENDDO!IT
1848 ENDDO !IS
1849 ENDDO !IR
1850 CALL H3D_WRITE_SH_TENSOR(IOK_PART,ISELECT,IS_WRITTEN_SHELL,SHELL_TENSOR,I,OFFSET,NFT,VALUE)
1851 ENDDO ! I
1852 ENDIF !ID == -1
1853 !--------
1854 ! LAW87
1855 !--------
1856.AND. ELSEIF( MLW == 87 CHARD > ZERO) THEN
1857 IF(ID == -1) THEN ! somme of all backstresses
1858 DO I=1,NEL
1859 DO IR=1,NPTR
1860 DO IS=1,NPTS
1861 DO IT=1,NPTT
1862 LBUF => ELBUF_TAB(NG)%BUFLY(J)%LBUF(IR,IS,IT)
1863 DO K=1,3
1864 VALUE(K) = VALUE(K) + (LBUF%SIGB(JJ(K) + I )
1865 . +LBUF%SIGB(JJ(K+3) + I )
1866 . +LBUF%SIGB(JJ(K+6) + I )
1867 . +LBUF%SIGB(JJ(K+9) + I ))/NPG/NPTT
1868
1869 ENDDO !k
1870 ENDDO!IT
1871 ENDDO !IS
1872 ENDDO !IR
1873 CALL H3D_WRITE_SH_TENSOR(IOK_PART,ISELECT,IS_WRITTEN_SHELL,SHELL_TENSOR,I,OFFSET,NFT,VALUE)
1874 ENDDO ! I
1875 ELSEIF(ID ==1 ) THEN
1876 DO I=1,NEL
1877 DO IR=1,NPTR
1878 DO IS=1,NPTS
1879 DO IT=1,NPTT
1880 LBUF => ELBUF_TAB(NG)%BUFLY(J)%LBUF(IR,IS,IT)
1881 DO K=1,3
1882 VALUE(K) = VALUE(K) + LBUF%SIGB(JJ(K) + I)/NPG/NPTT
1883 ENDDO !k
1884 ENDDO!IT
1885 ENDDO !IS
1886 ENDDO !IR
1887 CALL H3D_WRITE_SH_TENSOR(IOK_PART,ISELECT,IS_WRITTEN_SHELL,SHELL_TENSOR,I,OFFSET,NFT,VALUE)
1888 ENDDO ! I
1889 ELSEIF(ID ==2 ) THEN
1890 DO I=1,NEL
1891 DO IR=1,NPTR
1892 DO IS=1,NPTS
1893 DO IT=1,NPTT
1894 LBUF => ELBUF_TAB(NG)%BUFLY(J)%LBUF(IR,IS,IT)
1895 DO K=1,3
1896 VALUE(K) = VALUE(K) + LBUF%SIGB(JJ(K+3) + I )/NPG/NPTT
1897 ENDDO !k
1898 ENDDO!IT
1899 ENDDO !IS
1900 ENDDO !IR
1901 CALL H3D_WRITE_SH_TENSOR(IOK_PART,ISELECT,IS_WRITTEN_SHELL,SHELL_TENSOR,I,OFFSET,NFT,VALUE)
1902 ENDDO ! I
1903 ELSEIF(ID ==3 ) THEN
1904 DO I=1,NEL
1905 DO IR=1,NPTR
1906 DO IS=1,NPTS
1907 DO IT=1,NPTT
1908 LBUF => ELBUF_TAB(NG)%BUFLY(J)%LBUF(IR,IS,IT)
1909 DO K=1,3
1910 VALUE(K) = VALUE(K) + LBUF%SIGB(JJ(K+6) + I )/NPG/NPTT
1911 ENDDO !k
1912 ENDDO!IT
1913 ENDDO !IS
1914 ENDDO !IR
1915 CALL H3D_WRITE_SH_TENSOR(IOK_PART,ISELECT,IS_WRITTEN_SHELL,SHELL_TENSOR,I,OFFSET,NFT,VALUE)
1916 ENDDO ! I
1917 ELSEIF(ID ==4 ) THEN
1918 DO I=1,NEL
1919 DO IR=1,NPTR
1920 DO IS=1,NPTS
1921 DO IT=1,NPTT
1922 LBUF => ELBUF_TAB(NG)%BUFLY(J)%LBUF(IR,IS,IT)
1923 DO K=1,3
1924 VALUE(K) = VALUE(K) + LBUF%SIGB(JJ(K+9) + I )/NPG
1925 ENDDO !k
1926 ENDDO!IT
1927 ENDDO !IS
1928 ENDDO !IR
1929 CALL H3D_WRITE_SH_TENSOR(IOK_PART,ISELECT,IS_WRITTEN_SHELL,SHELL_TENSOR,I,OFFSET,NFT,VALUE)
1930 ENDDO ! I
1931 ENDIF !ID == -1
1932 ENDIF !(MLW ==
1933 ENDIF !IGTYP ==
1934C---------------------------------------------------------------------------
1935c ILAYER=-1 NPT=IPT IPLY=-1 ID=-1
1936C---------------------------------------------------------------------------
1937.AND..AND..AND. ELSE IF(ILAY == -1 IPT > 0 IPT<=MPT IPLY == -1 ) THEN ! output for each layer/PLY as if LAYER==ALL
1938 DO J=1,NLAY
1939 BUFLY => ELBUF_TAB(NG)%BUFLY(J)
1940 NPTT = BUFLY%NPTT
1941 IF (IPT <= NPTT ) THEN
1942 !--------
1943 ! LAW36
1944 !--------
1945.AND..OR..AND. IF (MLW == 36 (ID==-1 ID==1) CHARD > ZERO) THEN
1946 DO I=1,NEL
1947 DO IR=1,NPTR
1948 DO IS=1,NPTS
1949 LBUF => ELBUF_TAB(NG)%BUFLY(J)%LBUF(IR,IS,IPT)
1950 DO K=1,3
1951 VALUE(K) = VALUE(K) + LBUF%SIGB(JJ(K) + I)/NPG
1952 ENDDO !k
1953 ENDDO !IS
1954 ENDDO !IR
1955 CALL H3D_WRITE_SH_TENSOR(IOK_PART,ISELECT,IS_WRITTEN_SHELL,SHELL_TENSOR,I,OFFSET,NFT,VALUE)
1956 ENDDO ! I
1957 !--------
1958 ! LAW78
1959 !--------
1960 ELSEIF (MLW == 78) THEN
1961 IF(ID == -1) THEN ! somme of all backstresses
1962 DO I=1,NEL
1963 DO IR=1,NPTR
1964 DO IS=1,NPTS
1965 LBUF => ELBUF_TAB(NG)%BUFLY(J)%LBUF(IR,IS,IPT)
1966 DO K=1,3
1967 VALUE(K) = VALUE(K) + (LBUF%SIGA(JJ(K) + I)+LBUF%SIGB(JJ(K) + I))/NPG
1968 ENDDO !k
1969 ENDDO !IS
1970 ENDDO !IR
1971 CALL H3D_WRITE_SH_TENSOR(IOK_PART,ISELECT,IS_WRITTEN_SHELL,SHELL_TENSOR,I,OFFSET,NFT,VALUE)
1972 ENDDO ! I
1973 ELSEIF(ID ==1 ) THEN
1974 DO I=1,NEL
1975 DO IR=1,NPTR
1976 DO IS=1,NPTS
1977 LBUF => ELBUF_TAB(NG)%BUFLY(J)%LBUF(IR,IS,IPT)
1978 DO K=1,3
1979 VALUE(K) = VALUE(K) + LBUF%SIGA(JJ(K) + I)/NPG
1980 ENDDO !k
1981 ENDDO !IS
1982 ENDDO !IR
1983 CALL H3D_WRITE_SH_TENSOR(IOK_PART,ISELECT,IS_WRITTEN_SHELL,SHELL_TENSOR,I,OFFSET,NFT,VALUE)
1984 ENDDO ! I
1985 ELSEIF(ID ==2 ) THEN
1986 DO I=1,NEL
1987 DO IR=1,NPTR
1988 DO IS=1,NPTS
1989 LBUF => ELBUF_TAB(NG)%BUFLY(J)%LBUF(IR,IS,IPT)
1990 DO K=1,3
1991 VALUE(K) = VALUE(K) + LBUF%SIGB(JJ(K) + I)/NPG
1992 ENDDO !k
1993 ENDDO !IS
1994 ENDDO !IR
1995 CALL H3D_WRITE_SH_TENSOR(IOK_PART,ISELECT,IS_WRITTEN_SHELL,SHELL_TENSOR,I,OFFSET,NFT,VALUE)
1996 ENDDO ! I
1997 ELSEIF(ID ==3 ) THEN
1998 DO I=1,NEL
1999 DO IR=1,NPTR
2000 DO IS=1,NPTS
2001 LBUF => ELBUF_TAB(NG)%BUFLY(J)%LBUF(IR,IS,IPT)
2002 DO K=1,3
2003 VALUE(K) = VALUE(K) + LBUF%SIGC(JJ(K) + I)/NPG
2004 ENDDO !k
2005 ENDDO !IS
2006 ENDDO !IR
2007 CALL H3D_WRITE_SH_TENSOR(IOK_PART,ISELECT,IS_WRITTEN_SHELL,SHELL_TENSOR,I,OFFSET,NFT,VALUE)
2008 ENDDO ! I
2009 ENDIF !ID == -1
2010 !--------
2011 ! LAW87
2012 !--------
2013.AND. ELSEIF( MLW == 87 CHARD > ZERO) THEN
2014 IF(ID == -1) THEN ! somme of all backstresses
2015 DO I=1,NEL
2016 DO IR=1,NPTR
2017 DO IS=1,NPTS
2018 LBUF => ELBUF_TAB(NG)%BUFLY(J)%LBUF(IR,IS,IPT)
2019 DO K=1,3
2020 VALUE(K) = VALUE(K) + (LBUF%SIGB(JJ(K) + I )
2021 . +LBUF%SIGB(JJ(K+3) + I )
2022 . +LBUF%SIGB(JJ(K+6) + I )
2023 . +LBUF%SIGB(JJ(K+9) + I ))/NPG
2024
2025 ENDDO !k
2026 ENDDO !IS
2027 ENDDO !IR
2028 CALL H3D_WRITE_SH_TENSOR(IOK_PART,ISELECT,IS_WRITTEN_SHELL,SHELL_TENSOR,I,OFFSET,NFT,VALUE)
2029 ENDDO ! I
2030 ELSEIF(ID ==1 ) THEN
2031 DO I=1,NEL
2032 DO IR=1,NPTR
2033 DO IS=1,NPTS
2034 LBUF => ELBUF_TAB(NG)%BUFLY(J)%LBUF(IR,IS,IPT)
2035 DO K=1,3
2036 VALUE(K) = VALUE(K) + LBUF%SIGB(JJ(K) + I )/NPG
2037 ENDDO !k
2038 ENDDO !IS
2039 ENDDO !IR
2040 CALL H3D_WRITE_SH_TENSOR(IOK_PART,ISELECT,IS_WRITTEN_SHELL,SHELL_TENSOR,I,OFFSET,NFT,VALUE)
2041 ENDDO ! I
2042 ELSEIF(ID ==2 ) THEN
2043 DO I=1,NEL
2044 DO IR=1,NPTR
2045 DO IS=1,NPTS
2046 LBUF => ELBUF_TAB(NG)%BUFLY(J)%LBUF(IR,IS,IPT)
2047 DO K=1,3
2048 VALUE(K) = VALUE(K) + LBUF%SIGB(JJ(K+3) + I )/NPG
2049 ENDDO !k
2050 ENDDO !IS
2051 ENDDO !IR
2052 CALL H3D_WRITE_SH_TENSOR(IOK_PART,ISELECT,IS_WRITTEN_SHELL,SHELL_TENSOR,I,OFFSET,NFT,VALUE)
2053 ENDDO ! I
2054 ELSEIF(ID ==3 ) THEN
2055 DO I=1,NEL
2056 DO IR=1,NPTR
2057 DO IS=1,NPTS
2058 LBUF => ELBUF_TAB(NG)%BUFLY(J)%LBUF(IR,IS,IPT)
2059 DO K=1,3
2060 VALUE(K) = VALUE(K) + LBUF%SIGB(JJ(K+6) + I )/NPG
2061 ENDDO !k
2062 ENDDO !IS
2063 ENDDO !IR
2064 CALL H3D_WRITE_SH_TENSOR(IOK_PART,ISELECT,IS_WRITTEN_SHELL,SHELL_TENSOR,I,OFFSET,NFT,VALUE)
2065 ENDDO ! I
2066 ELSEIF(ID ==4 ) THEN
2067 DO I=1,NEL
2068 DO IR=1,NPTR
2069 DO IS=1,NPTS
2070 LBUF => ELBUF_TAB(NG)%BUFLY(J)%LBUF(IR,IS,IPT)
2071 DO K=1,3
2072 VALUE(K) = VALUE(K) + LBUF%SIGB(JJ(K+9) + I )/NPG
2073 ENDDO !k
2074 ENDDO !IS
2075 ENDDO !IR
2076 CALL H3D_WRITE_SH_TENSOR(IOK_PART,ISELECT,IS_WRITTEN_SHELL,SHELL_TENSOR,I,OFFSET,NFT,VALUE)
2077 ENDDO ! I
2078 ENDIF !ID == -1
2079 ENDIF !(MLW ==
2080 ENDIF! (IPT <= NPTT )
2081 ENDDO !JLAY
2082
2083 END IF
2084c ........
2085C---------------------------------------------------------------------------
2086c ELSEIF (KEYWORD == 'NEWKEY') THEN ! New Output Example
2087C---------------------------------------------------------------------------
2088c ILAYER=NULL NPT=NULL
2089c IF ( ILAY == -1 .AND. IPT == -1 .AND. IPLY == -1) THEN
2090c DO I=1,NEL
2091c VALUE(I) =
2092c ENDDO
2093c PLY=IPLY NPT=IPT
2094c ELSEIF ( IPLY > 0 .AND. IPT <= MPT .AND. IPT > 0 ) THEN
2095c IF (IGTYP == 17 .OR. IGTYP == 51 .OR. IGTYP == 52) THEN
2096c
2097c ENDIF
2098c
2099c PLY=NULL ILAYER=ILAY NPT=IPT
2100c ELSEIF (IPLY == -1 .AND. ILAY <= NLAY .AND. ILAY > 0 .AND. IPT <= MPT .AND. IPT > 0 ) THEN
2101c IF (IGTYP == 51 .OR. IGTYP == 52) THEN
2102c
2103c ENDIF
2104c PLY=NULL ILAYER=IL NPT=NULL
2105c ELSEIF (IPLY == -1 .AND. ILAY <= NLAY .AND. ILAY > 0 .AND. IPT == -1 ) THEN
2106c IF (IGTYP == 10 .OR. IGTYP == 11 .OR. IGTYP == 16 .OR. IGTYP == 17) THEN
2107c
2108c ELSEIF (IGTYP == 51 .OR. IGTYP == 52) THEN
2109c
2110c ENDIF
2111c PLY=NULL ILAYER=NULL NPT=IPT
2112c ELSEIF ( IPT <= MPT .AND. IPT > 0) THEN
2113c IF (IGTYP == 1 .OR. IGTYP == 9) THEN
2114c
2115c ENDIF
2116c ENDIF
2117 ENDIF
2118
2119C-----------------------------------------------
2120C RNUR
2121C-----------------------------------------------
2122 ELSEIF (ITY == 50) THEN
2123c DO I=1,NEL
2124c N = I + NFT
2125c TENS(1,EL2FA(NN9+N)) = ZERO
2126c TENS(2,EL2FA(NN9+N)) = ZERO
2127c TENS(3,EL2FA(NN9+N)) = ZERO
2128c ENDDO
2129C-----------------------------------------------
2130 ELSE
2131 ENDIF ! IF (MLW /= 13)
2132 ENDIF ! IF(ITY == 2)
2133 490 CONTINUE
2134 500 CONTINUE
2135C-----------------------------------------------
2136C
2137 RETURN
2138 END
2139!||====================================================================
2140!|| sh4_tstrain ../engine/source/output/h3d/h3d_results/h3d_shell_tensor.F
2141!||--- called by ------------------------------------------------------
2142!|| h3d_shell_tensor ../engine/source/output/h3d/h3d_results/h3d_shell_tensor.F
2143!||--- calls -----------------------------------------------------
2144!|| c4sysg2l ../engine/source/output/h3d/h3d_results/h3d_shell_tensor.F
2145!||====================================================================
2146 SUBROUTINE SH4_TSTRAIN(XN,YN,ZN,DX,DY,DZ,STRAIN,NEL)
2147C---+----1----+----2----+----3----+----4----+----5----+----6----+----7----+----8
2148#include "implicit_f.inc"
2149C---------+---------+---+---+--------------------------------------------
2150C VAR | SIZE |TYP| RW| DEFINITION
2151C---------+---------+---+---+--------------------------------------------
2152C NEL | 1 | I | R | SIZE OF THE ELEMENT GROUP NEL
2153C XN | 4*NEL | R | R | X-coordinate ARRAY (4n quad)
2154C YN | 4*NEL | R | R | Y-coordinate ARRAY (4n quad)
2155C ZN | 4*NEL | R | R | Z-coordinate ARRAY (4n quad)
2156C DX | 4*NEL | R | R | X-Displ ARRAY (4n quad)
2157C DY | 4*NEL | R | R | Y-Displ ARRAY (4n quad)
2158C DZ | 4*NEL | R | R | D-Displ ARRAY (4n quad)
2159C STRAIN | 3*NEL | R | W | STRAIN ARRAY
2160C---------+---------+---+---+--------------------------------------------
2161C-----------------------------------------------
2162C D U M M Y A R G U M E N T S
2163C-----------------------------------------------
2164 INTEGER NEL
2165 my_real
2166 . XN(4,NEL) , YN(4,NEL) , ZN(4,NEL),
2167 . DX(4,NEL) , DY(4,NEL) , DZ(4,NEL),STRAIN(3,*)
2168C-----------------------------------------------
2169C L O C A L V A R I A B L E S
2170C-----------------------------------------------
2171 INTEGER I,J,NNOD
2172 PARAMETER (NNOD = 4)
2173 my_real
2174 . X0N(NNOD,NEL) , Y0N(NNOD,NEL) , Z0N(NNOD,NEL),
2175 . LXYZ0(3),DETA1(NEL),COREL(2,NNOD),XX,YY,ZZ,
2176 . XL2(NEL),XL3(NEL),XL4(NEL),YL2(NEL),
2177 . YL3(NEL),YL4(NEL),ZL1(NEL),ZL(NEL),
2178 . X13,X24,Y13,Y24,UX1,UY1,UX2,UX3,UX4,UY2,UY3,UY4,
2179 . PX1(NEL),PX2(NEL),PY1(NEL),PY2(NEL),
2180 . UX13(NEL),UX24(NEL),UY13(NEL),UY24(NEL),
2181 . X0L2(NEL),X0L3(NEL),X0L4(NEL),Y0L2(NEL),
2182 . Y0L3(NEL),Y0L4(NEL),AREA(NEL),AREA_I(NEL),FXX,FYY,FXY,FYX
2183C----------------------------------------------
2184C------Compute coordinates in elementary local sys: actual configuration first
2185 CALL C4SYSG2L(XN,YN,ZN,XL2,YL2,XL3,YL3,XL4,YL4,ZL1,AREA,NEL)
2186C------initial configuration :
2187 DO I=1,NEL
2188 X0N(1:NNOD,I) = XN(1:NNOD,I)-DX(1:NNOD,I)
2189 Y0N(1:NNOD,I) = YN(1:NNOD,I)-DY(1:NNOD,I)
2190 Z0N(1:NNOD,I) = ZN(1:NNOD,I)-DZ(1:NNOD,I)
2191 ENDDO
2192 CALL C4SYSG2L(X0N,Y0N,Z0N,X0L2,Y0L2,X0L3,Y0L3,X0L4,Y0L4,ZL,AREA,NEL)
2193C-------[B0]---remove the origine to the center--------------
2194 DO I=1,NEL
2195C-----------EM20=1.0E-20,FOURTH=0.25,HALF=0.5,ZERO=0.--------------
2196 AREA_I(I) = ONE/MAX(EM20,AREA(I))
2197 LXYZ0(1)=FOURTH*(X0L2(I)+X0L3(I)+X0L4(I))
2198 LXYZ0(2)=FOURTH*(Y0L2(I)+Y0L3(I)+Y0L4(I))
2199 COREL(1,1)=-LXYZ0(1)
2200 COREL(1,2)=X0L2(I)-LXYZ0(1)
2201 COREL(1,3)=X0L3(I)-LXYZ0(1)
2202 COREL(1,4)=X0L4(I)-LXYZ0(1)
2203 COREL(2,1)=-LXYZ0(2)
2204 COREL(2,2)=Y0L2(I)-LXYZ0(2)
2205 COREL(2,3)=Y0L3(I)-LXYZ0(2)
2206 COREL(2,4)=Y0L4(I)-LXYZ0(2)
2207C----
2208 X13 =(COREL(1,1)-COREL(1,3))*HALF
2209 X24 =(COREL(1,2)-COREL(1,4))*HALF
2210 Y13 =(COREL(2,1)-COREL(2,3))*HALF
2211 Y24 =(COREL(2,2)-COREL(2,4))*HALF
2212 PY2(I) =X13*AREA_I(I)
2213 PY1(I) =-X24*AREA_I(I)
2214 PX2(I) =-Y13*AREA_I(I)
2215 PX1(I) =Y24*AREA_I(I)
2216 ENDDO
2217C------ objective disp (or projected disp to free rigide rotation)
2218 UX1= ZERO
2219 UY1= ZERO
2220 DO I=1,NEL
2221 UX2 = XL2(I)-X0L2(I)
2222 UY2 = YL2(I)-Y0L2(I)
2223 UX3 = XL3(I)-X0L3(I)
2224 UY3 = YL3(I)-Y0L3(I)
2225 UX4 = XL4(I)-X0L4(I)
2226 UY4 = YL4(I)-Y0L4(I)
2227 UX13(I)=UX1-UX3
2228 UX24(I)=UX2-UX4
2229 UY13(I)=UY1-UY3
2230 UY24(I)=UY2-UY4
2231 ENDDO
2232C---------------
2233C MEMBRANE [F]-1 = [B0]{d}, [e] ({d} has been projected to free rigide rotation)
2234C---------------
2235 DO I=1,NEL
2236 FXX = PX1(I)*UX13(I)+PX2(I)*UX24(I)
2237 FYY = PY1(I)*UY13(I)+PY2(I)*UY24(I)
2238 FYX = PX1(I)*UY13(I)+PX2(I)*UY24(I)
2239 FXY = PY1(I)*UX13(I)+PY2(I)*UX24(I)
2240 STRAIN(1,I) = FXX
2241 STRAIN(2,I) = FYY
2242 STRAIN(3,I) = 0.5*(FXY+FYX)
2243 ENDDO
2244C
2245 RETURN
2246 END
2247!||====================================================================
2248!|| c4sysg2l ../engine/source/output/h3d/h3d_results/h3d_shell_tensor.F
2249!||--- called by ------------------------------------------------------
2250!|| sh4_tstrain ../engine/source/output/h3d/h3d_results/h3d_shell_tensor.F
2251!||--- calls -----------------------------------------------------
2252!|| clsys3 ../engine/source/output/h3d/h3d_results/h3d_shell_tensor.F
2253!||====================================================================
2254 SUBROUTINE C4SYSG2L(XN,YN,ZN,XL2,YL2,XL3,YL3,XL4,YL4,ZL1,AREA,NEL)
2255C-----------------------------------------------
2256C I m p l i c i t T y p e s
2257C-----------------------------------------------
2258#include "implicit_f.inc"
2259C---------+---------+---+---+--------------------------------------------
2260C VAR | SIZE |TYP| RW| DEFINITION
2261C---------+---------+---+---+--------------------------------------------
2262C NEL | 1 | I | R | SIZE OF THE ELEMENT GROUP NEL
2263C XN | 4*NEL | R | R | X-coordinate ARRAY (4n quad)
2264C YN | 4*NEL | R | R | Y-coordinate ARRAY (4n quad)
2265C ZN | 4*NEL | R | R | Z-coordinate ARRAY (4n quad)
2266C XL2 | NEL | R | W | Local X-coordinate of N2 (relative to N1)
2267C YL2 | NEL | R | W | Local Y-coordinate of N2 (relative to N1)
2268C ZL1 | NEL | R | W | Local Z-coordinate of N1 (Z1 -Z1 Z1 -Z1)
2269C XL3 | NEL | R | W | Local X-coordinate of N3 (relative to N1)
2270C YL3 | NEL | R | W | Local Y-coordinate of N3 (relative to N1)
2271C XL4 | NEL | R | W | Local X-coordinate of N4 (relative to N1)
2272C YL4 | NEL | R | W | Local Y-coordinate of N4 (relative to N1)
2273C AREA | NEL | R | W | AREA of quad
2274C---------+---------+---+---+--------------------------------------------
2275C-----------------------------------------------
2276C D u m m y A r g u m e n t s
2277C-----------------------------------------------
2278 INTEGER NEL
2279 my_real
2280 . XN(4,*) , YN(4,*) , ZN(4,*),
2281 . XL2(NEL),XL3(NEL),XL4(NEL),YL2(NEL),
2282 . YL3(NEL),YL4(NEL),ZL1(NEL),AREA(NEL)
2283C-----------------------------------------------
2284C L o c a l V a r i a b l e s
2285C-----------------------------------------------
2286 INTEGER I
2287 my_real
2288 . RX(NEL),RY(NEL),RZ(NEL),SX(NEL),SY(NEL),SZ(NEL),
2289 . VQ(3,3,NEL), LXYZ0(3),DETA1(NEL),XX,YY,ZZ
2290C-----------------------------------------------
2291 DO I=1,NEL
2292 RX(I)=XN(2,I)+XN(3,I)-XN(1,I)-XN(4,I)
2293 RY(I)=YN(2,I)+YN(3,I)-YN(1,I)-YN(4,I)
2294 RZ(I)=ZN(2,I)+ZN(3,I)-ZN(1,I)-ZN(4,I)
2295 SX(I)=XN(3,I)+XN(4,I)-XN(1,I)-XN(2,I)
2296 SY(I)=YN(3,I)+YN(4,I)-YN(1,I)-YN(2,I)
2297 SZ(I)=ZN(3,I)+ZN(4,I)-ZN(1,I)-ZN(2,I)
2298 ENDDO
2299C------Local elem. base:
2300 CALL CLSYS3(RX, RY, RZ, SX, SY, SZ,
2301 . VQ, DETA1,NEL)
2302C------ Global -> Local Coordinate FOURTH=0.25 ;
2303 DO I=1,NEL
2304 LXYZ0(1)=FOURTH*(XN(1,I)+XN(2,I)+XN(3,I)+XN(4,I))
2305 LXYZ0(2)=FOURTH*(YN(1,I)+YN(2,I)+YN(3,I)+YN(4,I))
2306 LXYZ0(3)=FOURTH*(ZN(1,I)+ZN(2,I)+ZN(3,I)+ZN(4,I))
2307 XX=XN(2,I)-XN(1,I)
2308 YY=YN(2,I)-YN(1,I)
2309 ZZ=ZN(2,I)-ZN(1,I)
2310 XL2(I)=VQ(1,1,I)*XX+VQ(2,1,I)*YY+VQ(3,1,I)*ZZ
2311 YL2(I)=VQ(1,2,I)*XX+VQ(2,2,I)*YY+VQ(3,2,I)*ZZ
2312 XX=XN(2,I)-LXYZ0(1)
2313 YY=YN(2,I)-LXYZ0(2)
2314 ZZ=ZN(2,I)-LXYZ0(3)
2315 ZL1(I)=VQ(1,3,I)*XX+VQ(2,3,I)*YY+VQ(3,3,I)*ZZ
2316C
2317 XX=XN(3,I)-XN(1,I)
2318 YY=YN(3,I)-YN(1,I)
2319 ZZ=ZN(3,I)-ZN(1,I)
2320 XL3(I)=VQ(1,1,I)*XX+VQ(2,1,I)*YY+VQ(3,1,I)*ZZ
2321 YL3(I)=VQ(1,2,I)*XX+VQ(2,2,I)*YY+VQ(3,2,I)*ZZ
2322C
2323 XX=XN(4,I)-XN(1,I)
2324 YY=YN(4,I)-YN(1,I)
2325 ZZ=ZN(4,I)-ZN(1,I)
2326 XL4(I)=VQ(1,1,I)*XX+VQ(2,1,I)*YY+VQ(3,1,I)*ZZ
2327 YL4(I)=VQ(1,2,I)*XX+VQ(2,2,I)*YY+VQ(3,2,I)*ZZ
2328 AREA(I)=FOURTH*DETA1(I)
2329 ENDDO
2330c-----------
2331 RETURN
2332 END
2333!||====================================================================
2334!|| clsys3 ../engine/source/output/h3d/h3d_results/h3d_shell_tensor.F
2335!||--- called by ------------------------------------------------------
2336!|| c3sysg2l ../engine/source/output/h3d/h3d_results/h3d_shell_tensor.F
2337!|| c4sysg2l ../engine/source/output/h3d/h3d_results/h3d_shell_tensor.F
2338!|| sdlensh ../engine/source/elements/thickshell/solidec/sdlensh.F
2339!|| sdlensh8 ../engine/source/elements/thickshell/solide8c/sdlensh8.F
2340!||====================================================================
2341 SUBROUTINE CLSYS3(RX, RY, RZ, SX, SY, SZ, VQ, DET,NEL)
2342C-----------------------------------------------
2343C I m p l i c i t T y p e s
2344C-----------------------------------------------
2345#include "implicit_f.inc"
2346C-----------------------------------------------
2347C D u m m y A r g u m e n t s
2348C-----------------------------------------------
2349 INTEGER NEL
2350 my_real
2351 . RX(*) , RY(*) , RZ(*),
2352 . SX(*) , SY(*) , SZ(*),
2353 . DET(*),VQ(3,3,*)
2354C---------+---------+---+---+--------------------------------------------
2355C VAR | SIZE |TYP| RW| DEFINITION
2356C---------+---------+---+---+--------------------------------------------
2357C NEL | 1 | I | R | SIZE OF THE ELEMENT GROUP NEL
2358C RX | NEL | R | R | X-of covariant vecter g1
2359C RY | NEL | R | R | Y-of covariant vecter g1
2360C RZ | NEL | R | R | Z-of covariant vecter g1
2361C SX | NEL | R | R | X-of covariant vecter g2
2362C SY | NEL | R | R | Y-of covariant vecter g2
2363C SZ | NEL | R | R | Z-of covariant vecter g2
2364C VQ |3*3*NEL | R | W | Local elem sys bases
2365C DET | NEL | R | W | det of g1 ^ g2
2366C---------+---------+---+---+--------------------------------------------
2367C-----------------------------------------------
2368C L o c a l V a r i a b l e s
2369C-----------------------------------------------
2370 INTEGER I
2371C REAL
2372 my_real
2373 . E1X(NEL), E1Y(NEL), E1Z(NEL),
2374 . E2X(NEL), E2Y(NEL), E2Z(NEL),
2375 . E3X(NEL), E3Y(NEL), E3Z(NEL),
2376 . C1,C2,CC,C1C1,C2C2,C1_1,C2_1
2377C~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
2378 DO I=1,NEL
2379C---------E3------------
2380 E3X(I) = RY(I) * SZ(I) - RZ(I) * SY(I)
2381 E3Y(I) = RZ(I) * SX(I) - RX(I) * SZ(I)
2382 E3Z(I) = RX(I) * SY(I) - RY(I) * SX(I)
2383 DET(I) = SQRT(E3X(I)*E3X(I) + E3Y(I)*E3Y(I) + E3Z(I)*E3Z(I))
2384C ----- EM20=1.0E-20
2385 DET(I) = MAX(EM20,DET(I))
2386 E3X(I) = E3X(I) / DET(I)
2387 E3Y(I) = E3Y(I) / DET(I)
2388 E3Z(I) = E3Z(I) / DET(I)
2389 ENDDO
2390C~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
2391 DO I=1,NEL
2392 C1C1 = RX(I)*RX(I) + RY(I)*RY(I) + RZ(I)*RZ(I)
2393 C2C2 = SX(I)*SX(I) + SY(I)*SY(I) + SZ(I)*SZ(I)
2394C ----- ZERO=0., ONE=1.0
2395 IF(C1C1 /= ZERO) THEN
2396 C2_1 = SQRT(C2C2/MAX(EM20,C1C1))
2397 C1_1 = ONE
2398 ELSEIF(C2C2 /= ZERO)THEN
2399 C2_1 = ONE
2400 C1_1 = SQRT(C1C1/MAX(EM20,C2C2))
2401 END IF
2402 E1X(I) = RX(I)*C2_1+(SY(I)*E3Z(I)-SZ(I)*E3Y(I))*C1_1
2403 E1Y(I) = RY(I)*C2_1+(SZ(I)*E3X(I)-SX(I)*E3Z(I))*C1_1
2404 E1Z(I) = RZ(I)*C2_1+(SX(I)*E3Y(I)-SY(I)*E3X(I))*C1_1
2405 ENDDO
2406C~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
2407 DO I=1,NEL
2408 C1 = SQRT(E1X(I)*E1X(I) + E1Y(I)*E1Y(I) + E1Z(I)*E1Z(I))
2409 IF ( C1 /= ZERO) C1 = ONE / MAX(EM20,C1)
2410 E1X(I) = E1X(I)*C1
2411 E1Y(I) = E1Y(I)*C1
2412 E1Z(I) = E1Z(I)*C1
2413 E2X(I) = E3Y(I) * E1Z(I) - E3Z(I) * E1Y(I)
2414 E2Y(I) = E3Z(I) * E1X(I) - E3X(I) * E1Z(I)
2415 E2Z(I) = E3X(I) * E1Y(I) - E3Y(I) * E1X(I)
2416 ENDDO
2417 DO I=1,NEL
2418 VQ(1,1,I)=E1X(I)
2419 VQ(2,1,I)=E1Y(I)
2420 VQ(3,1,I)=E1Z(I)
2421 VQ(1,2,I)=E2X(I)
2422 VQ(2,2,I)=E2Y(I)
2423 VQ(3,2,I)=E2Z(I)
2424 VQ(1,3,I)=E3X(I)
2425 VQ(2,3,I)=E3Y(I)
2426 VQ(3,3,I)=E3Z(I)
2427 ENDDO
2428c-----------
2429 RETURN
2430 END
2431!||====================================================================
2432!|| sh3_tstrain ../engine/source/output/h3d/h3d_results/h3d_shell_tensor.F
2433!||--- called by ------------------------------------------------------
2434!|| h3d_shell_tensor ../engine/source/output/h3d/h3d_results/h3d_shell_tensor.F
2435!||--- calls -----------------------------------------------------
2436!|| c3sysg2l ../engine/source/output/h3d/h3d_results/h3d_shell_tensor.F
2437!|| u_from_f2 ../engine/source/output/h3d/h3d_results/h3d_shell_tensor.F
2438!||====================================================================
2439 SUBROUTINE SH3_TSTRAIN(XN,YN,ZN,DX,DY,DZ,STRAIN,NEL,IHBE)
2440C---+----1----+----2----+----3----+----4----+----5----+----6----+----7----+----8
2441#include "implicit_f.inc"
2442C---------+---------+---+---+--------------------------------------------
2443C VAR | SIZE |TYP| RW| DEFINITION
2444C---------+---------+---+---+--------------------------------------------
2445C NEL | 1 | I | R | SIZE OF THE ELEMENT GROUP NEL
2446C XN | 3*NEL | R | R | X-coordinate ARRAY (3n tria)
2447C YN | 3*NEL | R | R | Y-coordinate ARRAY (3n tria)
2448C ZN | 3*NEL | R | R | Z-coordinate ARRAY (3n tria)
2449C DX | 3*NEL | R | R | X-Displ ARRAY (3n tria)
2450C DY | 3*NEL | R | R | Y-Displ ARRAY (3n tria)
2451C DZ | 3*NEL | R | R | D-Displ ARRAY (3n tria)
2452C STRAIN | 3*NEL | R | W | STRAIN ARRAY
2453C---------+---------+---+---+--------------------------------------------
2454C-----------------------------------------------
2455C D U M M Y A R G U M E N T S
2456C-----------------------------------------------
2457 INTEGER NEL,IHBE
2458 my_real
2459 . XN(3,NEL) , YN(3,NEL) , ZN(3,NEL),
2460 . DX(3,NEL) , DY(3,NEL) , DZ(3,NEL),STRAIN(3,*)
2461C-----------------------------------------------
2462C L O C A L V A R I A B L E S
2463C-----------------------------------------------
2464 INTEGER I,J,NNOD
2465 PARAMETER (NNOD = 3)
2466 my_real
2467 . X0N(NNOD,NEL) , Y0N(NNOD,NEL) , Z0N(NNOD,NEL),
2468 . DETA1(NEL),XX,YY,ZZ,
2469 . XL2(NEL),XL3(NEL),YL2(NEL),YL3(NEL),
2470 . UX1,UY1,UX2,UX3,UY2,UY3,
2471 . PX2(NEL),PX3(NEL),PY2(NEL),PY3(NEL),
2472 . UX21(NEL),UX31(NEL),UY21(NEL),UY31(NEL),
2473 . X0L2(NEL),X0L3(NEL),Y0L2(NEL),
2474 . Y0L3(NEL),AREA(NEL),AREA_I(NEL),FXX,FYY,FXY,FYX,F(2,2,NEL)
2475C----------------------------------------------
2476C------Compute coordinates in elementary local sys: actual configuration first
2477 CALL C3SYSG2L(XN,YN,ZN,XL2,YL2,XL3,YL3,AREA,NEL)
2478C------initial configuration :
2479 DO I=1,NEL
2480 X0N(1:NNOD,I) = XN(1:NNOD,I)-DX(1:NNOD,I)
2481 Y0N(1:NNOD,I) = YN(1:NNOD,I)-DY(1:NNOD,I)
2482 Z0N(1:NNOD,I) = ZN(1:NNOD,I)-DZ(1:NNOD,I)
2483 ENDDO
2484 CALL C3SYSG2L(X0N,Y0N,Z0N,X0L2,Y0L2,X0L3,Y0L3,AREA,NEL)
2485C-----------[B0]-----------------
2486 DO I=1,NEL
2487 AREA_I(I)=0.5/AREA(I)
2488 PX2(I)= Y0L3(I)*AREA_I(I)
2489 PY2(I)=-X0L3(I)*AREA_I(I)
2490 PX3(I)=-Y0L2(I)*AREA_I(I)
2491 PY3(I)= X0L2(I)*AREA_I(I)
2492 ENDDO
2493C------ objective disp (free rigide rotation)
2494 UX1= ZERO
2495 UY1= ZERO
2496 DO I=1,NEL
2497 UX2 = XL2(I)-X0L2(I)
2498 UY2 = YL2(I)-Y0L2(I)
2499 UX3 = XL3(I)-X0L3(I)
2500 UY3 = YL3(I)-Y0L3(I)
2501 UX21(I)=UX2-UX1
2502 UX31(I)=UX3-UX1
2503 UY21(I)=UY2-UY1
2504 UY31(I)=UY3-UY1
2505 ENDDO
2506C---------------
2507C MEMBRANE [F]-1 = [B0]{d}, [e] ({d} has been projected to free rigide rotation)
2508 DO I=1,NEL
2509 F(1,1,I) = PX2(I)*UX21(I)+PX3(I)*UX31(I)
2510 F(2,2,I) = PY2(I)*UY21(I)+PY3(I)*UY31(I)
2511 F(2,1,I) = PX2(I)*UY21(I)+PX3(I)*UY31(I)
2512 F(1,2,I) = PY2(I)*UX21(I)+PY3(I)*UX31(I)
2513 STRAIN(1,I) = F(1,1,I)
2514 STRAIN(2,I) = F(2,2,I)
2515 STRAIN(3,I) = 0.5*(F(1,2,I) + F(2,1,I))
2516 ENDDO
2517C--- local sys for 3N isn't really material ----
2518 IF (IHBE==3) CALL U_FROM_F2(F,STRAIN,NEL )
2519C
2520 RETURN
2521 END
2522!||====================================================================
2523!|| c3sysg2l ../engine/source/output/h3d/h3d_results/h3d_shell_tensor.F
2524!||--- called by ------------------------------------------------------
2525!|| sh3_tstrain ../engine/source/output/h3d/h3d_results/h3d_shell_tensor.F
2526!||--- calls -----------------------------------------------------
2527!|| clsys3 ../engine/source/output/h3d/h3d_results/h3d_shell_tensor.F
2528!||====================================================================
2529 SUBROUTINE C3SYSG2L(XN,YN,ZN,XL2,YL2,XL3,YL3,AREA,NEL)
2530C-----------------------------------------------
2531C I m p l i c i t T y p e s
2532C-----------------------------------------------
2533#include "implicit_f.inc"
2534C---------+---------+---+---+--------------------------------------------
2535C VAR | SIZE |TYP| RW| DEFINITION
2536C---------+---------+---+---+--------------------------------------------
2537C NEL | 1 | I | R | SIZE OF THE ELEMENT GROUP NEL
2538C XN | 3*NEL | R | R | X-coordinate ARRAY (3n tria)
2539C YN | 3*NEL | R | R | Y-coordinate ARRAY (3n tria)
2540C ZN | 3*NEL | R | R | Z-coordinate ARRAY (3n tria)
2541C XL2 | NEL | R | W | Local X-coordinate of N2 (relative to N1)
2542C YL2 | NEL | R | W | Local Y-coordinate of N2 (relative to N1)
2543C XL3 | NEL | R | W | Local X-coordinate of N3 (relative to N1)
2544C YL3 | NEL | R | W | Local Y-coordinate of N3 (relative to N1)
2545C AREA | NEL | R | W | AREA of tria
2546C---------+---------+---+---+--------------------------------------------
2547C-----------------------------------------------
2548C D u m m y A r g u m e n t s
2549C-----------------------------------------------
2550 INTEGER NEL
2551 my_real
2552 . XN(3,*) , YN(3,*) , ZN(3,*),
2553 . XL2(NEL),XL3(NEL),YL2(NEL),YL3(NEL),AREA(NEL)
2554C-----------------------------------------------
2555C L o c a l V a r i a b l e s
2556C-----------------------------------------------
2557 INTEGER I
2558 my_real
2559 . RX(NEL),RY(NEL),RZ(NEL),SX(NEL),SY(NEL),SZ(NEL),
2560 . VQ(3,3,NEL), DETA1(NEL),XX,YY,ZZ
2561 DO I=1,NEL
2562 RX(I)=XN(2,I)-XN(1,I)
2563 RY(I)=YN(2,I)-YN(1,I)
2564 RZ(I)=ZN(2,I)-ZN(1,I)
2565 SX(I)=XN(3,I)-XN(1,I)
2566 SY(I)=YN(3,I)-YN(1,I)
2567 SZ(I)=ZN(3,I)-ZN(1,I)
2568 ENDDO
2569 CALL CLSYS3(RX, RY, RZ, SX, SY, SZ,
2570 . VQ, DETA1,NEL)
2571C------ Global -> Local Coordinate
2572 DO I=1,NEL
2573 XX=RX(I)
2574 YY=RY(I)
2575 ZZ=RZ(I)
2576 XL2(I)=VQ(1,1,I)*XX+VQ(2,1,I)*YY+VQ(3,1,I)*ZZ
2577 YL2(I)=VQ(1,2,I)*XX+VQ(2,2,I)*YY+VQ(3,2,I)*ZZ
2578C
2579 XX=SX(I)
2580 YY=SY(I)
2581 ZZ=SZ(I)
2582 XL3(I)=VQ(1,1,I)*XX+VQ(2,1,I)*YY+VQ(3,1,I)*ZZ
2583 YL3(I)=VQ(1,2,I)*XX+VQ(2,2,I)*YY+VQ(3,2,I)*ZZ
2584 AREA(I)=0.5*DETA1(I)
2585 ENDDO
2586c-----------
2587 RETURN
2588 END
2589!||====================================================================
2590!|| u_from_f2 ../engine/source/output/h3d/h3d_results/h3d_shell_tensor.F
2591!||--- called by ------------------------------------------------------
2592!|| sh3_tstrain ../engine/source/output/h3d/h3d_results/h3d_shell_tensor.F
2593!||====================================================================
2594 SUBROUTINE U_FROM_F2(F,STRAIN,NEL )
2595C-----------------------------------------------
2596C I m p l i c i t T y p e s
2597C-----------------------------------------------
2598#include "implicit_f.inc"
2599C-----------------------------------------------
2600C D u m m y A r g u m e n t s
2601C-----------------------------------------------
2602 INTEGER NEL
2603 my_real
2604 . F(2,2,NEL), STRAIN(3,*)
2605C-----------------------------------------------
2606C L o c a l V a r i a b l e s
2607C-----------------------------------------------
2608 INTEGER I
2609 DOUBLE PRECISION
2610 . FMAT(2,2),UM(2,2),IC,I2C,I3C,IU,I2U,I3U,
2611 . C11,C21,C31,C12,C22,C32,C13,C23,C33,DETJ0,DETM1,
2612 . CC11,CC21,CC31,CC12,CC22,CC32,CC13,CC23,CC33,
2613 . A,B,ZZ,A1,A2,A3,A4,ALPHA,C_A,S_A,C_A2,S_A2
2614C-----------------------------------------------
2615 DO I=1,NEL
2616 FMAT(1,1)= F(1,1,I)+1.0
2617 FMAT(2,2)= F(2,2,I)+1.0
2618 FMAT(1,2)= F(1,2,I)
2619 FMAT(2,1)= F(2,1,I)
2620 C11 = FMAT(1,1)*FMAT(1,1)+FMAT(2,1)*FMAT(2,1)
2621 C12 = FMAT(1,1)*FMAT(1,2)+FMAT(2,1)*FMAT(2,2)
2622 C22 = FMAT(1,2)*FMAT(1,2)+FMAT(2,2)*FMAT(2,2)
2623 CC12 = 0.5*(C11-C22)
2624 IC = 0.5*(C11+C22)
2625 B = SQRT(CC12*CC12+C12*C12)
2626 CC11 = SQRT(IC + B)
2627 CC22 = SQRT(IC - B)
2628 IF (ABS(CC12)<EM20) THEN
2629 C_A = 0.0
2630 S_A = 1.0
2631 ELSE
2632 ALPHA =0.5*(atan(C12/CC12))
2633 C_A = COS(ALPHA)
2634 S_A = SIN(ALPHA)
2635 END IF
2636 C_A2 = C_A*C_A
2637 S_A2 = S_A*S_A
2638 UM(1,1) = CC11*C_A2+CC22*S_A2
2639 UM(2,2) = CC11*S_A2+CC22*C_A2
2640 UM(1,2) = (CC11-CC22)*S_A*C_A
2641 STRAIN(1,I) = UM(1,1)-ONE
2642 STRAIN(2,I) = UM(2,2)-ONE
2643 STRAIN(3,I) = UM(1,2)
2644 END DO
2645C
2646 RETURN
2647 END
2648
my_real
#define my_real
Definition cppsort.cpp:32
h3d_shell_tensor
subroutine h3d_shell_tensor(elbuf_tab, shell_tensor, iparg, itens, invert, nelcut, el2fa, nbf, tens, epsdot, iadp, nbf_l, nbpart, iadg, x, ixc, igeo, ixtg, ipm, stack, id_elem, ity_elem, info1, info2, is_written_shell, ipartc, iparttg, layer_input, ipt_input, ply_input, gauss_input, iuvar_input, h3d_part, keyword, d, id, bufmat, mat_param, geo, drape_sh4n, drape_sh3n, drapeg)
Definition h3d_shell_tensor.F:51
max
#define max(a, b)
Definition macros.h:21
drape_mod
Definition drape_mod.F:54
names_and_titles_mod
Definition names_and_titles_mod.F:997
names_and_titles_mod::ncharline100
integer, parameter ncharline100
Definition names_and_titles_mod.F:1002
stack_mod
Definition stack_mod.F:72
stack_mod::ply_info
integer, dimension(:,:), allocatable ply_info
Definition stack_mod.F:133