OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
h3d_shell_scalar_1.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_scalar_1 ../engine/source/output/h3d/h3d_results/h3d_shell_scalar_1.F
25!||--- called by ------------------------------------------------------
26!|| funct_python_update_elements ../engine/source/tools/curve/funct_python_update_elements.F90
27!|| h3d_shell_scalar ../engine/source/output/h3d/h3d_results/h3d_shell_scalar.F
28!||--- calls -----------------------------------------------------
29!|| h3d_write_scalar_stack ../engine/source/output/h3d/h3d_results/h3d_write_scalar.F
30!|| initbuf ../engine/share/resol/initbuf.F
31!|| output_div_u ../engine/source/output/anim/generate/output_div_u.F
32!|| output_schlieren ../engine/source/output/anim/generate/output_schlieren.F
33!||--- uses -----------------------------------------------------
34!|| ale_connectivity_mod ../common_source/modules/ale/ale_connectivity_mod.F
35!|| alefvm_mod ../common_source/modules/ale/alefvm_mod.F
36!|| elbufdef_mod ../common_source/modules/mat_elem/elbufdef_mod.F90
37!|| initbuf_mod ../engine/share/resol/initbuf.F
38!|| matparam_def_mod ../common_source/modules/mat_elem/matparam_def_mod.F90
39!|| multi_fvm_mod ../common_source/modules/ale/multi_fvm_mod.F90
40!|| multimat_param_mod ../common_source/modules/multimat_param_mod.F90
41!|| names_and_titles_mod ../common_source/modules/names_and_titles_mod.F
42!|| schlieren_mod ../engine/share/modules/schlieren_mod.f
43!|| stack_mod ../engine/share/modules/stack_mod.F
44!||====================================================================
45 SUBROUTINE h3d_shell_scalar_1( CALLED_FROM_PYTHON,
46 . ELBUF_TAB ,SHELL_SCALAR ,IPARG ,GEO ,
47 . IXC ,IXTG ,PM ,BUFMAT ,
48 . EHOUR ,
49 . IPM ,IGEO ,THKE ,ERR_THK_SH4 ,ERR_THK_SH3,
50 . X ,V ,W ,ALE_CONNECT,
51 . STACK ,ID_ELEM ,ITY_ELEM ,
52 . IS_WRITTEN_SHELL,IPARTC ,IPARTTG ,LAYER_INPUT ,IPT_INPUT ,
53 . PLY_INPUT ,IUVAR_INPUT ,H3D_PART ,KEYWORD ,
54 . D ,NG ,MULTI_FVM ,IDMDS ,IMDSVAR ,
55 . MDS_MATID ,ID ,MODE ,MATPARAM ,
56 . H3D_LIGHT ,SHELL_STACK ,MAX_SHELL_STACKSIZE ,SHELL_STACKSIZE)
57C-----------------------------------------------
58C M o d u l e s
59C-----------------------------------------------
60 USE initbuf_mod
61 USE elbufdef_mod
62 USE schlieren_mod
63 USE stack_mod
64 USE multi_fvm_mod
65 USE ale_connectivity_mod
66 USE alefvm_mod , only:alefvm_param
67 USE names_and_titles_mod, ONLY: ncharline100
68 USE matparam_def_mod
69 USE multimat_param_mod , ONLY : m51_n0phas, m51_nvphas
70C-----------------------------------------------
71C I m p l i c i t T y p e s
72C-----------------------------------------------
73#include "implicit_f.inc"
74C-----------------------------------------------
75C C o m m o n B l o c k s
76C-----------------------------------------------
77#include "vect01_c.inc"
78#include "mvsiz_p.inc"
79#include "com01_c.inc"
80#include "com04_c.inc"
81#include "param_c.inc"
82#include "task_c.inc"
83#include "tabsiz_c.inc"
84C-----------------------------------------------
85C D u m m y A r g u m e n t s
86C-----------------------------------------------
87 logical, intent(in) :: CALLED_FROM_PYTHON
88 my_real,INTENT(IN),TARGET :: BUFMAT(*)
89 my_real
90 . SHELL_SCALAR(*),X(3,NUMNOD),V(3,NUMNOD),W(3,NUMNOD),D(3,NUMNOD),THKE(*),EHOUR(*),GEO(NPROPG,NUMGEO),
91 . PM(NPROPM,NUMMAT),ERR_THK_SH4(*), ERR_THK_SH3(NUMELTG)
92 INTEGER IPARG(NPARG,NGROUP),IXC(NIXC,NUMELC),IXTG(NIXTG,NUMELTG),
93 . IPM(NPROPMI,NUMMAT),
94 . IGEO(NPROPGI,NUMGEO), ID_ELEM(*),ITY_ELEM(*),
95 . IS_WRITTEN_SHELL(*),IPARTC(NUMELC),IPARTTG(NUMELTG),H3D_PART(*),
96 . LAYER_INPUT ,IPT_INPUT,PLY_INPUT,IUVAR_INPUT,NG,IDMDS,ID,
97 . MDS_MATID(*),IMDSVAR
98 INTEGER ,INTENT(INOUT):: SHELL_STACKSIZE
99 INTEGER, INTENT(IN) :: MAX_SHELL_STACKSIZE ! Size of SHELL_STACK / Output for H3D
100 REAL(KIND=4),dimension(max_shell_stacksize),INTENT(INOUT) :: shell_stack ! SHELL_STACK for H3D / Output for H3D
101 TYPE (ELBUF_STRUCT_), DIMENSION(NGROUP), TARGET :: ELBUF_TAB
102 TYPE (STACK_PLY) :: STACK
103 CHARACTER(NCHARLINE100)::KEYWORD
104 TYPE (MULTI_FVM_STRUCT), INTENT(IN) :: MULTI_FVM
105 TYPE(t_ale_connectivity), INTENT(IN) :: ALE_CONNECT
106 INTEGER ,INTENT(IN) :: MODE
107 TYPE (MATPARAM_STRUCT_) ,DIMENSION(NUMMAT) ,INTENT(IN) :: MATPARAM
108 INTEGER ,INTENT(IN) :: H3D_LIGHT
109C-----------------------------------------------
110C L o c a l V a r i a b l e s
111C-----------------------------------------------
112 my_real evar(mvsiz),dam1(mvsiz),dam2(mvsiz),wpla(mvsiz),dmax(mvsiz),wpmax(mvsiz),fail(mvsiz),
113 . epst1(mvsiz),epst2(mvsiz),epsf1(mvsiz),epsf2(mvsiz),value(mvsiz),vg(5),vly(5),ve(5),mass(mvsiz),
114 . ninty,vonm2,s1,s2,s12,dmgmx,a1,a2,a3,a4,dir1_1,dir1_2,aa,bb,v1,v2,v3,x21,x32,x34,
115 . x41,y21,y32,y34,y41,z21,z32,z34,z41,suma,vr,vs,x31,y31,z31,e11,e12,e13,e21,e22,e23,sum_,area,x2l,
116 . e1x,e1y,e1z,e2x,e2y,e2z,e3x,e3y,e3z,rx,ry,rz,s_x,s_y,s_z,rho0(mvsiz),thk0,xx1,xx2,xx3,yy1,yy2,yy3,zz1,zz2,zz3,a0,
117 . rindx,vfrac(mvsiz,1:21),tmp(3,3),cumul(3),vx,vy,vz,surf,nx,ny,nz,phi,err,pres(mvsiz),vel(0:3),maxdamini,
118 . volfrac,bfrac
119 INTEGER I,I1,II,J,NEL,NPTR,NPTS,NPTT,NLAY,L,IFAIL,ILAY,
120 . IR,IS,IT,IL,MLW, NUVAR,NFAIL,
121 . N,K,K1,K2,JTURB,
122 . OFFSET,IHBE,NPG, MPT,IPT,IADR,IPMAT,
123 . isubstack,ithk,id_ply,iok,n1,n2,n3,n4,
124 . imat,iu(4),nfrac,ipos,itrimat,ns,iad2,idrape,nlay_fail,ilay0,submatlaw,
125 . tag, mlw_lay
126 INTEGER PID(MVSIZ),MAT(MVSIZ),MATLY(MVSIZ*100),FAILG(100,MVSIZ),
127 . IPLY,NLAY_COUNT,
128 . IOK_PART(MVSIZ),JJ(5),NPTG,IUVAR,
129 . IS_WRITTEN_VALUE(MVSIZ),IV,KFACE,NB_FACE,IADBUF,NUPARAM,ISUBMAT,IS_EULER,IS_ALE,
130 . ipinch,ipg,user_ok,ialel,imode,nmod,mat_id,mid,ierr,mt
131 LOGICAL DETECTED
132 LOGICAL IS_LIGHTER
133 CHARACTER*5 BUFF
134 TYPE(G_BUFEL_) ,POINTER :: GBUF
135 TYPE(L_BUFEL_) ,POINTER :: LBUF
136 TYPE(BUF_LAY_) ,POINTER :: BUFLY
137 TYPE(buf_fail_) ,POINTER :: FBUF,FBUF1,FBUF2
138 TYPE(L_BUFEL_) ,POINTER :: LBUF1,LBUF2,LBUF3,LBUF4
139 TYPE(BUF_MAT_) ,POINTER :: MBUF
140 TYPE(L_BUFEL_DIR_) ,POINTER :: LBUF_DIR
141 my_real, DIMENSION(:), POINTER :: UVAR
142 my_real, DIMENSION(:) ,POINTER :: uparam
143 my_real :: vi(21) !< submaterial volumes at reference densities (max submat : 21)
144 my_real :: v0i(21) !< submaterial volumes at reference densities (max submat : 21)
145 my_real :: v0g !< global volume at reference density (mixture)
146 my_real :: rho0i(21) !< submaterial initial mass densities (max submat : 21)
147 my_real :: rhoi(21) !< submaterial mass densities (max submat : 21)
148 my_real :: rho0g !< global initial mass density (mixture)
149 DATA ns/10/
150C-----------------------------------------------
151C S o u r c e L i n e s
152C-----------------------------------------------
153 ninty = 90.
154 CALL initbuf(iparg ,ng ,
155 2 mlw ,nel ,nft ,iad ,ity ,
156 3 npt ,jale ,ismstr ,jeul ,jturb ,
157 4 jthe ,jlag ,jmult ,jhbe ,jivf ,
158 5 mid ,jpor ,jcvt ,jclose ,jplasol ,
159 6 irep ,iint ,igtyp ,israt ,isrot ,
160 7 icsen ,isorth ,isorthg ,ifailure,jsms )
161
162 IF(mlw /= 13) THEN
163
164 nft = iparg(3,ng)
165 iad = iparg(4,ng)
166 isubstack = iparg(71,ng)
167 is_euler = iparg(11,ng)
168 is_ale = iparg(7,ng)
169
170 iok_part(1:nel) = 0
171
172 DO i=1,5
173 jj(i) = nel*(i-1)
174 ENDDO
175
176 is_lighter = .false.
177 DO i=1,nel
178 value(i) = zero
179 is_written_value(i) = 0
180 ENDDO
181C-----------------------------------------------
182C 3-NODE-SHELL & 4-NODE-SHELL
183C-----------------------------------------------
184 IF (ity == 3.OR.ity == 7) THEN
185
186 gbuf => elbuf_tab(ng)%GBUF
187 npt = iparg(6,ng)
188 ihbe = iparg(23,ng)
189 irep = iparg(35,ng)
190 igtyp = iparg(38,ng)
191 ithk = iparg(28,ng)
192 mpt = iabs(npt)
193 nptr = elbuf_tab(ng)%NPTR
194 npts = elbuf_tab(ng)%NPTS
195 nptt = elbuf_tab(ng)%NPTT
196 nlay = elbuf_tab(ng)%NLAY
197 idrape = elbuf_tab(ng)%IDRAPE
198
199 npg = nptr*npts
200 nuvar = 0
201 ipinch= iparg(90,ng)
202c
203 IF (ity == 3) offset = 0
204 IF (ity == 7) offset = numelc
205c
206 IF(.NOT. called_from_python) THEN
207 DO i=1,nel
208 IF (ity == 3) THEN
209 id_elem(offset+nft+i) = ixc(nixc,nft+i)
210 ity_elem(offset+nft+i) = 3
211 IF( h3d_part(ipartc(nft+i)) == 1) iok_part(i) = 1
212 ELSEIF (ity == 7) THEN
213 id_elem(offset+nft+i) = ixtg(nixtg,nft+i)
214 ity_elem(offset+nft+i) = 7
215 IF( h3d_part(iparttg(nft+i)) == 1) iok_part(i) = 1
216 ENDIF
217 ENDDO
218 ENDIF
219
220 IF( igtyp == 10 .OR. igtyp == 11 .OR. igtyp == 16 .OR. igtyp == 17) THEN
221 npt = 1
222 mpt = npt
223 ELSEIF (igtyp == 51 .OR. igtyp == 52) THEN
224 IF(layer_input == -2) THEN
225 npt= elbuf_tab(ng)%BUFLY(1)%NPTT
226 ELSEIF(layer_input == -3) THEN
227 npt= elbuf_tab(ng)%BUFLY(nlay)%NPTT
228 ELSEIF(layer_input > 0 .AND. layer_input <= nlay) THEN
229 npt= elbuf_tab(ng)%BUFLY(layer_input)%NPTT
230 ENDIF
231 IF( ply_input > 0) THEN
232 DO j=1,nlay
233 id_ply = 0
234 IF (igtyp == 51) THEN
235 id_ply = igeo(1,stack%IGEO(2+j,isubstack))
236 ELSEIF (igtyp == 52) THEN
237 id_ply = ply_info(1,stack%IGEO(2+j,isubstack)-numstack)
238 ENDIF
239 IF (id_ply == ply_input ) THEN
240 npt= elbuf_tab(ng)%BUFLY(j)%NPTT
241 EXIT
242 ENDIF
243 ENDDO
244 ENDIF
245 mpt = max(1,npt)
246 ENDIF
247c
248 ilay = layer_input
249 ipt = ipt_input
250 iply = ply_input
251 iuvar = iuvar_input
252 user_ok = 0
253 imode = mode
254c
255 IF (keyword == 'MDS') iuvar = imdsvar
256 IF (igtyp == 51 .OR. igtyp == 52) THEN
257 IF (ilay == -2) ilay = 1
258 IF (ilay == -3) ilay = nlay
259 IF (ipt == -2) ipt = 1
260 IF (ipt == -3 .AND. ilay > 0 ) ipt = max(1,elbuf_tab(ng)%BUFLY(ilay)%NPTT)
261 ELSE
262 IF (ilay == -2) ilay = 1
263 IF (ilay == -3) ilay = nlay
264 IF (ipt == -2) ipt = 1
265 IF (ipt == -3) ipt = max(1,npt)
266 ENDIF
267C---------------------
268 DO i=1,nel
269 value(i) = zero
270 IF(.NOT. called_from_python) THEN
271 shell_stack(offset+nft+i) = zero ! Default = zero in all cases !
272 ELSE
273 shell_scalar(1:mvsiz) = zero
274 ENDIF
275 ENDDO
276C-----------------------------------------------
277C Mass computation
278C-----------------------------------------------
279 IF (keyword == 'MASS' .OR. keyword == 'HOURGLASS' .OR. keyword == 'ENER' .OR. keyword(1:4) == 'EINT') THEN
280C-----------------------------------------------
281C 4-NODE-SHELL
282C-----------------------------------------------
283 IF(ity==3)THEN
284C
285 IF(igtyp /= 17 . and. igtyp /= 51 .AND. igtyp /= 52) THEN
286 DO i=1,nel
287 n = i + nft
288 rho0(i) = pm(1,ixc(1,n))
289 thk0 = geo(1,ixc(6,n))
290 n1 = ixc(2,n)
291 n2 = ixc(3,n)
292 n3 = ixc(4,n)
293 n4 = ixc(5,n)
294 xx1 = x(1,n3)-d(1,n3)-x(1,n1)+d(1,n1)
295 yy1 = x(2,n3)-d(2,n3)-x(2,n1)+d(2,n1)
296 zz1 = x(3,n3)-d(3,n3)-x(3,n1)+d(3,n1)
297 xx2 = x(1,n4)-d(1,n4)-x(1,n2)+d(1,n2)
298 yy2 = x(2,n4)-d(2,n4)-x(2,n2)+d(2,n2)
299 zz2 = x(3,n4)-d(3,n4)-x(3,n2)+d(3,n2)
300 xx3 = yy1*zz2 - zz1*yy2
301 yy3 = zz1*xx2 - xx1*zz2
302 zz3 = xx1*yy2 - yy1*xx2
303 a0 = half*sqrt(xx3*xx3 + yy3*yy3 + zz3*zz3)
304 mass(i) = rho0(i)*thk0*a0
305 ENDDO
306 ELSE
307 DO i=1,nel
308 n = i + nft
309 rho0(i) = pm(1,ixc(1,n))
310 thk0 = stack%GEO(1,isubstack)
311 n1 = ixc(2,n)
312 n2 = ixc(3,n)
313 n3 = ixc(4,n)
314 n4 = ixc(5,n)
315 xx1 = x(1,n3)-d(1,n3)-x(1,n1)+d(1,n1)
316 yy1 = x(2,n3)-d(2,n3)-x(2,n1)+d(2,n1)
317 zz1 = x(3,n3)-d(3,n3)-x(3,n1)+d(3,n1)
318 xx2 = x(1,n4)-d(1,n4)-x(1,n2)+d(1,n2)
319 yy2 = x(2,n4)-d(2,n4)-x(2,n2)+d(2,n2)
320 zz2 = x(3,n4)-d(3,n4)-x(3,n2)+d(3,n2)
321 xx3 = yy1*zz2 - zz1*yy2
322 yy3 = zz1*xx2 - xx1*zz2
323 zz3 = xx1*yy2 - yy1*xx2
324 a0 = half*sqrt(xx3*xx3 + yy3*yy3 + zz3*zz3)
325 mass(i) = rho0(i)*thk0*a0
326 ENDDO
327 ENDIF
328C-----------------------------------------------
329C 3-NODE-SHELL
330C-----------------------------------------------
331 ELSEIF(ity==7)THEN
332C
333 IF(igtyp /= 17 . and. igtyp /= 51 .AND. igtyp /= 52) THEN
334 DO i=1,nel
335 n = i + nft
336 rho0(i) = pm(1,ixtg(1,n))
337 thk0 = geo(1,ixtg(5,n))
338 n1 = ixtg(2,n)
339 n2 = ixtg(3,n)
340 n3 = ixtg(4,n)
341 xx1 = x(1,n2)-d(1,n2)-x(1,n1)+d(1,n1)
342 yy1 = x(2,n2)-d(2,n2)-x(2,n1)+d(2,n1)
343 zz1 = x(3,n2)-d(3,n2)-x(3,n1)+d(3,n1)
344 xx2 = x(1,n3)-d(1,n3)-x(1,n1)+d(1,n1)
345 yy2 = x(2,n3)-d(2,n3)-x(2,n1)+d(2,n1)
346 zz2 = x(3,n3)-d(3,n3)-x(3,n1)+d(3,n1)
347 xx3 = yy1*zz2 - zz1*yy2
348 yy3 = zz1*xx2 - xx1*zz2
349 zz3 = xx1*yy2 - yy1*xx2
350 a0 = half*sqrt(xx3*xx3 + yy3*yy3 + zz3*zz3)
351 mass(i) = rho0(i)*thk0*a0
352 ENDDO
353 ELSE
354 DO i=1,nel
355 n = i + nft
356 rho0(i) = pm(1,ixtg(1,n))
357 thk0 = stack%GEO(1,isubstack)
358 n1 = ixtg(2,n)
359 n2 = ixtg(3,n)
360 n3 = ixtg(4,n)
361 xx1 = x(1,n2)-d(1,n2)-x(1,n1)+d(1,n1)
362 yy1 = x(2,n2)-d(2,n2)-x(2,n1)+d(2,n1)
363 zz1 = x(3,n2)-d(3,n2)-x(3,n1)+d(3,n1)
364 xx2 = x(1,n3)-d(1,n3)-x(1,n1)+d(1,n1)
365 yy2 = x(2,n3)-d(2,n3)-x(2,n1)+d(2,n1)
366 zz2 = x(3,n3)-d(3,n3)-x(3,n1)+d(3,n1)
367 xx3 = yy1*zz2 - zz1*yy2
368 yy3 = zz1*xx2 - xx1*zz2
369 zz3 = xx1*yy2 - yy1*xx2
370 a0 = half*sqrt(xx3*xx3 + yy3*yy3 + zz3*zz3)
371 mass(i) = rho0(i)*thk0*a0
372 ENDDO
373 ENDIF
374 ENDIF
375 ENDIF
376C---------------------
377
378C
379 IF (mlw == 0 .OR. mlw == 13) THEN
380 !nothing to do
381C--------------------------------------------------
382 ELSEIF (keyword == 'MASS') THEN ! MASS
383C--------------------------------------------------
384 DO i=1,nel
385 value(i) = mass(i)
386 is_written_value(i) = 1
387 ENDDO
388C--------------------------------------------------
389 ELSEIF (keyword == 'DENS') THEN ! DENS
390C--------------------------------------------------
391 IF (mlw /= 151) THEN
392 IF (ity == 3) THEN
393 DO i=1,nel
394 n = i + nft
395 value(i) = pm(1,ixc(1,n))
396 is_written_value(i) = 1
397 ENDDO
398 ELSEIF(ity == 7) THEN
399 DO i=1,nel
400 n = i + nft
401 value(i) = pm(1,ixtg(1,n))
402 is_written_value(i) = 1
403 ENDDO
404 ENDIF
405 ELSE
406 DO i=1,nel
407 value(i) = multi_fvm%RHO(i + nft)
408 is_written_value(i) = 1
409 ENDDO
410 ENDIF
411C--------------------------------------------------
412 ELSEIF (keyword == 'ENER') THEN ! = EINTM
413C--------------------------------------------------
414 IF (mlw /= 151) THEN
415 DO i=1,nel
416 value(i) = (gbuf%EINT(i)+ gbuf%EINT(i+nel))/max(em20,mass(i))
417 is_written_value(i) = 1
418 ENDDO
419 ELSE
420 DO i=1,nel
421 value(i) = multi_fvm%EINT(i + nft) / multi_fvm%RHO(i + nft)
422 is_written_value(i) = 1
423 ENDDO
424 ENDIF
425C--------------------------------------------------
426c temporary (tria entity is not yet created)
427 ELSEIF (keyword == 'EINT')THEN !SI:J
428C--------------------------------------------------
429 IF (mlw == 151) THEN
430 DO i = 1, nel
431 value(i) = multi_fvm%EINT(i + nft) * gbuf%VOL(i)
432 is_written_value(i) = 1
433 ENDDO
434 ELSE
435 DO i=1,nel
436 n = i + nft
437 IF(n2d == 0)THEN
438 value(i) = (gbuf%EINT(i) + gbuf%EINT(i+nel))
439 ELSE
440 value(i) = gbuf%EINT(i)*gbuf%VOL(i)
441 ENDIF
442 is_written_value(i) = 1
443 ENDDO
444 ENDIF
445C--------------------------------------------------
446c temporary (tria entity is not yet created)
447 ELSEIF (keyword == 'EINTM')THEN !SI:J/kg
448C--------------------------------------------------
449 !LAG: GBUF%VOL = V0, GBUF%EINT=rho0.e
450 IF (mlw == 151) THEN
451 DO i = 1, nel
452 value(i) = multi_fvm%EINT(i + nft) / multi_fvm%RHO(i + nft) !
453 is_written_value(i) = 1
454 ENDDO
455 ELSE
456 IF(n2d == 0)THEN
457 DO i=1,nel
458 value(i) = (gbuf%EINT(i)+ gbuf%EINT(i+nel))/max(em20,mass(i))
459 is_written_value(i) = 1
460 ENDDO
461 ELSE
462 DO i=1,nel
463 value(i) = gbuf%EINT(i)/gbuf%RHO(i)
464 is_written_value(i) = 1
465 ENDDO
466 ENDIF
467 ENDIF
468C--------------------------------------------------
469c temporary (tria entity is not yet created)
470 ELSEIF (keyword == 'EINTV')THEN !SI:J/m^3
471C--------------------------------------------------
472 IF (mlw == 151) THEN
473 DO i = 1, nel
474 value(i) = multi_fvm%EINT(i + nft)
475 is_written_value(i) = 1
476 ENDDO
477 ELSE
478 IF(n2d == 0)THEN
479 DO i=1,nel
480 value(i) = (gbuf%EINT(i)+ gbuf%EINT(i+nel))*rho0(i)/mass(i)
481 is_written_value(i) = 1
482 ENDDO
483 ELSE
484 DO i=1,nel
485 value(i) = gbuf%EINT(i)
486 is_written_value(i) = 1
487 ENDDO
488 ENDIF
489 ENDIF
490C--------------------------------------------------
491c temporary (tria entity is not yet created)
492C--------------------------------------------------
493 ELSEIF (keyword(1:4) == 'ENTH')THEN
494C--------------------------------------------------
495 IF (mlw == 151) THEN
496 DO i = 1, nel
497 pres(i) = multi_fvm%PRES(i + nft)
498 ENDDO
499 ELSE
500 DO i=1,nel
501 IF(gbuf%G_SIG > 0) THEN
502 pres(i) = - (gbuf%SIG(jj(1) + i)+ gbuf%SIG(jj(2) + i) + gbuf%SIG(jj(3) + i))*third
503 ELSE
504 pres(i) = zero
505 ENDIF
506 ENDDO
507 ENDIF
508 !GBUF%EINT is rho.e
509 IF(keyword == 'ENTH')THEN
510 IF (mlw == 151) THEN
511 DO i = 1, nel
512 value(i) = multi_fvm%EINT(i + nft) / multi_fvm%RHO(i + nft) + pres(i)*gbuf%VOL(i) !
513 is_written_value(i) = 1
514 ENDDO
515 ELSE
516 IF(n2d == 0)THEN
517 IF(gbuf%G_RHO > 0 .AND. gbuf%G_VOL > 0 )THEN
518 DO i=1,nel
519 value(i) = gbuf%EINT(i)/gbuf%RHO(i) + pres(i)*gbuf%VOL(i)
520 is_written_value(i) = 1
521 ENDDO
522 ENDIF
523 ENDIF
524 ENDIF
525 ELSEIF(keyword == 'ENTHV')THEN
526 IF (mlw == 151) THEN
527 DO i = 1, nel
528 value(i) = multi_fvm%EINT(i + nft) / multi_fvm%RHO(i + nft)/gbuf%VOL(i) + pres(i) !
529 is_written_value(i) = 1
530 ENDDO
531 ELSE
532 IF(n2d == 0)THEN
533 if(gbuf%G_EINT > 0 .AND. gbuf%G_RHO > 0 .AND. gbuf%G_VOL > 0) THEN
534 DO i=1,nel
535 value(i) = gbuf%EINT(i)/gbuf%VOL(i)/gbuf%RHO(i) + pres(i)
536 is_written_value(i) = 1
537 ENDDO
538 endif
539 ENDIF
540 ENDIF
541 ELSEIF(keyword == 'ENTHM')THEN
542 IF (mlw == 151) THEN
543 DO i = 1, nel
544 mass(i) = multi_fvm%RHO(i + nft)*gbuf%VOL(i)
545 value(i) = (multi_fvm%EINT(i + nft) / multi_fvm%RHO(i + nft) + pres(i)*gbuf%VOL(i))/mass(i) !
546 is_written_value(i) = 1
547 ENDDO
548 ELSE
549 IF(n2d == 0)THEN
550 IF(gbuf%G_RHO > 0 .AND. gbuf%G_VOL > 0 .AND. gbuf%G_EINT > 0) THEN
551 DO i=1,nel
552 mass(i)=gbuf%RHO(i)*gbuf%VOL(i)
553 value(i) = (gbuf%EINT(i)/gbuf%RHO(i) + pres(i)*gbuf%VOL(i))/mass(i)
554 is_written_value(i) = 1
555 ENDDO
556 ENDIF
557 ENDIF
558 ENDIF
559 ENDIF
560C--------------------------------------------------
561 ELSEIF(keyword == 'P')THEN
562C--------------------------------------------------
563 IF (mlw == 151) THEN
564 DO i=1,nel
565 value(i) = multi_fvm%PRES(i + nft)
566 is_written_value(i) = 1
567 ENDDO
568 ENDIF
569C--------------------------------------------------
570 ELSEIF (keyword == 'THICK') THEN ! THK
571C--------------------------------------------------
572 IF (ithk >0) THEN
573 DO i=1,nel
574 value(i) = gbuf%THK(i)
575 is_written_value(i) = 1
576 ENDDO
577 ELSE
578 IF (ity == 3) THEN ! SHELL
579 DO i=1,nel
580 value(i) = thke(nft+i)
581 is_written_value(i) = 1
582 ENDDO
583 ELSEIF (ity == 7) THEN ! SH3N
584 DO i=1,nel
585 value(i) = thke(nft+i+numelc)
586 is_written_value(i) = 1
587 ENDDO
588 ENDIF ! IF (ITY == 3)
589 END IF
590C--------------------------------------------------
591 ELSEIF (keyword == 'VONM') THEN ! Von Mises
592C--------------------------------------------------
593 DO i=1,nel
594 s1 = gbuf%FOR(jj(1)+i)
595 s2 = gbuf%FOR(jj(2)+i)
596 s12= gbuf%FOR(jj(3)+i)
597 vonm2= s1*s1 + s2*s2 - s1*s2 + three*s12*s12
598 value(i) = sqrt(vonm2)
599 is_written_value(i) = 1
600 ENDDO
601C--------------------------------------------------
602 ELSEIF (keyword == 'DAM1') THEN ! DAM1
603C--------------------------------------------------
604 IF (mlw == 15)THEN
605c
606 ! Resetting values
607 DO i = 1,nel
608 value(i) = zero
609 ENDDO
610c
611 ! If no specific input PLY=null LAYER=null NPT=null
612 IF (ilay == -1 .AND. ipt == -1 .AND. iply == -1) THEN
613 ! Multilayer properties TYPE 10/11/16/17/51/52
614 ! -> Mean value among all layers and integration points
615 IF (nlay > 1) THEN
616 DO i = 1,nel
617 DO n = 1,nlay
618 nptt = elbuf_tab(ng)%BUFLY(n)%NPTT
619 DO it = 1,nptt
620 DO ir = 1,nptr
621 DO is = 1,npts
622 lbuf => elbuf_tab(ng)%BUFLY(n)%LBUF(ir,is,it)
623 value(i) = value(i) + lbuf%DAM(jj(1)+i)/(nptt*nptr*npts)
624 ENDDO
625 ENDDO
626 ENDDO
627 ENDDO
628 value(i) = value(i) / nlay
629 is_written_value(i) = 1
630 ENDDO
631 ! Single layer properties TYPE 1/9
632 ! -> Mean value among all layers and integration points
633 ELSEIF (mpt > 0) THEN
634 nptt = elbuf_tab(ng)%BUFLY(1)%NPTT
635 DO i = 1,nel
636 DO it = 1,nptt
637 DO ir = 1,nptr
638 DO is = 1,npts
639 lbuf => elbuf_tab(ng)%BUFLY(1)%LBUF(ir,is,it)
640 value(i) = value(i) + lbuf%DAM(jj(1)+i)/(nptt*nptr*npts)
641 ENDDO
642 ENDDO
643 ENDDO
644 is_written_value(i) = 1
645 ENDDO
646 ENDIF
647c
648 ! If ply and int. point input: ply=iply layer=null npt=ipt
649 ! -> Properties type 17/51/52 only
650 ELSEIF (iply > 0 .AND. ipt <= mpt .AND. ipt > 0) THEN
651 DO j = 1,nlay
652 nptt = elbuf_tab(ng)%BUFLY(j)%NPTT
653 id_ply = 0
654 IF (igtyp == 17 .OR. igtyp == 51) THEN
655 id_ply = igeo(1,stack%IGEO(2+j,isubstack))
656 ELSEIF (igtyp == 52) THEN
657 id_ply = ply_info(1,stack%IGEO(2+j,isubstack)-numstack)
658 ENDIF
659 IF (id_ply == iply) THEN
660 IF (ipt <= nptt) THEN
661 DO i = 1,nel
662 DO ir = 1,nptr
663 DO is = 1,npts
664 lbuf => elbuf_tab(ng)%BUFLY(j)%LBUF(ir,is,ipt)
665 value(i) = value(i) + lbuf%DAM(jj(1)+i)/(nptr*npts)
666 ENDDO
667 ENDDO
668 is_written_value(i) = 1
669 ENDDO
670 ENDIF
671 ENDIF
672 ENDDO
673c
674 ! If ply input only: PLY=IPLY LAYER=null NPT=null
675 ! -> Properties type 17/51/52 only
676 ELSEIF (iply > 0 .AND. ipt == -1) THEN
677 DO j = 1,nlay
678 nptt = elbuf_tab(ng)%BUFLY(j)%NPTT
679 id_ply = 0
680 IF (igtyp == 17 .OR. igtyp == 51) THEN
681 id_ply = igeo(1,stack%IGEO(2+j,isubstack))
682 ELSEIF (igtyp == 52) THEN
683 id_ply = ply_info(1,stack%IGEO(2+j,isubstack)-numstack)
684 ENDIF
685 IF (id_ply == iply) THEN
686 DO i = 1,nel
687 DO ir = 1,nptr
688 DO is = 1,npts
689 DO it = 1,nptt
690 lbuf => elbuf_tab(ng)%BUFLY(j)%LBUF(ir,is,it)
691 value(i) = value(i) + lbuf%DAM(jj(1)+i)/(nptr*npts*nptt)
692 ENDDO
693 ENDDO
694 ENDDO
695 is_written_value(i) = 1
696 ENDDO
697 ENDIF
698 ENDDO
699c
700 ! If layer input : PLY=null LAYER=ILAY NPT=null/IPT
701 ! -> Properties type 10/11/16 only
702 ELSEIF (ilay <= nlay .AND. ilay > 0) THEN
703 ipt = 1
704 IF (igtyp == 10 .OR. igtyp == 11 .OR. igtyp == 16) THEN
705 DO i=1,nel
706 DO ir = 1,nptr
707 DO is = 1,npts
708 lbuf => elbuf_tab(ng)%BUFLY(ilay)%LBUF(ir,is,1)
709 VALUE(i) = value(i) + lbuf%DAM(jj(1)+i)/(nptr*npts)
710 ENDDO
711 ENDDO
712 is_written_value(i) = 1
713 ENDDO
714 ENDIF
715c
716 ! If intg. point input : PLY=null LAYER=null NPT=IPT
717 ! -> Properties type 1/9 only
718 ELSEIF (ipt <= npt .AND. ipt > 0) THEN
719 IF (igtyp == 1 .OR. igtyp == 9) THEN
720 DO i=1,nel
721 DO ir = 1,nptr
722 DO is = 1,npts
723 lbuf => elbuf_tab(ng)%BUFLY(1)%LBUF(ir,is,ipt)
724 value(i) = value(i) + lbuf%DAM(jj(1)+i)/(nptr*npts)
725 ENDDO
726 ENDDO
727 is_written_value(i) = 1
728 ENDDO
729 ENDIF
730 ENDIF
731 ENDIF
732C--------------------------------------------------
733 ELSEIF(keyword == 'DAM2')THEN ! DAM2
734C--------------------------------------------------
735 IF (mlw == 15)THEN
736c
737 ! Resetting values
738 DO i = 1,nel
739 value(i) = zero
740 ENDDO
741c
742 ! If no specific input PLY=null LAYER=null NPT=null
743 IF (ilay == -1 .AND. ipt == -1 .AND. iply == -1) THEN
744 ! Multilayer properties TYPE 10/11/16/17/51/52
745 ! -> Mean value among all layers and integration points
746 IF (nlay > 1) THEN
747 DO i = 1,nel
748 DO n = 1,nlay
749 nptt = elbuf_tab(ng)%BUFLY(n)%NPTT
750 DO it = 1,nptt
751 DO ir = 1,nptr
752 DO is = 1,npts
753 lbuf => elbuf_tab(ng)%BUFLY(n)%LBUF(ir,is,it)
754 value(i) = value(i) + lbuf%DAM(jj(2)+i)/(nptt*nptr*npts)
755 ENDDO
756 ENDDO
757 ENDDO
758 ENDDO
759 value(i) = value(i) / nlay
760 is_written_value(i) = 1
761 ENDDO
762 ! Single layer properties TYPE 1/9
763 ! -> Mean value among all layers and integration points
764 ELSEIF (mpt > 0) THEN
765 nptt = elbuf_tab(ng)%BUFLY(1)%NPTT
766 DO i = 1,nel
767 DO it = 1,nptt
768 DO ir = 1,nptr
769 DO is = 1,npts
770 lbuf => elbuf_tab(ng)%BUFLY(1)%LBUF(ir,is,it)
771 value(i) = value(i) + lbuf%DAM(jj(2)+i)/(nptt*nptr*npts)
772 ENDDO
773 ENDDO
774 ENDDO
775 is_written_value(i) = 1
776 ENDDO
777 ENDIF
778c
779 ! If ply and int. point input: PLY=IPLY LAYER=null NPT=IPT
780 ! -> Properties type 17/51/52 only
781 ELSEIF (iply > 0 .AND. ipt <= mpt .AND. ipt > 0) THEN
782 DO j = 1,nlay
783 nptt = elbuf_tab(ng)%BUFLY(j)%NPTT
784 id_ply = 0
785 IF (igtyp == 17 .OR. igtyp == 51) THEN
786 id_ply = igeo(1,stack%IGEO(2+j,isubstack))
787 ELSEIF (igtyp == 52) THEN
788 id_ply = ply_info(1,stack%IGEO(2+j,isubstack)-numstack)
789 ENDIF
790 IF (id_ply == iply) THEN
791 IF (ipt <= nptt) THEN
792 DO i = 1,nel
793 DO ir = 1,nptr
794 DO is = 1,npts
795 lbuf => elbuf_tab(ng)%BUFLY(j)%LBUF(ir,is,ipt)
796 value(i) = value(i) + lbuf%DAM(jj(2)+i)/(nptr*npts)
797 ENDDO
798 ENDDO
799 is_written_value(i) = 1
800 ENDDO
801 ENDIF
802 ENDIF
803 ENDDO
804c
805 ! If ply input only: PLY=IPLY LAYER=null NPT=null
806 ! -> Properties type 17/51/52 only
807 ELSEIF (iply > 0 .AND. ipt == -1) THEN
808 DO j = 1,nlay
809 nptt = elbuf_tab(ng)%BUFLY(j)%NPTT
810 id_ply = 0
811 IF (igtyp == 17 .OR. igtyp == 51) THEN
812 id_ply = igeo(1,stack%IGEO(2+j,isubstack))
813 ELSEIF (igtyp == 52) THEN
814 id_ply = ply_info(1,stack%IGEO(2+j,isubstack)-numstack)
815 ENDIF
816 IF (id_ply == iply) THEN
817 DO i = 1,nel
818 DO ir = 1,nptr
819 DO is = 1,npts
820 DO it = 1,nptt
821 lbuf => elbuf_tab(ng)%BUFLY(j)%LBUF(ir,is,it)
822 value(i) = value(i) + lbuf%DAM(jj(2)+i)/(nptr*npts*nptt)
823 ENDDO
824 ENDDO
825 ENDDO
826 is_written_value(i) = 1
827 ENDDO
828 ENDIF
829 ENDDO
830c
831 ! If layer input : PLY=null LAYER=ILAY NPT=null/IPT
832 ! -> Properties type 10/11/16 only
833 ELSEIF (ilay <= nlay .AND. ilay > 0) THEN
834 ipt = 1
835 IF (igtyp == 10 .OR. igtyp == 11 .OR. igtyp == 16) THEN
836 DO i=1,nel
837 DO ir = 1,nptr
838 DO is = 1,npts
839 lbuf => elbuf_tab(ng)%BUFLY(ilay)%LBUF(ir,is,1)
840 value(i) = value(i) + lbuf%DAM(jj(2)+i)/(nptr*npts)
841 ENDDO
842 ENDDO
843 is_written_value(i) = 1
844 ENDDO
845 ENDIF
846c
847 ! If intg. point input : PLY=null LAYER=null NPT=IPT
848 ! -> Properties type 1/9 only
849 ELSEIF (ipt <= npt .AND. ipt > 0) THEN
850 IF (igtyp == 1 .OR. igtyp == 9) THEN
851 DO i=1,nel
852 DO ir = 1,nptr
853 DO is = 1,npts
854 lbuf => elbuf_tab(ng)%BUFLY(1)%LBUF(ir,is,ipt)
855 value(i) = value(i) + lbuf%DAM(jj(2)+i)/(nptr*npts)
856 ENDDO
857 ENDDO
858 is_written_value(i) = 1
859 ENDDO
860 ENDIF
861 ENDIF
862 ENDIF
863C--------------------------------------------------
864 ELSEIF(keyword == 'DAM3')THEN ! DAM3
865C--------------------------------------------------
866 IF (mlw == 15)THEN
867c
868 ! Resetting values
869 DO i = 1,nel
870 value(i) = zero
871 ENDDO
872c
873 ! If no specific input PLY=null LAYER=null NPT=null
874 IF (ilay == -1 .AND. ipt == -1 .AND. iply == -1) THEN
875 ! Multilayer properties TYPE 10/11/16/17/51/52
876 ! -> Mean value among all layers and integration points
877 IF (nlay > 1) THEN
878 DO i = 1,nel
879 DO n = 1,nlay
880 nptt = elbuf_tab(ng)%BUFLY(n)%NPTT
881 DO it = 1,nptt
882 DO ir = 1,nptr
883 DO is = 1,npts
884 lbuf => elbuf_tab(ng)%BUFLY(n)%LBUF(ir,is,it)
885 value(i) = value(i) + lbuf%DAM(jj(3)+i)/(nptt*nptr*npts)
886 ENDDO
887 ENDDO
888 ENDDO
889 ENDDO
890 value(i) = value(i) / nlay
891 is_written_value(i) = 1
892 ENDDO
893 ! Single layer properties TYPE 1/9
894 ! -> Mean value among all layers and integration points
895 ELSEIF (mpt > 0) THEN
896 nptt = elbuf_tab(ng)%BUFLY(1)%NPTT
897 DO i = 1,nel
898 DO it = 1,nptt
899 DO ir = 1,nptr
900 DO is = 1,npts
901 lbuf => elbuf_tab(ng)%BUFLY(1)%LBUF(ir,is,it)
902 value(i) = VALUE(i) + lbuf%DAM(jj(3)+i)/(nptt*nptr*npts)
903 ENDDO
904 ENDDO
905 ENDDO
906 is_written_value(i) = 1
907 ENDDO
908 ENDIF
909c
910 ! If ply and int. point input: PLY=IPLY LAYER=null NPT=IPT
911 ! -> Properties type 17/51/52 only
912 ELSEIF (iply > 0 .AND. ipt <= mpt .AND. ipt > 0) THEN
913 DO j = 1,nlay
914 nptt = elbuf_tab(ng)%BUFLY(j)%NPTT
915 id_ply = 0
916 IF (igtyp == 17 .OR. igtyp == 51) THEN
917 id_ply = igeo(1,stack%IGEO(2+j,isubstack))
918 ELSEIF (igtyp == 52) THEN
919 id_ply = ply_info(1,stack%IGEO(2+j,isubstack)-numstack)
920 ENDIF
921 IF (id_ply == iply) THEN
922 IF (ipt <= nptt) THEN
923 DO i = 1,nel
924 DO ir = 1,nptr
925 DO is = 1,npts
926 lbuf => elbuf_tab(ng)%BUFLY(j)%LBUF(ir,is,ipt)
927 value(i) = value(i) + lbuf%DAM(jj(3)+i)/(nptr*npts)
928 ENDDO
929 ENDDO
930 is_written_value(i) = 1
931 ENDDO
932 ENDIF
933 ENDIF
934 ENDDO
935c
936 ! If ply input only: PLY=IPLY LAYER=null NPT=null
937 ! -> Properties type 17/51/52 only
938 ELSEIF (iply > 0 .AND. ipt == -1) THEN
939 DO j = 1,nlay
940 nptt = elbuf_tab(ng)%BUFLY(j)%NPTT
941 id_ply = 0
942 IF (igtyp == 17 .OR. igtyp == 51) THEN
943 id_ply = igeo(1,stack%IGEO(2+j,isubstack))
944 ELSEIF (igtyp == 52) THEN
945 id_ply = ply_info(1,stack%IGEO(2+j,isubstack)-numstack)
946 ENDIF
947 IF (id_ply == iply) THEN
948 DO i = 1,nel
949 DO ir = 1,nptr
950 DO is = 1,npts
951 DO it = 1,nptt
952 lbuf => elbuf_tab(ng)%BUFLY(j)%LBUF(ir,is,it)
953 value(i) = value(i) + lbuf%DAM(jj(3)+i)/(nptr*npts*nptt)
954 ENDDO
955 ENDDO
956 ENDDO
957 is_written_value(i) = 1
958 ENDDO
959 ENDIF
960 ENDDO
961c
962 ! If layer input : PLY=null LAYER=ILAY NPT=null/IPT
963 ! -> Properties type 10/11/16 only
964 ELSEIF (ilay <= nlay .AND. ilay > 0) THEN
965 ipt = 1
966 IF (igtyp == 10 .OR. igtyp == 11 .OR. igtyp == 16) THEN
967 DO i=1,nel
968 DO ir = 1,nptr
969 DO is = 1,npts
970 lbuf => elbuf_tab(ng)%BUFLY(ilay)%LBUF(ir,is,1)
971 value(i) = value(i) + lbuf%DAM(jj(3)+i)/(nptr*npts)
972 ENDDO
973 ENDDO
974 is_written_value(i) = 1
975 ENDDO
976 ENDIF
977c
978 ! If intg. point input : PLY=null LAYER=null NPT=IPT
979 ! -> Properties type 1/9 only
980 ELSEIF (ipt <= npt .AND. ipt > 0) THEN
981 IF (igtyp == 1 .OR. igtyp == 9) THEN
982 DO i=1,nel
983 DO ir = 1,nptr
984 DO is = 1,npts
985 lbuf => elbuf_tab(ng)%BUFLY(1)%LBUF(ir,is,ipt)
986 value(i) = value(i) + lbuf%DAM(jj(3)+i)/(nptr*npts)
987 ENDDO
988 ENDDO
989 is_written_value(i) = 1
990 ENDDO
991 ENDIF
992 ENDIF
993 ENDIF
994C--------------------------------------------------
995 ELSEIF (keyword == 'SIGX') THEN ! Sigx - global
996C--------------------------------------------------
997 DO i=1,nel
998 value(i) = gbuf%FOR(jj(1)+i)
999 is_written_value(i) = 1
1000 ENDDO
1001C--------------------------------------------------
1002 ELSEIF (keyword == 'SIGY') THEN ! Sigy - global
1003C--------------------------------------------------
1004 DO i=1,nel
1005 value(i) = gbuf%FOR(jj(2)+i)
1006 is_written_value(i) = 1
1007 ENDDO
1008C--------------------------------------------------
1009 ELSEIF (keyword == 'SIGZ') THEN ! Sigz - batoz pinching
1010C--------------------------------------------------
1011 IF(ihbe == 11 .AND. ipinch == 1) THEN
1012 DO i=1,nel
1013 value(i) = zero
1014 DO ipg=1,4
1015 value(i) = value(i) + fourth*gbuf%FORPGPINCH(nel*(ipg-1)+i)
1016 ENDDO
1017 is_written_value(i) = 1
1018 ENDDO
1019 ENDIF
1020C--------------------------------------------------
1021 ELSEIF (keyword == 'SIGXY') THEN ! Sigxy - global
1022C--------------------------------------------------
1023 DO i=1,nel
1024 value(i) = gbuf%FOR(jj(3)+i)
1025 is_written_value(i) = 1
1026 ENDDO
1027C--------------------------------------------------
1028 ELSEIF (keyword == 'SIGYZ') THEN ! Sigyz - global
1029C--------------------------------------------------
1030 DO i=1,nel
1031 value(i) = gbuf%FOR(jj(4)+i)
1032 is_written_value(i) = 1
1033 ENDDO
1034C--------------------------------------------------
1035 ELSEIF (keyword == 'SIGZX') THEN ! Sigzx - global
1036C--------------------------------------------------
1037 DO i=1,nel
1038 value(i) = gbuf%FOR(jj(5)+i)
1039 is_written_value(i) = 1
1040 ENDDO
1041C--------------------------------------------------
1042 ELSEIF (keyword == 'HOURGLASS') THEN ! HOUR
1043C--------------------------------------------------
1044 IF (ity == 3) THEN
1045 DO i=1,nel
1046 value(i) = ehour(nft+i+numels)/max(em20,mass(i))
1047 is_written_value(i) = 1
1048 ENDDO
1049 ENDIF
1050C--------------------------------------------------
1051 ELSEIF (keyword == 'EPSD')THEN ! EPSD
1052C--------------------------------------------------
1053 value(1:nel) = gbuf%EPSD(1:nel)
1054 is_written_value(1:nel) = 1
1055C--------------------------------------------------
1056 ELSEIF(keyword(1:9) == 'M151VFRAC') THEN
1057C--------------------------------------------------
1058 IF (mlw == 151) THEN
1059 READ(keyword, '(A9,I10)') buff, imat
1060 IF (imat > 0 .AND. imat <= nlay) THEN
1061 gbuf => elbuf_tab(ng)%GBUF
1062 lbuf => elbuf_tab(ng)%BUFLY(imat)%LBUF(1,1,1)
1063 DO i=1,nel
1064 value(i) = lbuf%VOL(i) / gbuf%VOL(i)
1065 is_written_value(i) = 1
1066 ENDDO
1067 ENDIF
1068 ENDIF
1069C--------------------------------------------------
1070 ELSEIF(keyword(1:8) == 'M151ENER') THEN
1071C--------------------------------------------------
1072 IF (mlw == 151) THEN
1073 READ(keyword, '(A8,I10)') buff, imat
1074 IF (imat > 0 .AND. imat <= nlay) THEN
1075 DO i=1,nel
1076 value(i) = multi_fvm%PHASE_EINT(imat, i + nft) /
1077 . multi_fvm%PHASE_RHO(imat, i + nft)
1078 is_written_value(i) = 1
1079 ENDDO
1080 ENDIF
1081 ENDIF
1082C--------------------------------------------------
1083 ELSEIF(keyword(1:8) == 'M151PRES') THEN
1084C--------------------------------------------------
1085 IF (mlw == 151) THEN
1086 READ(keyword, '(A8,I10)') buff, imat
1087 IF (imat > 0 .AND. imat <= nlay) THEN
1088 DO i=1,nel
1089 value(i) = multi_fvm%PHASE_PRES(imat, i + nft)
1090 is_written_value(i) = 1
1091 ENDDO
1092 ENDIF
1093 ENDIF
1094C--------------------------------------------------
1095 ELSEIF(keyword(1:8) == 'M151DENS') THEN
1096C--------------------------------------------------
1097 IF (mlw == 151) THEN
1098 READ(keyword, '(A8,I10)') buff, imat
1099 IF (imat > 0 .AND. imat <= nlay) THEN
1100 DO i=1,nel
1101 value(i) = multi_fvm%PHASE_RHO(imat, i + nft)
1102 is_written_value(i) = 1
1103 ENDDO
1104 ENDIF
1105 ENDIF
1106C--------------------------------------------------
1107 ELSEIF(keyword == 'THIN')THEN
1108C--------------------------------------------------
1109 DO i=1,nel
1110 value(i) = hundred *(gbuf%THK_I(i)-gbuf%THK(i))/gbuf%THK_I(i)
1111 is_written_value(i) = 1
1112 ENDDO
1113C--------------------------------------------------
1114 ELSEIF (keyword == 'USER' .OR. keyword == 'MDS') THEN
1115C--------------------------------------------------
1116 i1 = (iuvar-1)*nel
1117c ILAYER=NULL NPT=NULL (mid-layer)
1118 IF(ipt == -1 .AND. ilay == -1 .AND. iply == -1 .AND. iuvar > 0 ) THEN
1119 IF (mlw==29 .OR. mlw==30 .OR. mlw==31 .OR. mlw>=33) THEN
1120c
1121 IF (nlay > 1) THEN
1122 il = iabs(nlay)/2 + 1
1123 npt = elbuf_tab(ng)%BUFLY(il)%NPTT
1124 ipt = iabs(npt)/2 + 1
1125 ELSE
1126 il = 1
1127 ipt = iabs(npt)/2 + 1
1128 ENDIF
1129 imat = elbuf_tab(ng)%BUFLY(il)%IMAT
1130 nuvar = elbuf_tab(ng)%BUFLY(il)%NVAR_MAT
1131c
1132 IF(keyword == 'USER') user_ok = 1
1133 IF(idmds > 0)THEN
1134 IF(imat == mds_matid(idmds))user_ok = 1
1135 ENDIF
1136c
1137 IF(user_ok == 1)THEN
1138 IF(iuvar <= nuvar) THEN
1139 IF (mlw == 58 .or. mlw == 158) THEN
1140 DO ir = 1, nptr
1141 DO is = 1, npts
1142 uvar=>elbuf_tab(ng)%BUFLY(il)%MAT(ir,is,ipt)%VAR
1143 IF(iuvar==4.OR.iuvar==5)THEN
1144 DO i=1,nel
1145 value(i) = value(i) + log(uvar(i1 + i)+one)/npg
1146 is_written_value(i) = 1
1147 ENDDO
1148 ELSE
1149 DO i=1,nel
1150 value(i) = value(i) + uvar(i1 + i)/npg
1151 is_written_value(i) = 1
1152 ENDDO
1153 ENDIF
1154 ENDDO
1155 ENDDO
1156 ELSE
1157 DO ir = 1, nptr
1158 DO is = 1, npts
1159 uvar=>elbuf_tab(ng)%BUFLY(il)%MAT(ir,is,ipt)%VAR
1160 DO i=1,nel
1161 value(i) = value(i) + uvar(i1 + i)/npg
1162 is_written_value(i) = 1
1163 ENDDO
1164 ENDDO
1165 ENDDO
1166 ENDIF !MLW=58
1167 ENDIF
1168 ENDIF
1169 ENDIF
1170c PLY=IPLY NPT=IPT
1171 ELSEIF ( iply > 0 .AND. ipt <= mpt .AND. ipt > 0 .AND. iuvar > 0) THEN
1172c
1173 DO j=1,nlay
1174 nuvar = elbuf_tab(ng)%BUFLY(j)%NVAR_MAT
1175 IF(iuvar <= nuvar) THEN
1176 id_ply = 0
1177 IF (igtyp == 17 .OR. igtyp == 51) THEN
1178 id_ply = igeo(1,stack%IGEO(2+j,isubstack))
1179 ELSEIF (igtyp == 52) THEN
1180 id_ply = ply_info(1,stack%IGEO(2+j,isubstack)-numstack)
1181 ENDIF
1182c
1183 IF (id_ply == iply ) THEN
1184 imat = elbuf_tab(ng)%BUFLY(j)%IMAT
1185c
1186 IF(keyword == 'USER') user_ok = 1
1187 IF(idmds > 0)THEN
1188 IF(imat == mds_matid(idmds))user_ok = 1
1189 ENDIF
1190c
1191 IF(user_ok == 1)THEN
1192 bufly => elbuf_tab(ng)%BUFLY(j)
1193 IF (igtyp == 17 .OR. igtyp == 51 .OR. igtyp == 52 ) THEN
1194 nptt = bufly%NPTT
1195 IF( ipt <= nptt) THEN
1196 IF( npg > 1 ) THEN
1197 DO ir=1,nptr
1198 DO is=1,npts
1199 uvar=>elbuf_tab(ng)%BUFLY(j)%MAT(ir,is,ipt)%VAR
1200 DO i=1,nel
1201 value(i) = value(i) + uvar(i1 + i)/npg
1202 is_written_value(i) = 1
1203 ENDDO
1204 ENDDO
1205 ENDDO
1206 ELSE
1207 uvar=>elbuf_tab(ng)%BUFLY(j)%MAT(1,1,ipt)%VAR
1208 DO i=1,nel
1209 value(i) = uvar(i1 + i)
1210 is_written_value(i) = 1
1211 ENDDO
1212 ENDIF
1213 ENDIF
1214 ENDIF
1215 ENDIF
1216 ENDIF
1217 ENDIF
1218 ENDDO
1219c PLY=IPLY NPT=NULL
1220 ELSEIF ( iply > 0 .AND. ipt ==-1 .AND. iuvar > 0) THEN
1221c
1222 DO j=1,nlay
1223 nuvar = elbuf_tab(ng)%BUFLY(j)%NVAR_MAT
1224 IF(iuvar <= nuvar) THEN
1225 id_ply = 0
1226 IF (igtyp == 17 .OR. igtyp == 51) THEN
1227 id_ply = igeo(1,stack%IGEO(2+j,isubstack))
1228 ELSEIF (igtyp == 52) THEN
1229 id_ply = ply_info(1,stack%IGEO(2+j,isubstack)-numstack)
1230 ENDIF
1231c
1232 IF (id_ply == iply ) THEN
1233 bufly => elbuf_tab(ng)%BUFLY(j)
1234 imat = elbuf_tab(ng)%BUFLY(j)%IMAT
1235c
1236 IF(keyword == 'USER') user_ok = 1
1237 IF(idmds > 0)THEN
1238 IF(imat == mds_matid(idmds))user_ok = 1
1239 ENDIF
1240c
1241 IF(user_ok == 1)THEN
1242 IF (igtyp == 17 .OR. igtyp == 51 .OR. igtyp == 52 ) THEN
1243 nptt = bufly%NPTT
1244 DO ipt=1,nptt
1245 IF( npg > 1 ) THEN
1246 DO ir=1,nptr
1247 DO is=1,npts
1248 uvar=>elbuf_tab(ng)%BUFLY(j)%MAT(ir,is,ipt)%VAR
1249 DO i=1,nel
1250 value(i) = value(i) + uvar(i1 + i) / (npg * nptt)
1251 is_written_value(i) = 1
1252 ENDDO
1253 ENDDO
1254 ENDDO
1255 ELSE
1256 uvar=>elbuf_tab(ng)%BUFLY(j)%MAT(1,1,ipt)%VAR
1257 DO i=1,nel
1258 value(i) = value(i) + uvar(i1 + i) / nptt
1259 is_written_value(i) = 1
1260 ENDDO
1261 ENDIF
1262 ENDDO
1263 ENDIF
1264 ENDIF
1265 ENDIF
1266 ENDIF
1267 ENDDO
1268c ILAYER=IL NPT=IPT
1269 ELSEIF ( ilay <= nlay .AND. ilay > 0 .AND. ipt <= mpt .AND. ipt > 0 .AND. iuvar > 0) THEN
1270 IF(iuvar <= nuvar) THEN
1271 IF (igtyp == 51 .OR. igtyp == 52) THEN
1272 nuvar = elbuf_tab(ng)%BUFLY(ilay)%NVAR_MAT
1273 bufly => elbuf_tab(ng)%BUFLY(ilay)
1274 imat = elbuf_tab(ng)%BUFLY(ilay)%IMAT
1275c
1276 IF(keyword == 'USER') user_ok = 1
1277 IF(idmds > 0)THEN
1278 IF(imat == mds_matid(idmds))user_ok = 1
1279 ENDIF
1280c
1281 IF(user_ok == 1)THEN
1282 DO ir=1,nptr
1283 DO is=1,npts
1284 uvar=>elbuf_tab(ng)%BUFLY(ilay)%MAT(ir,is,ipt)%VAR
1285 DO i=1,nel
1286 value(i) = value(i) + uvar(i1 + i)/npg
1287 is_written_value(i) = 1
1288 ENDDO
1289 ENDDO
1290 ENDDO
1291 ENDIF
1292 ENDIF
1293 ENDIF
1294c ILAYER=IL NPT=NULL
1295 ELSEIF ( ilay <= nlay .AND. ilay > 0 .AND. iuvar > 0) THEN
1296 nuvar = elbuf_tab(ng)%BUFLY(ilay)%NVAR_MAT
1297 imat = elbuf_tab(ng)%BUFLY(ilay)%IMAT
1298c
1299 IF(keyword == 'user') USER_OK = 1
1300 IF(IDMDS > 0)THEN
1301 IF(IMAT == MDS_MATID(IDMDS))USER_OK = 1
1302 ENDIF
1303c
1304 IF(USER_OK == 1)THEN
1305 IF(IUVAR <= NUVAR) THEN
1306.OR..OR..OR. IF (IGTYP == 10 IGTYP == 11 IGTYP == 16 IGTYP == 17) THEN
1307 BUFLY => ELBUF_TAB(NG)%BUFLY(ILAY)
1308 DO IR=1,NPTR
1309 DO IS=1,NPTS
1310 UVAR=>ELBUF_TAB(NG)%BUFLY(ILAY)%MAT(IR,IS,1)%VAR
1311 DO I=1,NEL
1312 VALUE(I) = VALUE(I) + UVAR(I1 + I)/NPG
1313 IS_WRITTEN_VALUE(I) = 1
1314 ENDDO
1315 ENDDO
1316 ENDDO
1317.OR. ELSEIF (IGTYP == 51 IGTYP == 52) THEN
1318 BUFLY => ELBUF_TAB(NG)%BUFLY(ILAY)
1319 DO IT=1,NPTT
1320 DO IR=1,NPTR
1321 DO IS=1,NPTS
1322 UVAR=>ELBUF_TAB(NG)%BUFLY(ILAY)%MAT(IR,IS,IT)%VAR
1323 DO I=1,NEL
1324 VALUE(I) = VALUE(I) + UVAR(I1 + I)/(NPG * NPTT)
1325 IS_WRITTEN_VALUE(I) = 1
1326 ENDDO
1327 ENDDO
1328 ENDDO
1329 ENDDO
1330 ENDIF
1331 ENDIF
1332 ENDIF
1333c ILAYER=NULL NPT=IPT
1334.AND..AND. ELSEIF ( IPT <= MPT IPT > 0 IUVAR > 0) THEN
1335.OR. IF (IGTYP == 1 IGTYP == 9) THEN
1336 NUVAR = ELBUF_TAB(NG)%BUFLY(1)%NVAR_MAT
1337 BUFLY => ELBUF_TAB(NG)%BUFLY(1)
1338 IF(IUVAR <= NUVAR) THEN
1339 DO IR=1,NPTR
1340 DO IS=1,NPTS
1341 UVAR=>ELBUF_TAB(NG)%BUFLY(1)%MAT(IR,IS,IPT)%VAR
1342 DO I=1,NEL
1343 VALUE(I) = VALUE(I) + UVAR(I1 + I)/NPG
1344 IS_WRITTEN_VALUE(I) = 1
1345 ENDDO
1346 ENDDO
1347 ENDDO
1348 ENDIF
1349 ENDIF
1350 ENDIF
1351C--------------------------------------------------
1352 ELSEIF( KEYWORD == 'phi' ) THEN
1353C--------------------------------------------------
1354c
1355.AND..AND. IF (ILAY <= NLAY ILAY > 0 IPLY == -1) THEN
1356 BUFLY => ELBUF_TAB(NG)%BUFLY(ILAY)
1357 IF (ITY == 3) THEN
1358.OR..OR..OR. IF (IGTYP == 9 IGTYP == 10 IGTYP == 11
1359.OR..OR..OR. . IGTYP == 16 IGTYP == 17 IGTYP == 51
1360 . IGTYP == 52 ) THEN
1361.AND. IF (MLW /= 0 MLW /= 13) THEN
1362.AND..OR. IF(IDRAPE > 0 (IGTYP == 51 IGTYP == 52)) THEN
1363.AND. IF(IPT <= BUFLY%NPTT IPT > 0 ) THEN
1364 LBUF_DIR => ELBUF_TAB(NG)%BUFLY(ILAY)%LBUF_DIR(IPT)
1365 ELSE
1366 LBUF_DIR => ELBUF_TAB(NG)%BUFLY(ILAY)%LBUF_DIR(1)
1367 ENDIF
1368 DO I=1,NEL
1369 N = I + NFT
1370 X21 = X(1,IXC(3,N))-X(1,IXC(2,N))
1371 X32 = X(1,IXC(4,N))-X(1,IXC(3,N))
1372 X34 = X(1,IXC(4,N))-X(1,IXC(5,N))
1373 X41 = X(1,IXC(5,N))-X(1,IXC(2,N))
1374 Y21 = X(2,IXC(3,N))-X(2,IXC(2,N))
1375 Y32 = X(2,IXC(4,N))-X(2,IXC(3,N))
1376 Y34 = X(2,IXC(4,N))-X(2,IXC(5,N))
1377 Y41 = X(2,IXC(5,N))-X(2,IXC(2,N))
1378
1379 Z21 = X(3,IXC(3,N))-X(3,IXC(2,N))
1380 Z32 = X(3,IXC(4,N))-X(3,IXC(3,N))
1381 Z34 = X(3,IXC(4,N))-X(3,IXC(5,N))
1382 Z41 = X(3,IXC(5,N))-X(3,IXC(2,N))
1383
1384 E1X = (X21+X34)
1385 E1Y = (Y21+Y34)
1386 E1Z = (Z21+Z34)
1387
1388 E2X = (X32+X41)
1389 E2Y = (Y32+Y41)
1390 E2Z = (Z32+Z41)
1391
1392 E3X = E1Y*E2Z-E1Z*E2Y
1393 E3Y = E1Z*E2X-E1X*E2Z
1394 E3Z = E1X*E2Y-E1Y*E2X
1395 IF (IREP > 0) THEN
1396 RX = E1X
1397 RY = E1Y
1398 RZ = E1Z
1399 S_X = E2X
1400 S_Y = E2Y
1401 S_Z = E2Z
1402 ENDIF
1403 IF (ISHFRAM == 0 ) THEN
1404C------ Convected frame symmetric - version 5 (default)
1405 SUMA = E3X*E3X+E3Y*E3Y+E3Z*E3Z
1406 SUMA = ONE / MAX(SQRT(SUMA),EM20)
1407 E3X = E3X * SUMA
1408 E3Y = E3Y * SUMA
1409 E3Z = E3Z * SUMA
1410C
1411 S1 = E1X*E1X+E1Y*E1Y+E1Z*E1Z
1412 S2 = E2X*E2X+E2Y*E2Y+E2Z*E2Z
1413 SUMA = SQRT(S1/S2)
1414 E1X = E1X + (E2Y*E3Z-E2Z*E3Y)*SUMA
1415 E1Y = E1Y + (E2Z*E3X-E2X*E3Z)*SUMA
1416 E1Z = E1Z + (E2X*E3Y-E2Y*E3X)*SUMA
1417C
1418 SUMA = E1X*E1X+E1Y*E1Y+E1Z*E1Z
1419 SUMA = ONE / MAX(SQRT(SUMA),EM20)
1420 E1X = E1X * SUMA
1421 E1Y = E1Y * SUMA
1422 E1Z = E1Z * SUMA
1423C
1424 E2X = E3Y * E1Z - E3Z * E1Y
1425 E2Y = E3Z * E1X - E3X * E1Z
1426 E2Z = E3X * E1Y - E3Y * E1X
1427 ELSEIF (ISHFRAM == 2) THEN
1428C------ Convected frame non-symmetric - version 4
1429 SUMA = E2X*E2X+E2Y*E2Y+E2Z*E2Z
1430 E1X = E1X*SUMA + E2Y*E3Z-E2Z*E3Y
1431 E1Y = E1Y*SUMA + E2Z*E3X-E2X*E3Z
1432 E1Z = E1Z*SUMA + E2X*E3Y-E2Y*E3X
1433 SUMA = E1X*E1X+E1Y*E1Y+E1Z*E1Z
1434 SUMA = ONE/MAX(SQRT(SUMA),EM20)
1435 E1X = E1X*SUMA
1436 E1Y = E1Y*SUMA
1437 E1Z = E1Z*SUMA
1438C
1439 SUMA = E3X*E3X+E3Y*E3Y+E3Z*E3Z
1440 SUMA = ONE / MAX(SQRT(SUMA),EM20)
1441 E3X = E3X * SUMA
1442 E3Y = E3Y * SUMA
1443 E3Z = E3Z * SUMA
1444C
1445 E2X = E3Y*E1Z-E3Z*E1Y
1446 E2Y = E3Z*E1X-E3X*E1Z
1447 E2Z = E3X*E1Y-E3Y*E1X
1448 SUMA = E2X*E2X+E2Y*E2Y+E2Z*E2Z
1449 SUMA = ONE/MAX(SQRT(SUMA),EM20)
1450 E2X = E2X*SUMA
1451 E2Y = E2Y*SUMA
1452 E2Z = E2Z*SUMA
1453 ENDIF
1454 IF (IREP >= 1) THEN
1455 AA = LBUF_DIR%DIRA(I)
1456 BB = LBUF_DIR%DIRA(I+NEL)
1457 V1 = AA*RX + BB*S_X
1458 V2 = AA*RY + BB*S_Y
1459 V3 = AA*RZ + BB*S_Z
1460 VR = V1*E1X+ V2*E1Y + V3*E1Z
1461 VS = V1*E2X+ V2*E2Y + V3*E2Z
1462 SUMA=SQRT(VR*VR + VS*VS)
1463 DIR1_1 = VR/SUMA
1464 DIR1_2 = VS/SUMA
1465 ELSE
1466 DIR1_1 = LBUF_DIR%DIRA(I)
1467 DIR1_2 = LBUF_DIR%DIRA(I+NEL)
1468 ENDIF
1469c
1470 PHI =(HUNDRED80/PI)*ATAN2(DIR1_2,DIR1_1)
1471 ERR = (ABS(PHI) - NINTY)/NINTY
1472 VALUE(I) = PHI
1473 IF(ABS(ERR) < EM02) VALUE(I) = SIGN(NINTY,PHI)
1474 IF(ABS(VALUE(I)) < ONE) VALUE(I) = ZERO
1475 IS_WRITTEN_VALUE(I) = 1
1476 ENDDO
1477 ELSE ! IDRAPE
1478 DO I=1,NEL
1479 N = I + NFT
1480 X21 = X(1,IXC(3,N))-X(1,IXC(2,N))
1481 X32 = X(1,IXC(4,N))-X(1,IXC(3,N))
1482 X34 = X(1,IXC(4,N))-X(1,IXC(5,N))
1483 X41 = X(1,IXC(5,N))-X(1,IXC(2,N))
1484
1485 Y21 = X(2,IXC(3,N))-X(2,IXC(2,N))
1486 Y32 = X(2,IXC(4,N))-X(2,IXC(3,N))
1487 Y34 = X(2,IXC(4,N))-X(2,IXC(5,N))
1488 Y41 = X(2,IXC(5,N))-X(2,IXC(2,N))
1489
1490 Z21 = X(3,IXC(3,N))-X(3,IXC(2,N))
1491 Z32 = X(3,IXC(4,N))-X(3,IXC(3,N))
1492 Z34 = X(3,IXC(4,N))-X(3,IXC(5,N))
1493 Z41 = X(3,IXC(5,N))-X(3,IXC(2,N))
1494
1495 E1X = (X21+X34)
1496 E1Y = (Y21+Y34)
1497 E1Z = (Z21+Z34)
1498
1499 E2X = (X32+X41)
1500 E2Y = (Y32+Y41)
1501 E2Z = (Z32+Z41)
1502
1503 E3X = E1Y*E2Z-E1Z*E2Y
1504 E3Y = E1Z*E2X-E1X*E2Z
1505 E3Z = E1X*E2Y-E1Y*E2X
1506 IF (IREP > 0) THEN
1507 RX = E1X
1508 RY = E1Y
1509 RZ = E1Z
1510 S_X = E2X
1511 S_Y = E2Y
1512 S_Z = E2Z
1513 ENDIF
1514.OR. IF (ISHFRAM == 0 IGTYP == 16 ) THEN
1515C------ Convected frame symmetric - version 5 (default)
1516 SUMA = E3X*E3X+E3Y*E3Y+E3Z*E3Z
1517 SUMA = ONE / MAX(SQRT(SUMA),EM20)
1518 E3X = E3X * SUMA
1519 E3Y = E3Y * SUMA
1520 E3Z = E3Z * SUMA
1521C
1522 S1 = E1X*E1X+E1Y*E1Y+E1Z*E1Z
1523 S2 = E2X*E2X+E2Y*E2Y+E2Z*E2Z
1524 SUMA = SQRT(S1/S2)
1525 E1X = E1X + (E2Y*E3Z-E2Z*E3Y)*SUMA
1526 E1Y = E1Y + (E2Z*E3X-E2X*E3Z)*SUMA
1527 E1Z = E1Z + (E2X*E3Y-E2Y*E3X)*SUMA
1528C
1529 SUMA = E1X*E1X+E1Y*E1Y+E1Z*E1Z
1530 SUMA = ONE / MAX(SQRT(SUMA),EM20)
1531 E1X = E1X * SUMA
1532 E1Y = E1Y * SUMA
1533 E1Z = E1Z * SUMA
1534C
1535 E2X = E3Y * E1Z - E3Z * E1Y
1536 E2Y = E3Z * E1X - E3X * E1Z
1537 E2Z = E3X * E1Y - E3Y * E1X
1538 ELSEIF (ISHFRAM == 2) THEN
1539C------ Convected frame non-symmetric - version 4
1540 SUMA = E2X*E2X+E2Y*E2Y+E2Z*E2Z
1541 E1X = E1X*SUMA + E2Y*E3Z-E2Z*E3Y
1542 E1Y = E1Y*SUMA + E2Z*E3X-E2X*E3Z
1543 E1Z = E1Z*SUMA + E2X*E3Y-E2Y*E3X
1544 SUMA = E1X*E1X+E1Y*E1Y+E1Z*E1Z
1545 SUMA = ONE/MAX(SQRT(SUMA),EM20)
1546 E1X = E1X*SUMA
1547 E1Y = E1Y*SUMA
1548 E1Z = E1Z*SUMA
1549C
1550 SUMA = E3X*E3X+E3Y*E3Y+E3Z*E3Z
1551 SUMA = ONE / MAX(SQRT(SUMA),EM20)
1552 E3X = E3X * SUMA
1553 E3Y = E3Y * SUMA
1554 E3Z = E3Z * SUMA
1555C
1556 E2X = E3Y*E1Z-E3Z*E1Y
1557 E2Y = E3Z*E1X-E3X*E1Z
1558 E2Z = E3X*E1Y-E3Y*E1X
1559 SUMA = E2X*E2X+E2Y*E2Y+E2Z*E2Z
1560 SUMA = ONE/MAX(SQRT(SUMA),EM20)
1561 E2X = E2X*SUMA
1562 E2Y = E2Y*SUMA
1563 E2Z = E2Z*SUMA
1564 ENDIF
1565 IF (IREP >= 1) THEN
1566 AA = BUFLY%DIRA(I)
1567 BB = BUFLY%DIRA(I+NEL)
1568 V1 = AA*RX + BB*S_X
1569 V2 = AA*RY + BB*S_Y
1570 V3 = AA*RZ + BB*S_Z
1571 VR = V1*E1X+ V2*E1Y + V3*E1Z
1572 VS = V1*E2X+ V2*E2Y + V3*E2Z
1573 SUMA=SQRT(VR*VR + VS*VS)
1574 DIR1_1 = VR/SUMA
1575 DIR1_2 = VS/SUMA
1576 ELSE
1577 DIR1_1 = BUFLY%DIRA(I)
1578 DIR1_2 = BUFLY%DIRA(I+NEL)
1579 ENDIF
1580 PHI =(HUNDRED80/PI)*ATAN2(DIR1_2,DIR1_1)
1581 ERR = (ABS(PHI) - NINTY)/NINTY
1582 VALUE(I) = PHI
1583 IF(ABS(ERR) < EM02) VALUE(I) = SIGN(NINTY,PHI)
1584 IF(ABS(VALUE(I)) < ONE) VALUE(I) = ZERO
1585 IS_WRITTEN_VALUE(I) = 1
1586 ENDDO
1587 ENDIF ! IDRAPE
1588 ENDIF ! MLW
1589 ENDIF ! IGTYP
1590
1591 ELSEIF (ITY == 7) THEN
1592 NPG = IPARG(48,NG)
1593.OR..OR..OR. IF (IGTYP == 9 IGTYP == 10 IGTYP == 11
1594.OR..OR..OR. . IGTYP == 16 IGTYP == 17 IGTYP == 51
1595 . IGTYP == 52 ) THEN
1596.AND. IF (MLW /= 0 MLW /= 13) THEN
1597.OR. IF(IDRAPE > 0 . AND. (IGTYP == 51 IGTYP == 52)) THEN
1598.AND. IF(IPT <= BUFLY%NPTT IPT > 0) THEN
1599 LBUF_DIR => ELBUF_TAB(NG)%BUFLY(ILAY)%LBUF_DIR(IPT)
1600 ELSE
1601 LBUF_DIR => ELBUF_TAB(NG)%BUFLY(ILAY)%LBUF_DIR(1)
1602 ENDIF
1603 DO I=1,NEL
1604 N = I + NFT
1605 X21 = X(1,IXTG(3,N))-X(1,IXTG(2,N))
1606 X31 = X(1,IXTG(4,N))-X(1,IXTG(2,N))
1607 X32 = X(1,IXTG(4,N))-X(1,IXTG(3,N))
1608
1609 Y21 = X(2,IXTG(3,N))-X(2,IXTG(2,N))
1610 Y31 = X(2,IXTG(4,N))-X(2,IXTG(2,N))
1611 Y32 = X(2,IXTG(4,N))-X(2,IXTG(3,N))
1612
1613 Z21 = X(3,IXTG(3,N))-X(3,IXTG(2,N))
1614 Z31 = X(3,IXTG(4,N))-X(3,IXTG(2,N))
1615 Z32 = X(3,IXTG(4,N))-X(3,IXTG(3,N))
1616 IF (IREP > 0) THEN
1617 E11 = X21
1618 E12 = Y21
1619 E13 = Z21
1620 E21 = X31
1621 E22 = Y31
1622 E23 = Z31
1623 ENDIF
1624 E1X= X21
1625 E1Y= Y21
1626 E1Z= Z21
1627 X2L = SQRT(E1X*E1X+E1Y*E1Y+E1Z*E1Z)
1628 E1X=E1X/X2L
1629 E1Y=E1Y/X2L
1630 E1Z=E1Z/X2L
1631C
1632 E3X=Y31*Z32-Z31*Y32
1633 E3Y=Z31*X32-X31*Z32
1634 E3Z=X31*Y32-Y31*X32
1635 SUM_ = SQRT(E3X*E3X+E3Y*E3Y+E3Z*E3Z)
1636 E3X=E3X/SUM_
1637 E3Y=E3Y/SUM_
1638 E3Z=E3Z/SUM_
1639 AREA = HALF * SUM_
1640 E2X=E3Y*E1Z-E3Z*E1Y
1641 E2Y=E3Z*E1X-E3X*E1Z
1642 E2Z=E3X*E1Y-E3Y*E1X
1643 SUM_ = SQRT(E2X*E2X+E2Y*E2Y+E2Z*E2Z)
1644 E2X=E2X/SUM_
1645 E2Y=E2Y/SUM_
1646 E2Z=E2Z/SUM_
1647 IF (IREP >= 1) THEN
1648 AA = LBUF_DIR%DIRA(I)
1649 BB = LBUF_DIR%DIRA(I+NEL)
1650 V1 = AA*E11 + BB*E21
1651 V2 = AA*E12 + BB*E22
1652 V3 = AA*E13 + BB*E23
1653 VR = V1*E1X + V2*E1Y + V3*E1Z
1654 VS = V1*E2X + V2*E2Y + V3*E2Z
1655 SUMA=SQRT(VR*VR + VS*VS)
1656 DIR1_1 = VR/SUMA
1657 DIR1_2 = VS/SUMA
1658 ELSE
1659 DIR1_1 = LBUF_DIR%DIRA(I)
1660 DIR1_2 = LBUF_DIR%DIRA(I+NEL)
1661 ENDIF
1662 PHI =(HUNDRED80/PI)*ATAN2(DIR1_2,DIR1_1)
1663 ERR = (ABS(PHI) - NINTY)/NINTY
1664 VALUE(I) = PHI
1665 IF(ABS(ERR) < EM02) VALUE(I) = SIGN(NINTY,PHI)
1666 IF(ABS(VALUE(I)) < ONE) VALUE(I) = ZERO
1667 IS_WRITTEN_VALUE(I) = 1
1668 ENDDO
1669 ELSE
1670 DO I=1,NEL
1671 N = I + NFT
1672 X21 = X(1,IXTG(3,N))-X(1,IXTG(2,N))
1673 X31 = X(1,IXTG(4,N))-X(1,IXTG(2,N))
1674 X32 = X(1,IXTG(4,N))-X(1,IXTG(3,N))
1675
1676 Y21 = X(2,IXTG(3,N))-X(2,IXTG(2,N))
1677 Y31 = X(2,IXTG(4,N))-X(2,IXTG(2,N))
1678 Y32 = X(2,IXTG(4,N))-X(2,IXTG(3,N))
1679
1680 Z21 = X(3,IXTG(3,N))-X(3,IXTG(2,N))
1681 Z31 = X(3,IXTG(4,N))-X(3,IXTG(2,N))
1682 Z32 = X(3,IXTG(4,N))-X(3,IXTG(3,N))
1683 IF (IREP > 0) THEN
1684 E11 = X21
1685 E12 = Y21
1686 E13 = Z21
1687 E21 = X31
1688 E22 = Y31
1689 E23 = Z31
1690 ENDIF
1691 E1X= X21
1692 E1Y= Y21
1693 E1Z= Z21
1694 X2L = SQRT(E1X*E1X+E1Y*E1Y+E1Z*E1Z)
1695 E1X=E1X/X2L
1696 E1Y=E1Y/X2L
1697 E1Z=E1Z/X2L
1698C
1699 E3X=Y31*Z32-Z31*Y32
1700 E3Y=Z31*X32-X31*Z32
1701 E3Z=X31*Y32-Y31*X32
1702 SUM_ = SQRT(E3X*E3X+E3Y*E3Y+E3Z*E3Z)
1703 E3X=E3X/SUM_
1704 E3Y=E3Y/SUM_
1705 E3Z=E3Z/SUM_
1706 AREA = HALF * SUM_
1707 E2X=E3Y*E1Z-E3Z*E1Y
1708 E2Y=E3Z*E1X-E3X*E1Z
1709 E2Z=E3X*E1Y-E3Y*E1X
1710 SUM_ = SQRT(E2X*E2X+E2Y*E2Y+E2Z*E2Z)
1711 E2X=E2X/SUM_
1712 E2Y=E2Y/SUM_
1713 E2Z=E2Z/SUM_
1714 IF (IREP >= 1) THEN
1715 AA = BUFLY%DIRA(I)
1716 BB = BUFLY%DIRA(I+NEL)
1717 V1 = AA*E11 + BB*E21
1718 V2 = AA*E12 + BB*E22
1719 V3 = AA*E13 + BB*E23
1720 VR = V1*E1X + V2*E1Y + V3*E1Z
1721 VS = V1*E2X + V2*E2Y + V3*E2Z
1722 SUMA=SQRT(VR*VR + VS*VS)
1723 DIR1_1 = VR/SUMA
1724 DIR1_2 = VS/SUMA
1725 ELSE
1726 DIR1_1 = BUFLY%DIRA(I)
1727 DIR1_2 = BUFLY%DIRA(I+NEL)
1728 ENDIF
1729 PHI =(HUNDRED80/PI)*ATAN2(DIR1_2,DIR1_1)
1730 ERR = (ABS(PHI) - NINTY)/NINTY
1731 VALUE(I) = PHI
1732 IF(ABS(ERR) < EM02) VALUE(I) = SIGN(NINTY,PHI)
1733 IF(ABS(VALUE(I)) < ONE) VALUE(I) = ZERO
1734 IS_WRITTEN_VALUE(I) = 1
1735 ENDDO
1736 ENDIF ! IDRAPE
1737 ENDIF
1738 ENDIF
1739 ENDIF
1740c
1741 ELSEIF (IPLY > 0) THEN
1742 DO J=1,NLAY
1743 ID_PLY = 0
1744.OR. IF (IGTYP == 17 IGTYP == 51) THEN
1745 ID_PLY = IGEO(1,STACK%IGEO(2+J,ISUBSTACK))
1746 ELSEIF (IGTYP == 52) THEN
1747 ID_PLY = PLY_INFO(1,STACK%IGEO(2+J,ISUBSTACK)-NUMSTACK)
1748 ENDIF
1749c
1750 IF (ID_PLY == IPLY ) THEN
1751 BUFLY => ELBUF_TAB(NG)%BUFLY(J)
1752 IF (ITY == 3) THEN
1753.OR..OR. IF (IGTYP == 17 IGTYP == 51 IGTYP == 52 ) THEN
1754.AND. IF (MLW /= 0 MLW /= 13) THEN
1755.AND..OR. IF(IDRAPE > 0 (IGTYP == 51 IGTYP == 52)) THEN
1756.AND. IF(IPT <= BUFLY%NPTT IPT > 0) THEN
1757 LBUF_DIR => ELBUF_TAB(NG)%BUFLY(J)%LBUF_DIR(IPT)
1758 ELSE
1759 LBUF_DIR => ELBUF_TAB(NG)%BUFLY(J)%LBUF_DIR(1)
1760 ENDIF
1761 DO I=1,NEL
1762 N = I + NFT
1763 X21 = X(1,IXC(3,N))-X(1,IXC(2,N))
1764 X32 = X(1,IXC(4,N))-X(1,IXC(3,N))
1765 X34 = X(1,IXC(4,N))-X(1,IXC(5,N))
1766 X41 = X(1,IXC(5,N))-X(1,IXC(2,N))
1767
1768 Y21 = X(2,IXC(3,N))-X(2,IXC(2,N))
1769 Y32 = X(2,IXC(4,N))-X(2,IXC(3,N))
1770 Y34 = X(2,IXC(4,N))-X(2,IXC(5,N))
1771 Y41 = X(2,IXC(5,N))-X(2,IXC(2,N))
1772
1773 Z21 = X(3,IXC(3,N))-X(3,IXC(2,N))
1774 Z32 = X(3,IXC(4,N))-X(3,IXC(3,N))
1775 Z34 = X(3,IXC(4,N))-X(3,IXC(5,N))
1776 Z41 = X(3,IXC(5,N))-X(3,IXC(2,N))
1777
1778 E1X = (X21+X34)
1779 E1Y = (Y21+Y34)
1780 E1Z = (Z21+Z34)
1781
1782 E2X = (X32+X41)
1783 E2Y = (Y32+Y41)
1784 E2Z = (Z32+Z41)
1785
1786 E3X = E1Y*E2Z-E1Z*E2Y
1787 E3Y = E1Z*E2X-E1X*E2Z
1788 E3Z = E1X*E2Y-E1Y*E2X
1789
1790 IF (IREP > 0) THEN
1791 RX = E1X
1792 RY = E1Y
1793 RZ = E1Z
1794 S_X = E2X
1795 S_Y = E2Y
1796 S_Z = E2Z
1797 ENDIF
1798 IF (ISHFRAM == 0 ) THEN
1799C------ Convected frame symmetric - version 5 (default)
1800 SUMA = E3X*E3X+E3Y*E3Y+E3Z*E3Z
1801 SUMA = ONE / MAX(SQRT(SUMA),EM20)
1802 E3X = E3X * SUMA
1803 E3Y = E3Y * SUMA
1804 E3Z = E3Z * SUMA
1805C
1806 S1 = E1X*E1X+E1Y*E1Y+E1Z*E1Z
1807 S2 = E2X*E2X+E2Y*E2Y+E2Z*E2Z
1808 SUMA = SQRT(S1/S2)
1809 E1X = E1X + (E2Y*E3Z-E2Z*E3Y)*SUMA
1810 E1Y = E1Y + (E2Z*E3X-E2X*E3Z)*SUMA
1811 E1Z = E1Z + (E2X*E3Y-E2Y*E3X)*SUMA
1812C
1813 SUMA = E1X*E1X+E1Y*E1Y+E1Z*E1Z
1814 SUMA = ONE / MAX(SQRT(SUMA),EM20)
1815 E1X = E1X * SUMA
1816 E1Y = E1Y * SUMA
1817 E1Z = E1Z * SUMA
1818C
1819 E2X = E3Y * E1Z - E3Z * E1Y
1820 E2Y = E3Z * E1X - E3X * E1Z
1821 E2Z = E3X * E1Y - E3Y * E1X
1822 ELSEIF (ISHFRAM == 2) THEN
1823C------ Convected frame non-symmetric - version 4
1824 SUMA = E2X*E2X+E2Y*E2Y+E2Z*E2Z
1825 E1X = E1X*SUMA + E2Y*E3Z-E2Z*E3Y
1826 E1Y = E1Y*SUMA + E2Z*E3X-E2X*E3Z
1827 E1Z = E1Z*SUMA + E2X*E3Y-E2Y*E3X
1828 SUMA = E1X*E1X+E1Y*E1Y+E1Z*E1Z
1829 SUMA = ONE/MAX(SQRT(SUMA),EM20)
1830 E1X = E1X*SUMA
1831 E1Y = E1Y*SUMA
1832 E1Z = E1Z*SUMA
1833C
1834 SUMA = E3X*E3X+E3Y*E3Y+E3Z*E3Z
1835 SUMA = ONE / MAX(SQRT(SUMA),EM20)
1836 E3X = E3X * SUMA
1837 E3Y = E3Y * SUMA
1838 E3Z = E3Z * SUMA
1839C
1840 E2X = E3Y*E1Z-E3Z*E1Y
1841 E2Y = E3Z*E1X-E3X*E1Z
1842 E2Z = E3X*E1Y-E3Y*E1X
1843 SUMA = E2X*E2X+E2Y*E2Y+E2Z*E2Z
1844 SUMA = ONE/MAX(SQRT(SUMA),EM20)
1845 E2X = E2X*SUMA
1846 E2Y = E2Y*SUMA
1847 E2Z = E2Z*SUMA
1848 ENDIF
1849 IF (IREP >= 1) THEN
1850 AA = LBUF_DIR%DIRA(I)
1851 BB = LBUF_DIR%DIRA(I+NEL)
1852 V1 = AA*RX + BB*S_X
1853 V2 = AA*RY + BB*S_Y
1854 V3 = AA*RZ + BB*S_Z
1855 VR = V1*E1X+ V2*E1Y + V3*E1Z
1856 VS = V1*E2X+ V2*E2Y + V3*E2Z
1857 SUMA=SQRT(VR*VR + VS*VS)
1858 DIR1_1 = VR/SUMA
1859 DIR1_2 = VS/SUMA
1860 ELSE
1861 DIR1_1 = LBUF_DIR%DIRA(I)
1862 DIR1_2 = LBUF_DIR%DIRA(I+NEL)
1863 ENDIF
1864c
1865 PHI =(HUNDRED80/PI)*ATAN2(DIR1_2,DIR1_1)
1866 ERR = (ABS(PHI) - NINTY)/NINTY
1867 VALUE(I) = PHI
1868 IF(ABS(ERR) < EM02) VALUE(I) = SIGN(NINTY,PHI)
1869 IF(ABS(VALUE(I)) < ONE) VALUE(I) = ZERO
1870 IS_WRITTEN_VALUE(I) = 1
1871 ENDDO
1872 ELSE
1873 DO I=1,NEL
1874 N = I + NFT
1875 X21 = X(1,IXC(3,N))-X(1,IXC(2,N))
1876 X32 = X(1,IXC(4,N))-X(1,IXC(3,N))
1877 X34 = X(1,IXC(4,N))-X(1,IXC(5,N))
1878 X41 = X(1,IXC(5,N))-X(1,IXC(2,N))
1879
1880 Y21 = X(2,IXC(3,N))-X(2,IXC(2,N))
1881 Y32 = X(2,IXC(4,N))-X(2,IXC(3,N))
1882 Y34 = X(2,IXC(4,N))-X(2,IXC(5,N))
1883 Y41 = X(2,IXC(5,N))-X(2,IXC(2,N))
1884
1885 Z21 = X(3,IXC(3,N))-X(3,IXC(2,N))
1886 Z32 = X(3,IXC(4,N))-X(3,IXC(3,N))
1887 Z34 = X(3,IXC(4,N))-X(3,IXC(5,N))
1888 Z41 = X(3,IXC(5,N))-X(3,IXC(2,N))
1889
1890 E1X = (X21+X34)
1891 E1Y = (Y21+Y34)
1892 E1Z = (Z21+Z34)
1893
1894 E2X = (X32+X41)
1895 E2Y = (Y32+Y41)
1896 E2Z = (Z32+Z41)
1897
1898 E3X = E1Y*E2Z-E1Z*E2Y
1899 E3Y = E1Z*E2X-E1X*E2Z
1900 E3Z = E1X*E2Y-E1Y*E2X
1901
1902 IF (IREP > 0) THEN
1903 RX = E1X
1904 RY = E1Y
1905 RZ = E1Z
1906 S_X = E2X
1907 S_Y = E2Y
1908 S_Z = E2Z
1909 ENDIF
1910.OR. IF (ISHFRAM == 0 IGTYP == 16 ) THEN
1911C------ Convected frame symmetric - version 5 (default)
1912 SUMA = E3X*E3X+E3Y*E3Y+E3Z*E3Z
1913 SUMA = ONE / MAX(SQRT(SUMA),EM20)
1914 E3X = E3X * SUMA
1915 E3Y = E3Y * SUMA
1916 E3Z = E3Z * SUMA
1917C
1918 S1 = E1X*E1X+E1Y*E1Y+E1Z*E1Z
1919 S2 = E2X*E2X+E2Y*E2Y+E2Z*E2Z
1920 SUMA = SQRT(S1/S2)
1921 E1X = E1X + (E2Y*E3Z-E2Z*E3Y)*SUMA
1922 E1Y = E1Y + (E2Z*E3X-E2X*E3Z)*SUMA
1923 E1Z = E1Z + (E2X*E3Y-E2Y*E3X)*SUMA
1924C
1925 SUMA = E1X*E1X+E1Y*E1Y+E1Z*E1Z
1926 SUMA = ONE / MAX(SQRT(SUMA),EM20)
1927 E1X = E1X * SUMA
1928 E1Y = E1Y * SUMA
1929 E1Z = E1Z * SUMA
1930C
1931 E2X = E3Y * E1Z - E3Z * E1Y
1932 E2Y = E3Z * E1X - E3X * E1Z
1933 E2Z = E3X * E1Y - E3Y * E1X
1934 ELSEIF (ISHFRAM == 2) THEN
1935C------ Convected frame non-symmetric - version 4
1936 SUMA = E2X*E2X+E2Y*E2Y+E2Z*E2Z
1937 E1X = E1X*SUMA + E2Y*E3Z-E2Z*E3Y
1938 E1Y = E1Y*SUMA + E2Z*E3X-E2X*E3Z
1939 E1Z = E1Z*SUMA + E2X*E3Y-E2Y*E3X
1940 SUMA = E1X*E1X+E1Y*E1Y+E1Z*E1Z
1941 SUMA = ONE/MAX(SQRT(SUMA),EM20)
1942 E1X = E1X*SUMA
1943 E1Y = E1Y*SUMA
1944 E1Z = E1Z*SUMA
1945C
1946 SUMA = E3X*E3X+E3Y*E3Y+E3Z*E3Z
1947 SUMA = ONE / MAX(SQRT(SUMA),EM20)
1948 E3X = E3X * SUMA
1949 E3Y = E3Y * SUMA
1950 E3Z = E3Z * SUMA
1951C
1952 E2X = E3Y*E1Z-E3Z*E1Y
1953 E2Y = E3Z*E1X-E3X*E1Z
1954 E2Z = E3X*E1Y-E3Y*E1X
1955 SUMA = E2X*E2X+E2Y*E2Y+E2Z*E2Z
1956 SUMA = ONE/MAX(SQRT(SUMA),EM20)
1957 E2X = E2X*SUMA
1958 E2Y = E2Y*SUMA
1959 E2Z = E2Z*SUMA
1960 ENDIF
1961 IF (IREP >= 1) THEN
1962 AA = BUFLY%DIRA(I)
1963 BB = BUFLY%DIRA(I+NEL)
1964 V1 = AA*RX + BB*S_X
1965 V2 = AA*RY + BB*S_Y
1966 V3 = AA*RZ + BB*S_Z
1967 VR = V1*E1X+ V2*E1Y + V3*E1Z
1968 VS = V1*E2X+ V2*E2Y + V3*E2Z
1969 SUMA=SQRT(VR*VR + VS*VS)
1970 DIR1_1 = VR/SUMA
1971 DIR1_2 = VS/SUMA
1972 ELSE
1973 DIR1_1 = BUFLY%DIRA(I)
1974 DIR1_2 = BUFLY%DIRA(I+NEL)
1975 ENDIF
1976c
1977 PHI =(HUNDRED80/PI)*ATAN2(DIR1_2,DIR1_1)
1978 ERR = (ABS(PHI) - NINTY)/NINTY
1979 VALUE(I) = PHI
1980 IF(ABS(ERR) < EM02) VALUE(I) = SIGN(NINTY,PHI)
1981 IF(ABS(VALUE(I)) < ONE) VALUE(I) = ZERO
1982 IS_WRITTEN_VALUE(I) = 1
1983 ENDDO
1984 ENDIF ! IDRAPE
1985 ENDIF ! MLW
1986 ENDIF ! IGTYP
1987
1988 ELSEIF (ITY == 7) THEN
1989.OR..OR. IF (IGTYP == 17 IGTYP == 51 IGTYP == 52 ) THEN
1990.AND. IF (MLW /= 0 MLW /= 13) THEN
1991.AND..OR. IF(IDRAPE > 0 (IGTYP == 51 IGTYP == 52)) THEN
1992.AND. IF(IPT <= BUFLY%NPTT IPT > 0 ) THEN
1993 LBUF_DIR => ELBUF_TAB(NG)%BUFLY(J)%LBUF_DIR(IPT)
1994 ELSE
1995 LBUF_DIR => ELBUF_TAB(NG)%BUFLY(J)%LBUF_DIR(1)
1996 ENDIF
1997 DO I=1,NEL
1998 N = I + NFT
1999 X21 = X(1,IXTG(3,N))-X(1,IXTG(2,N))
2000 X31 = X(1,IXTG(4,N))-X(1,IXTG(2,N))
2001 X32 = X(1,IXTG(4,N))-X(1,IXTG(3,N))
2002
2003 Y21 = X(2,IXTG(3,N))-X(2,IXTG(2,N))
2004 Y31 = X(2,IXTG(4,N))-X(2,IXTG(2,N))
2005 Y32 = X(2,IXTG(4,N))-X(2,IXTG(3,N))
2006
2007 Z21 = X(3,IXTG(3,N))-X(3,IXTG(2,N))
2008 Z31 = X(3,IXTG(4,N))-X(3,IXTG(2,N))
2009 Z32 = X(3,IXTG(4,N))-X(3,IXTG(3,N))
2010 IF (IREP > 0) THEN
2011 E11 = X21
2012 E12 = Y21
2013 E13 = Z21
2014 E21 = X31
2015 E22 = Y31
2016 E23 = Z31
2017 ENDIF
2018 E1X= X21
2019 E1Y= Y21
2020 E1Z= Z21
2021 X2L = SQRT(E1X*E1X+E1Y*E1Y+E1Z*E1Z)
2022 E1X=E1X/X2L
2023 E1Y=E1Y/X2L
2024 E1Z=E1Z/X2L
2025C
2026 E3X=Y31*Z32-Z31*Y32
2027 E3Y=Z31*X32-X31*Z32
2028 E3Z=X31*Y32-Y31*X32
2029 SUM_ = SQRT(E3X*E3X+E3Y*E3Y+E3Z*E3Z)
2030 E3X=E3X/SUM_
2031 E3Y=E3Y/SUM_
2032 E3Z=E3Z/SUM_
2033 AREA = HALF * SUM_
2034 E2X=E3Y*E1Z-E3Z*E1Y
2035 E2Y=E3Z*E1X-E3X*E1Z
2036 E2Z=E3X*E1Y-E3Y*E1X
2037 SUM_ = SQRT(E2X*E2X+E2Y*E2Y+E2Z*E2Z)
2038 E2X=E2X/SUM_
2039 E2Y=E2Y/SUM_
2040 E2Z=E2Z/SUM_
2041 IF (IREP >= 1) THEN
2042 DIR1_1 = LBUF_DIR%DIRA(I)
2043 DIR1_2 = LBUF_DIR%DIRA(I+NEL)
2044 V1 = AA*E11 + BB*E21
2045 V2 = AA*E12 + BB*E22
2046 V3 = AA*E13 + BB*E23
2047 VR = V1*E1X + V2*E1Y + V3*E1Z
2048 VS = V1*E2X + V2*E2Y + V3*E2Z
2049 SUMA=SQRT(VR*VR + VS*VS)
2050 DIR1_1 = VR/SUMA
2051 DIR1_2 = VS/SUMA
2052 ELSE
2053 DIR1_1 = LBUF_DIR%DIRA(I)
2054 DIR1_2 = LBUF_DIR%DIRA(I+NEL)
2055 ENDIF
2056 PHI =(HUNDRED80/PI)*ATAN2(DIR1_2,DIR1_1)
2057 ERR = (ABS(PHI) - NINTY)/NINTY
2058 VALUE(I) = PHI
2059 IF(ABS(ERR) < EM02) VALUE(I) = SIGN(NINTY,PHI)
2060 IF(ABS(VALUE(I)) < ONE) VALUE(I) = ZERO
2061 IS_WRITTEN_VALUE(I) = 1
2062 ENDDO
2063 ELSE
2064 DO I=1,NEL
2065 N = I + NFT
2066 X21 = X(1,IXTG(3,N))-X(1,IXTG(2,N))
2067 X31 = X(1,IXTG(4,N))-X(1,IXTG(2,N))
2068 X32 = X(1,IXTG(4,N))-X(1,IXTG(3,N))
2069
2070 Y21 = X(2,IXTG(3,N))-X(2,IXTG(2,N))
2071 Y31 = X(2,IXTG(4,N))-X(2,IXTG(2,N))
2072 Y32 = X(2,IXTG(4,N))-X(2,IXTG(3,N))
2073
2074 Z21 = X(3,IXTG(3,N))-X(3,IXTG(2,N))
2075 Z31 = X(3,IXTG(4,N))-X(3,IXTG(2,N))
2076 Z32 = X(3,IXTG(4,N))-X(3,IXTG(3,N))
2077 IF (IREP > 0) THEN
2078 E11 = X21
2079 E12 = Y21
2080 E13 = Z21
2081 E21 = X31
2082 E22 = Y31
2083 E23 = Z31
2084 ENDIF
2085 E1X= X21
2086 E1Y= Y21
2087 E1Z= Z21
2088 X2L = SQRT(E1X*E1X+E1Y*E1Y+E1Z*E1Z)
2089 E1X=E1X/X2L
2090 E1Y=E1Y/X2L
2091 E1Z=E1Z/X2L
2092C
2093 E3X=Y31*Z32-Z31*Y32
2094 E3Y=Z31*X32-X31*Z32
2095 E3Z=X31*Y32-Y31*X32
2096 SUM_ = SQRT(E3X*E3X+E3Y*E3Y+E3Z*E3Z)
2097 E3X=E3X/SUM_
2098 E3Y=E3Y/SUM_
2099 E3Z=E3Z/SUM_
2100 AREA = HALF * SUM_
2101 E2X=E3Y*E1Z-E3Z*E1Y
2102 E2Y=E3Z*E1X-E3X*E1Z
2103 E2Z=E3X*E1Y-E3Y*E1X
2104 SUM_ = SQRT(E2X*E2X+E2Y*E2Y+E2Z*E2Z)
2105 E2X=E2X/SUM_
2106 E2Y=E2Y/SUM_
2107 E2Z=E2Z/SUM_
2108 IF (IREP >= 1) THEN
2109 DIR1_1 = BUFLY%DIRA(I)
2110 DIR1_2 = BUFLY%DIRA(I+NEL)
2111 V1 = AA*E11 + BB*E21
2112 V2 = AA*E12 + BB*E22
2113 V3 = AA*E13 + BB*E23
2114 VR = V1*E1X + V2*E1Y + V3*E1Z
2115 VS = V1*E2X + V2*E2Y + V3*E2Z
2116 SUMA=SQRT(VR*VR + VS*VS)
2117 DIR1_1 = VR/SUMA
2118 DIR1_2 = VS/SUMA
2119 ELSE
2120 DIR1_1 = BUFLY%DIRA(I)
2121 DIR1_2 = BUFLY%DIRA(I+NEL)
2122 ENDIF
2123 PHI =(HUNDRED80/PI)*ATAN2(DIR1_2,DIR1_1)
2124 ERR = (ABS(PHI) - NINTY)/NINTY
2125 VALUE(I) = PHI
2126 IF(ABS(ERR) < EM02) VALUE(I) = SIGN(NINTY,PHI)
2127 IF(ABS(VALUE(I)) < ONE) VALUE(I) = ZERO
2128 IS_WRITTEN_VALUE(I) = 1
2129 ENDDO
2130 ENDIF ! IDRAPE
2131 ENDIF
2132 ENDIF
2133 ENDIF
2134c
2135 ENDIF
2136 ENDDO
2137 ENDIF
2138C--------------------------------------------------
2139 ELSEIF (KEYWORD == 'epsp.AND..AND.' MLW /= 15 MLW /= 25 ) THEN ! anim/shell/epsp/
2140C--------------------------------------------------
2141c ILAYER=NULL NPT=NULL
2142.AND..AND. IF(MPT == 0 GBUF%G_PLA > 0 IPT == 1) THEN
2143.OR. IF (IGTYP == 1 IGTYP == 9) THEN
2144 BUFLY => ELBUF_TAB(NG)%BUFLY(1)
2145 IF (BUFLY%L_PLA > 0) THEN
2146 DO IR=1,NPTR
2147 DO IS=1,NPTS
2148 LBUF => BUFLY%LBUF(IR,IS,1)
2149 DO I=1,NEL
2150 VALUE(I) = VALUE(I) + ABS(LBUF%PLA(I))/NPG
2151 IS_WRITTEN_VALUE(I) = 1
2152 ENDDO
2153 ENDDO
2154 ENDDO
2155 ENDIF
2156 ENDIF
2157.AND..AND..and. ELSEIF ( ILAY == -1 IPT == -1 IPLY == -1 GBUF%G_PLA > 0) THEN
2158 ! for law25, plastic work < 0 if the layer has reached failure-p
2159 ILAY0 = 1
2160 IF (NLAY > 1) ILAY0 = IABS(NLAY)/2 + 1
2161 BUFLY => ELBUF_TAB(NG)%BUFLY(ILAY0)
2162 IF (BUFLY%L_PLA > 0) THEN
2163 IF (NPG > 1) THEN
2164 IF(ITY == 3) THEN
2165.OR. IF(IGTYP == 51 IGTYP == 52) THEN
2166 NPTT = BUFLY%NPTT
2167 DO IS = 1,NPTS
2168 DO IR = 1,NPTR
2169 DO IT = 1, NPTT
2170 DO I=1,NEL
2171 VALUE(I) = VALUE(I) + FOURTH*BUFLY%LBUF(IR,IS,IT)%PLA(I)/NPTT
2172 IS_WRITTEN_VALUE(I) = 1
2173 ENDDO
2174 ENDDO
2175 ENDDO
2176 ENDDO
2177 ELSE
2178 DO I=1,NEL
2179 VALUE(I) = FOURTH*(BUFLY%LBUF(1,1,1)%PLA(I) + BUFLY%LBUF(2,1,1)%PLA(I) +
2180 . BUFLY%LBUF(1,2,1)%PLA(I) + BUFLY%LBUF(2,2,1)%PLA(I))
2181 IS_WRITTEN_VALUE(I) = 1
2182 ENDDO
2183 ENDIF ! igtyp
2184 ELSE ! ITY == 7
2185.OR. IF(IGTYP == 51 IGTYP == 52) THEN
2186 NPTT = BUFLY%NPTT
2187 DO IT = 1,NPTT
2188 DO IR =1,NPG
2189 DO I=1,NEL
2190 VALUE(I) = VALUE(I) + THIRD*BUFLY%LBUF(IR,1,IT)%PLA(I)/NPTT
2191 IS_WRITTEN_VALUE(I) = 1
2192 ENDDO
2193 ENDDO
2194 ENDDO
2195 ELSE
2196 DO I=1,NEL
2197 VALUE(I) = THIRD*(BUFLY%LBUF(1,1,1)%PLA(I) + BUFLY%LBUF(1,1,1)%PLA(I) +
2198 . BUFLY%LBUF(1,1,1)%PLA(I))
2199 IS_WRITTEN_VALUE(I) = 1
2200 ENDDO
2201 ENDIF ! igtyp
2202 ENDIF ! ity
2203 ELSE ! NPG == 1
2204.OR. IF(IGTYP == 51 IGTYP == 52) THEN
2205 NPTT = BUFLY%NPTT ! needed for PID51 (new shell prop)
2206 DO IT=1,NPTT
2207 DO I=1,NEL
2208 VALUE(I) = VALUE(I) + ABS(BUFLY%LBUF(1,1,IT)%PLA(I))/NPTT
2209 IS_WRITTEN_VALUE(I) = 1
2210 ENDDO
2211 ENDDO
2212 ELSE
2213 NPTT = BUFLY%NPTT !
2214 IPT = IABS(NPTT)/2 + 1
2215 DO I=1,NEL
2216 VALUE(I) = ABS(BUFLY%LBUF(1,1,IPT)%PLA(I))
2217 IS_WRITTEN_VALUE(I) = 1
2218 ENDDO
2219 ENDIF
2220 ENDIF ! npg
2221 ENDIF ! BUFLY%L_PLA
2222c PLY=IPLY NPT=IPT
2223.AND..AND..AND. ELSEIF ( IPLY > 0 (IPT <= MPT IPT > 0 ) GBUF%G_PLA > 0) THEN
2224c
2225 DO J=1,NLAY
2226 ID_PLY = 0
2227.OR. IF (IGTYP == 17 IGTYP == 51) THEN
2228 ID_PLY = IGEO(1,STACK%IGEO(2+J,ISUBSTACK))
2229 ELSEIF (IGTYP == 52) THEN
2230 ID_PLY = PLY_INFO(1,STACK%IGEO(2+J,ISUBSTACK)-NUMSTACK)
2231 ENDIF
2232c
2233 IF (ID_PLY == IPLY ) THEN
2234 BUFLY => ELBUF_TAB(NG)%BUFLY(J)
2235.OR..OR. IF (IGTYP == 17 IGTYP == 51 IGTYP == 52 ) THEN
2236 NPTT = BUFLY%NPTT
2237 IF( IPT <= NPTT) THEN
2238 IF( NPG > 1 ) THEN
2239 DO IR=1,NPTR
2240 DO IS=1,NPTS
2241 DO I=1,NEL
2242 VALUE(I) = VALUE(I) + ABS(BUFLY%LBUF(IR,IS,IPT)%PLA(I))/NPG
2243 IS_WRITTEN_VALUE(I) = 1
2244 ENDDO
2245 ENDDO
2246 ENDDO
2247 ELSE
2248 DO I=1,NEL
2249 VALUE(I) = ABS(BUFLY%LBUF(1,1,IPT)%PLA(I))
2250 IS_WRITTEN_VALUE(I) = 1
2251 ENDDO
2252 ENDIF
2253 ENDIF
2254 ENDIF
2255 ENDIF
2256 ENDDO
2257
2258c PLY=IPLY NPT=NULL
2259.AND..AND. ELSEIF ( IPLY > 0 IPT == -1 GBUF%G_PLA > 0) THEN
2260c
2261 DO J=1,NLAY
2262 ID_PLY = 0
2263.OR. IF (IGTYP == 17 IGTYP == 51) THEN
2264 ID_PLY = IGEO(1,STACK%IGEO(2+J,ISUBSTACK))
2265 ELSEIF (IGTYP == 52) THEN
2266 ID_PLY = PLY_INFO(1,STACK%IGEO(2+J,ISUBSTACK)-NUMSTACK)
2267 ENDIF
2268c
2269 IF (ID_PLY == IPLY ) THEN
2270 BUFLY => ELBUF_TAB(NG)%BUFLY(J)
2271.OR..OR. IF (IGTYP == 17 IGTYP == 51 IGTYP == 52 ) THEN
2272 NPTT = BUFLY%NPTT
2273 DO IPT=1,NPTT
2274 IF( IPT <= NPTT) THEN
2275 IF( NPG > 1 ) THEN
2276 DO IR=1,NPTR
2277 DO IS=1,NPTS
2278 DO I=1,NEL
2279 VALUE(I) = VALUE(I) + ABS(BUFLY%LBUF(IR,IS,IPT)%PLA(I))/NPG
2280 IS_WRITTEN_VALUE(I) = 1
2281 ENDDO
2282 ENDDO
2283 ENDDO
2284 ELSE
2285 DO I=1,NEL
2286 VALUE(I) = VALUE(I) + ABS(BUFLY%LBUF(1,1,IPT)%PLA(I))
2287 IS_WRITTEN_VALUE(I) = 1
2288 ENDDO
2289 ENDIF
2290 ENDIF
2291 ENDDO
2292 ENDIF
2293 ENDIF
2294 ENDDO
2295
2296
2297c ILAYER= NPT=
2298.AND..AND..AND..AND. ELSEIF ( (ILAY <= NLAY ILAY > 0) (IPT <= MPT IPT > 0 ) GBUF%G_PLA > 0) THEN
2299.OR. IF (IGTYP == 51 IGTYP == 52) THEN
2300 BUFLY => ELBUF_TAB(NG)%BUFLY(ILAY)
2301 IF (BUFLY%L_PLA > 0) THEN
2302 DO IR=1,NPTR
2303 DO IS=1,NPTS
2304 LBUF => BUFLY%LBUF(IR,IS,IPT)
2305 DO I=1,NEL
2306 VALUE(I) = VALUE(I) + ABS(LBUF%PLA(I))/NPG
2307 IS_WRITTEN_VALUE(I) = 1
2308 ENDDO
2309 ENDDO
2310 ENDDO
2311 ENDIF
2312 ENDIF
2313c ILAYER=IL NPT=NULL
2314.AND..AND. ELSEIF ( ILAY <= NLAY ILAY > 0 GBUF%G_PLA > 0) THEN
2315.OR..OR..OR. IF (IGTYP == 10 IGTYP == 11 IGTYP == 16 IGTYP == 17) THEN
2316 BUFLY => ELBUF_TAB(NG)%BUFLY(ILAY)
2317 IF (BUFLY%L_PLA > 0) THEN
2318 DO IR=1,NPTR
2319 DO IS=1,NPTS
2320 LBUF => BUFLY%LBUF(IR,IS,1)
2321 DO I=1,NEL
2322 VALUE(I) = VALUE(I) + ABS(LBUF%PLA(I))/NPG
2323 IS_WRITTEN_VALUE(I) = 1
2324 ENDDO
2325 ENDDO
2326 ENDDO
2327 ENDIF
2328.OR. ELSEIF (IGTYP == 51 IGTYP == 52) THEN
2329 BUFLY => ELBUF_TAB(NG)%BUFLY(ILAY)
2330 IF (BUFLY%L_PLA > 0) THEN
2331 DO IT=1,NPTT
2332 DO IR=1,NPTR
2333 DO IS=1,NPTS
2334 LBUF => BUFLY%LBUF(IR,IS,IT)
2335 DO I=1,NEL
2336 VALUE(I) = VALUE(I) + ABS(LBUF%PLA(I))/NPG
2337 IS_WRITTEN_VALUE(I) = 1
2338 ENDDO
2339 ENDDO
2340 ENDDO
2341 ENDDO
2342 ENDIF
2343
2344 ENDIF
2345c ILAYER=NULL NPT=IPT
2346.AND..AND. ELSEIF ( IPT <= MPT IPT > 0 GBUF%G_PLA > 0) THEN
2347.OR. IF (IGTYP == 1 IGTYP == 9) THEN
2348 BUFLY => ELBUF_TAB(NG)%BUFLY(1)
2349 IF (BUFLY%L_PLA > 0) THEN
2350 DO IR=1,NPTR
2351 DO IS=1,NPTS
2352 LBUF => BUFLY%LBUF(IR,IS,IPT)
2353 DO I=1,NEL
2354 VALUE(I) = VALUE(I) + ABS(LBUF%PLA(I))/NPG
2355 IS_WRITTEN_VALUE(I) = 1
2356 ENDDO
2357 ENDDO
2358 ENDDO
2359 ENDIF
2360 ENDIF
2361 ENDIF
2362C--------------------------------------------------
2363c ELSEIF (KEYWORD == '') THEN ! output Damage IFUNC == 10253
2364C--------------------------------------------------
2365c DO IL=1,NLAY
2366c NFAIL = ELBUF_TAB(NG)%BUFLY(IL)%NFAIL
2367c DO IS=1,NPTS
2368c DO IT=1,NPTT
2369c DO IR=1,NPTR
2370c FBUF => ELBUF_TAB(NG)%BUFLY(IL)%FAIL(IR,IS,IT)
2371c DO IFAIL=1,NFAIL
2372c IF (FBUF%FLOC(IFAIL)%ILAWF == 25) THEN ! check NXT model
2373c DO I=1,NEL
2374c VALUE(I) = MAX(VALUE(I),FBUF%FLOC(IFAIL)%DAM(I))
2375c ENDDO
2376c ENDIF
2377c ENDDO
2378c ENDDO
2379c ENDDO
2380c ENDDO
2381c ENDDO
2382C--------------------------------------------------
2383c ELSEIF (KEYWORD == '') THEN ! output Sig1 IFUNC == 10254
2384C--------------------------------------------------
2385c DO IL=1,NLAY
2386c NFAIL = ELBUF_TAB(NG)%BUFLY(IL)%NFAIL
2387c DO IS=1,NPTS
2388c DO IT=1,NPTT
2389c DO IR=1,NPTR
2390c FBUF => ELBUF_TAB(NG)%BUFLY(IL)%FAIL(IR,IS,IT)
2391c DO IFAIL=1,NFAIL
2392c IF (FBUF%FLOC(IFAIL)%ILAWF == 25) THEN ! check NXT model
2393c NVARF = FBUF%FLOC(IFAIL)%NVAR
2394c DO I=1,NEL
2395c VAR = FBUF%FLOC(IFAIL)%VAR(NVARF*(I-1)+1) ! Sig1
2396c VALUE(I) = MAX(VALUE(I), VAR)
2397c ENDDO
2398c ENDIF
2399c ENDDO
2400c ENDDO
2401c ENDDO
2402c ENDDO
2403c ENDDO
2404C--------------------------------------------------
2405c ELSEIF (KEYWORD == '') THEN ! output Sig2 IFUNC == 10255
2406C--------------------------------------------------
2407c DO IL=1,NLAY
2408c NFAIL = ELBUF_TAB(NG)%BUFLY(IL)%NFAIL
2409c DO IS=1,NPTS
2410c DO IT=1,NPTT
2411c DO IR=1,NPTR
2412c FBUF => ELBUF_TAB(NG)%BUFLY(IL)%FAIL(IR,IS,IT)
2413c DO IFAIL=1,NFAIL
2414c IF (FBUF%FLOC(IFAIL)%ILAWF == 25) THEN ! check NXT model
2415c NVARF = FBUF%FLOC(IFAIL)%NVAR
2416c DO I=1,NEL
2417c VAR = FBUF%FLOC(IFAIL)%VAR(NVARF*(I-1)+2) ! Sig2
2418c VALUE(I) = MAX(VALUE(I), VAR)
2419c ENDDO
2420c ENDIF
2421c ENDDO
2422c ENDDO
2423c ENDDO
2424c ENDDO
2425c ENDDO
2426C--------------------------------------------------
2427 ELSEIF (KEYWORD == 'wpla.AND..OR.' (MLW == 15 MLW == 25) ) THEN ! anim/shell/WPLA/
2428C--------------------------------------------------
2429c ILAYER=NULL NPT=NULL
2430.AND..AND..and. IF ( ILAY == -1 IPT == -1 IPLY == -1 GBUF%G_PLA > 0) THEN
2431 ! for law25, plastic work < 0 if the layer has reached failure-p
2432 ILAY0 = 1
2433 IF (NLAY > 1) ILAY0 = IABS(NLAY)/2 + 1
2434 BUFLY => ELBUF_TAB(NG)%BUFLY(ILAY0)
2435 IF (BUFLY%L_PLA > 0) THEN
2436 IF (NPG > 1) THEN
2437 IF(ITY == 3) THEN
2438.OR. IF(IGTYP == 51 IGTYP == 52) THEN
2439 NPTT = BUFLY%NPTT
2440 DO IS = 1,NPTS
2441 DO IR = 1,NPTR
2442 DO IT = 1, NPTT
2443 DO I=1,NEL
2444 VALUE(I) = VALUE(I) + FOURTH*BUFLY%LBUF(IR,IS,IT)%PLA(I)/NPTT
2445 IS_WRITTEN_VALUE(I) = 1
2446 ENDDO
2447 ENDDO
2448 ENDDO
2449 ENDDO
2450 ELSE
2451 DO I=1,NEL
2452 VALUE(I) = FOURTH*(BUFLY%LBUF(1,1,1)%PLA(I) + BUFLY%LBUF(2,1,1)%PLA(I) +
2453 . BUFLY%LBUF(1,2,1)%PLA(I) + BUFLY%LBUF(2,2,1)%PLA(I))
2454 IS_WRITTEN_VALUE(I) = 1
2455 ENDDO
2456 ENDIF ! igtyp
2457 ELSE ! ITY == 7
2458.OR. IF(IGTYP == 51 IGTYP == 52) THEN
2459 NPTT = BUFLY%NPTT
2460 DO IT = 1,NPTT
2461 DO IR =1,NPG
2462 DO I=1,NEL
2463 VALUE(I) = VALUE(I) + THIRD*BUFLY%LBUF(IR,1,IT)%PLA(I)/NPTT
2464 IS_WRITTEN_VALUE(I) = 1
2465 ENDDO
2466 ENDDO
2467 ENDDO
2468 ELSE
2469 DO I=1,NEL
2470 VALUE(I) = THIRD*(BUFLY%LBUF(1,1,1)%PLA(I) + BUFLY%LBUF(1,1,1)%PLA(I) +
2471 . BUFLY%LBUF(1,1,1)%PLA(I))
2472 IS_WRITTEN_VALUE(I) = 1
2473 ENDDO
2474 ENDIF ! igtyp
2475 ENDIF ! ity
2476 ELSE ! NPG == 1
2477.OR. IF(IGTYP == 51 IGTYP == 52)THEN
2478 NPTT = BUFLY%NPTT ! needed for PID51 (new shell prop)
2479 DO IT=1,NPTT
2480 DO I=1,NEL
2481 VALUE(I) = VALUE(I) + ABS(BUFLY%LBUF(1,1,IT)%PLA(I))/NPTT
2482 IS_WRITTEN_VALUE(I) = 1
2483 ENDDO
2484 ENDDO
2485 ELSE
2486 NPTT = BUFLY%NPTT !
2487 IPT = IABS(NPTT/2) + 1
2488 DO I=1,NEL
2489 VALUE(I) = ABS(BUFLY%LBUF(1,1,IPT)%PLA(I))
2490 IS_WRITTEN_VALUE(I) = 1
2491 ENDDO
2492 ENDIF
2493 ENDIF ! npg
2494 ENDIF ! BUFLY%L_PLA
2495c PLY=IPLY NPT=IPT
2496.AND..AND..AND. ELSEIF ( IPLY > 0 (IPT <= MPT IPT > 0 ) GBUF%G_PLA > 0) THEN
2497c
2498 DO J=1,NLAY
2499 ID_PLY = 0
2500.OR. IF (IGTYP == 17 IGTYP == 51) THEN
2501 ID_PLY = IGEO(1,STACK%IGEO(2+J,ISUBSTACK))
2502 ELSEIF (IGTYP == 52) THEN
2503 ID_PLY = PLY_INFO(1,STACK%IGEO(2+J,ISUBSTACK)-NUMSTACK)
2504 ENDIF
2505c
2506 IF (ID_PLY == IPLY ) THEN
2507 BUFLY => ELBUF_TAB(NG)%BUFLY(J)
2508.OR..OR. IF (IGTYP == 17 IGTYP == 51 IGTYP == 52 ) THEN
2509 NPTT = BUFLY%NPTT
2510 IF( IPT <= NPTT) THEN
2511 IF( NPG > 1 ) THEN
2512 DO IR=1,NPTR
2513 DO IS=1,NPTS
2514 DO I=1,NEL
2515 VALUE(I) = VALUE(I) + ABS(BUFLY%LBUF(IR,IS,IPT)%PLA(I))/NPG
2516 IS_WRITTEN_VALUE(I) = 1
2517 ENDDO
2518 ENDDO
2519 ENDDO
2520 ELSE
2521 DO I=1,NEL
2522 VALUE(I) = ABS(BUFLY%LBUF(1,1,IPT)%PLA(I))
2523 IS_WRITTEN_VALUE(I) = 1
2524 ENDDO
2525 ENDIF
2526 ENDIF
2527 ENDIF
2528 ENDIF
2529 ENDDO
2530
2531c PLY=IPLY NPT=NULL
2532.AND..AND. ELSEIF ( IPLY > 0 IPT == -1 GBUF%G_PLA > 0) THEN
2533c
2534 DO J=1,NLAY
2535 ID_PLY = 0
2536.OR. IF (IGTYP == 17 IGTYP == 51) THEN
2537 ID_PLY = IGEO(1,STACK%IGEO(2+J,ISUBSTACK))
2538 ELSEIF (IGTYP == 52) THEN
2539 ID_PLY = PLY_INFO(1,STACK%IGEO(2+J,ISUBSTACK)-NUMSTACK)
2540 ENDIF
2541c
2542 IF (ID_PLY == IPLY ) THEN
2543 BUFLY => ELBUF_TAB(NG)%BUFLY(J)
2544.OR..OR. IF (IGTYP == 17 IGTYP == 51 IGTYP == 52 ) THEN
2545 NPTT = BUFLY%NPTT
2546 DO IPT=1,NPTT
2547 IF( IPT <= NPTT) THEN
2548 IF( NPG > 1 ) THEN
2549 DO IR=1,NPTR
2550 DO IS=1,NPTS
2551 DO I=1,NEL
2552 VALUE(I) = VALUE(I) + ABS(BUFLY%LBUF(IR,IS,IPT)%PLA(I))/NPG
2553 IS_WRITTEN_VALUE(I) = 1
2554 ENDDO
2555 ENDDO
2556 ENDDO
2557 ELSE
2558 DO I=1,NEL
2559 VALUE(I) = VALUE(I) + ABS(BUFLY%LBUF(1,1,IPT)%PLA(I))
2560 IS_WRITTEN_VALUE(I) = 1
2561 ENDDO
2562 ENDIF
2563 ENDIF
2564 ENDDO
2565 ENDIF
2566 ENDIF
2567 ENDDO
2568
2569
2570c ILAYER= NPT=
2571.AND..AND..AND..AND. ELSEIF ( (ILAY <= NLAY ILAY > 0) (IPT <= MPT IPT > 0 ) GBUF%G_PLA > 0) THEN
2572.OR. IF (IGTYP == 51 IGTYP == 52) THEN
2573 BUFLY => ELBUF_TAB(NG)%BUFLY(ILAY)
2574 NPTT = BUFLY%NPTT
2575.AND. IF ((BUFLY%L_PLA > 0)(IPT <= NPTT)) THEN
2576 DO IR=1,NPTR
2577 DO IS=1,NPTS
2578 LBUF => BUFLY%LBUF(IR,IS,IPT)
2579 DO I=1,NEL
2580 VALUE(I) = VALUE(I) + ABS(LBUF%PLA(I))/NPG
2581 IS_WRITTEN_VALUE(I) = 1
2582 ENDDO
2583 ENDDO
2584 ENDDO
2585 ENDIF
2586 ENDIF
2587c ILAYER=IL NPT=NULL
2588.AND..AND. ELSEIF ( ILAY <= NLAY ILAY > 0 GBUF%G_PLA > 0) THEN
2589.OR..OR..OR. IF (IGTYP == 10 IGTYP == 11 IGTYP == 16 IGTYP == 17) THEN
2590 BUFLY => ELBUF_TAB(NG)%BUFLY(ILAY)
2591 IF (BUFLY%L_PLA > 0) THEN
2592 DO IR=1,NPTR
2593 DO IS=1,NPTS
2594 LBUF => BUFLY%LBUF(IR,IS,1)
2595 DO I=1,NEL
2596 VALUE(I) = VALUE(I) + ABS(LBUF%PLA(I))/NPG
2597 IS_WRITTEN_VALUE(I) = 1
2598 ENDDO
2599 ENDDO
2600 ENDDO
2601 ENDIF
2602.OR. ELSEIF (IGTYP == 51 IGTYP == 52) THEN
2603 BUFLY => ELBUF_TAB(NG)%BUFLY(ILAY)
2604 IF (BUFLY%L_PLA > 0) THEN
2605 DO IT=1,NPTT
2606 DO IR=1,NPTR
2607 DO IS=1,NPTS
2608 LBUF => BUFLY%LBUF(IR,IS,IT)
2609 DO I=1,NEL
2610 VALUE(I) = VALUE(I) + ABS(LBUF%PLA(I))/NPG
2611 IS_WRITTEN_VALUE(I) = 1
2612 ENDDO
2613 ENDDO
2614 ENDDO
2615 ENDDO
2616 ENDIF
2617
2618 ENDIF
2619c ILAYER=NULL NPT=IPT
2620.AND..AND. ELSEIF ( IPT <= MPT IPT > 0 GBUF%G_PLA > 0) THEN
2621.OR. IF (IGTYP == 1 IGTYP == 9) THEN
2622 BUFLY => ELBUF_TAB(NG)%BUFLY(1)
2623 IF (BUFLY%L_PLA > 0) THEN
2624 DO IR=1,NPTR
2625 DO IS=1,NPTS
2626 LBUF => BUFLY%LBUF(IR,IS,IPT)
2627 DO I=1,NEL
2628 VALUE(I) = VALUE(I) + ABS(LBUF%PLA(I))/NPG
2629 IS_WRITTEN_VALUE(I) = 1
2630 ENDDO
2631 ENDDO
2632 ENDDO
2633 ENDIF
2634 ENDIF
2635 ENDIF
2636C--------------------------------------
2637 ELSEIF (KEYWORD == 'nxtf') THEN ! Damage factor
2638C--------------------------------------------------
2639 IOK = 0
2640c ILAYER=NULL NPT=NULL
2641.AND. IF ( ILAY == -1 IPT == -1) THEN
2642 NFAIL = ELBUF_TAB(NG)%BUFLY(1)%NFAIL
2643 NPTT = ELBUF_TAB(NG)%BUFLY(1)%NPTT
2644 DO IS=1,NPTS
2645 DO IR=1,NPTR
2646 DO IT=1,NPTT
2647 IPT = IT
2648 FBUF => ELBUF_TAB(NG)%BUFLY(1)%FAIL(IR,IS,IPT)
2649 DO IFAIL=1,NFAIL
2650 IF (FBUF%FLOC(IFAIL)%ILAWF == 25) THEN ! check NXT model
2651 IOK = 1
2652 DO I=1,NEL
2653 VALUE(I) = MAX(VALUE(I),FBUF%FLOC(IFAIL)%DAM(I))
2654 IS_WRITTEN_VALUE(I) = 1
2655 ENDDO
2656 ENDIF
2657 ENDDO
2658 ENDDO
2659 ENDDO
2660 ENDDO
2661c ILAYER=ILAY NPT=IPT
2662.AND..AND..AND. ELSEIF (ILAY <= NLAY ILAY > 0 IPT <= MPT IPT > 0 ) THEN
2663.OR. IF (IGTYP == 51 IGTYP == 52) THEN
2664 NFAIL = ELBUF_TAB(NG)%BUFLY(ILAY)%NFAIL
2665 NPTT = ELBUF_TAB(NG)%BUFLY(ILAY)%NPTT
2666 DO IS=1,NPTS
2667 DO IR=1,NPTR
2668 FBUF => ELBUF_TAB(NG)%BUFLY(ILAY)%FAIL(IR,IS,IPT)
2669 DO IFAIL=1,NFAIL
2670 IF (FBUF%FLOC(IFAIL)%ILAWF == 25) THEN ! check NXT model
2671 IOK = 1
2672 DO I=1,NEL
2673 VALUE(I) = MAX(VALUE(I),FBUF%FLOC(IFAIL)%DAM(I))
2674 IS_WRITTEN_VALUE(I) = 1
2675 ENDDO
2676 ENDIF
2677 ENDDO
2678 ENDDO
2679 ENDDO
2680 ENDIF
2681c ILAYER=IL NPT=NULL
2682.AND. ELSEIF ( ILAY <= NLAY ILAY > 0) THEN
2683.OR..OR..OR. IF (IGTYP == 10 IGTYP == 11 IGTYP == 16 IGTYP == 17) THEN
2684 NFAIL = ELBUF_TAB(NG)%BUFLY(ILAY)%NFAIL
2685 NPTT = ELBUF_TAB(NG)%BUFLY(ILAY)%NPTT
2686 DO IS=1,NPTS
2687 DO IR=1,NPTR
2688 FBUF => ELBUF_TAB(NG)%BUFLY(ILAY)%FAIL(IR,IS,1)
2689 DO IFAIL=1,NFAIL
2690 IF (FBUF%FLOC(IFAIL)%ILAWF == 25) THEN ! check NXT model
2691 IOK = 1
2692 DO I=1,NEL
2693 VALUE(I) = MAX(VALUE(I),FBUF%FLOC(IFAIL)%DAM(I))
2694 IS_WRITTEN_VALUE(I) = 1
2695 ENDDO
2696 ENDIF
2697 ENDDO
2698 ENDDO
2699 ENDDO
2700.OR. ELSEIF (IGTYP == 51 IGTYP == 52) THEN
2701 NFAIL = ELBUF_TAB(NG)%BUFLY(ILAY)%NFAIL
2702 NPTT = ELBUF_TAB(NG)%BUFLY(ILAY)%NPTT
2703 DO IS=1,NPTS
2704 DO IR=1,NPTR
2705 DO IPT=1,NPTT
2706 FBUF => ELBUF_TAB(NG)%BUFLY(ILAY)%FAIL(IR,IS,IPT)
2707 DO IFAIL=1,NFAIL
2708 IF (FBUF%FLOC(IFAIL)%ILAWF == 25) THEN ! check NXT model
2709 IOK = 1
2710 DO I=1,NEL
2711 VALUE(I) = MAX(VALUE(I),FBUF%FLOC(IFAIL)%DAM(I))
2712 IS_WRITTEN_VALUE(I) = 1
2713 ENDDO
2714 ENDIF
2715 ENDDO
2716 ENDDO
2717 ENDDO
2718 ENDDO
2719 ENDIF
2720c ILAYER=NULL NPT=IPT
2721.AND. ELSEIF ( IPT <= MPT IPT > 0) THEN
2722.OR. IF (IGTYP == 1 IGTYP == 9) THEN
2723 NFAIL = ELBUF_TAB(NG)%BUFLY(1)%NFAIL
2724 NPTT = ELBUF_TAB(NG)%BUFLY(1)%NPTT
2725 DO IS=1,NPTS
2726 DO IR=1,NPTR
2727 FBUF => ELBUF_TAB(NG)%BUFLY(1)%FAIL(IR,IS,IPT)
2728 DO IFAIL=1,NFAIL
2729 IF (FBUF%FLOC(IFAIL)%ILAWF == 25) THEN ! check NXT model
2730 IOK = 1
2731 DO I=1,NEL
2732 VALUE(I) = MAX(VALUE(I),FBUF%FLOC(IFAIL)%DAM(I))
2733 IS_WRITTEN_VALUE(I) = 1
2734 ENDDO
2735 ENDIF
2736 ENDDO
2737 ENDDO
2738 ENDDO
2739 ENDIF
2740 ENDIF
2741C--------------------------------------------------
2742 ELSEIF (KEYWORD == 'nxtf/memb') THEN ! Damage factor - membrane
2743C--------------------------------------------------
2744 IOK = 0
2745 IF (NLAY > 1) THEN
2746 IL = IABS(NLAY) / 2
2747 IPT = 1
2748 ELSE
2749 IL = 1
2750 IPT = IABS(NPTT) / 2
2751 ENDIF
2752 NFAIL = ELBUF_TAB(NG)%BUFLY(IL)%NFAIL
2753 DO IS=1,NPTS
2754 DO IR=1,NPTR
2755 DO IT=1,NPTT
2756 IPT = IT
2757 IF (NLAY == 1) IPT = IABS(NPTT) / 2
2758 FBUF => ELBUF_TAB(NG)%BUFLY(IL)%FAIL(IR,IS,IPT)
2759 DO IFAIL=1,NFAIL
2760 IF (FBUF%FLOC(IFAIL)%ILAWF == 25) THEN ! check NXT model
2761 IOK = 1
2762 DO I=1,NEL
2763 VALUE(I) = MAX(VALUE(I),FBUF%FLOC(IFAIL)%DAM(I))
2764 IS_WRITTEN_VALUE(I) = 1
2765 ENDDO
2766 ENDIF
2767 ENDDO
2768 ENDDO
2769 ENDDO
2770 ENDDO
2771C--------------------------------------------------
2772 ELSE IF (KEYWORD == 'fail') THEN ! FAIL
2773C--------------------------------------------------
2774.OR..OR..OR. IF (IGTYP == 10. OR.IGTYP == 11IGTYP == 17IGTYP == 51
2775 . IGTYP == 52) THEN
2776 FAILG = 0
2777 DO I=1,NEL
2778 DAM1(I)=ZERO
2779 DAM2(I)=ZERO
2780 WPLA(I)=ZERO
2781 FAIL(I)=ZERO
2782 END DO
2783c
2784 IF (IHBE == 11) THEN
2785 DO IL=1,NLAY
2786 NPTT = ELBUF_TAB(NG)%BUFLY(IL)%NPTT
2787 BUFLY => ELBUF_TAB(NG)%BUFLY(IL)
2788 IMAT = ELBUF_TAB(NG)%BUFLY(IL)%IMAT
2789 IADR = (IL-1)*NEL
2790 MLW_LAY = ELBUF_TAB(NG)%BUFLY(IL)%ILAW
2791 DO IT=1,NPTT
2792 DO I=1,NEL
2793 WPLA(I) = ZERO
2794 ENDDO
2795 TAG = 0
2796 DO IR=1,NPTR
2797 DO IS=1,NPTS
2798 LBUF => ELBUF_TAB(NG)%BUFLY(IL)%LBUF(IR,IS,IT)
2799 DO I=1,NEL
2800 J = IADR + I
2801 IF (MLW_LAY == 25) THEN
2802 DAM1(I)=LBUF%DMG(JJ(1)+I)
2803 DAM2(I)=LBUF%DMG(JJ(2)+I)
2804 WPLA(I) = WPLA(I) + ABS(LBUF%PLA(I))/NPG
2805 DMAX(I) = PM(64,IMAT)
2806 WPMAX(I)= PM(41,IMAT)
2807.OR. IF (DAM1(I) >= DMAX(I)DAM2(I) >= DMAX(I)
2808.OR..OR. . WPLA(I) < ZEROWPLA(I) >= WPMAX(I))
2809 . FAILG(IL,I) = FAILG(IL,I) + 1
2810 IF (FAILG(IL,I) == NPG ) THEN
2811 FAIL(I) = FAIL(I) + ONE
2812 FAILG(IL,I) = NPG + 1
2813 ENDIF
2814 ELSEIF (MLW_LAY == 15) THEN
2815 DAM1(I)=LBUF%DAM(JJ(1)+I)
2816 DAM2(I)=LBUF%DAM(JJ(2)+I)
2817 WPLA(I) = WPLA(I) + ABS(LBUF%PLA(I))/NPG
2818 DMAX(I) = PM(64,IMAT)
2819 WPMAX(I)= PM(41,IMAT)
2820.OR. IF (DAM1(I) >= DMAX(I)DAM2(I) >= DMAX(I)
2821.OR..OR. . WPLA(I) < ZEROWPLA(I) >= WPMAX(I))
2822 . FAILG(IL,I) = FAILG(IL,I) + 1
2823 IF (FAILG(IL,I) == NPG ) THEN
2824 FAIL(I) = FAIL(I) + ONE
2825 FAILG(IL,I) = NPG + 1
2826 ENDIF
2827 ELSE ! available law127. save info in lbuf%off
2828 IF(LBUF%OFF(I) < ONE) TAG= 1
2829 ENDIF
2830 ENDDO
2831 ENDDO
2832 FAIL(I) = FAIL(I) + TAG ! only one plan integration is off
2833 ENDDO
2834 ENDDO
2835 ENDDO ! DO IL=1,NLAY
2836 DO I=1,NEL
2837 VALUE(I) = FAIL(I)
2838 IS_WRITTEN_VALUE(I) = 1
2839 ENDDO
2840 ELSE
2841 DO IL=1,NLAY
2842 NPTT = ELBUF_TAB(NG)%BUFLY(IL)%NPTT
2843 BUFLY => ELBUF_TAB(NG)%BUFLY(IL)
2844 IMAT = ELBUF_TAB(NG)%BUFLY(IL)%IMAT
2845 IADR = (IL-1)*NEL
2846 MLW_LAY = ELBUF_TAB(NG)%BUFLY(IL)%ILAW
2847 DO IT=1,NPTT
2848 LBUF => ELBUF_TAB(NG)%BUFLY(IL)%LBUF(1,1,IT)
2849 DO I=1,NEL
2850 J = IADR + I
2851 IF (MLW_LAY == 25) THEN
2852 DAM1(I)=LBUF%DMG(JJ(1)+I)
2853 DAM2(I)=LBUF%DMG(JJ(2)+I)
2854 WPLA(I) = ABS(LBUF%PLA(I))
2855 DMAX(I) = PM(64,IMAT)
2856 WPMAX(I)= PM(41,IMAT)
2857.OR..OR. IF (DAM1(I) >= DMAX(I)DAM2(I) >= DMAX(I)
2858.OR. . WPLA(I) < ZEROWPLA(I) >= WPMAX(I))
2859 . FAIL(I) = FAIL(I) + ONE
2860 ELSEIF (MLW_LAY == 15) THEN
2861 DAM1(I)=LBUF%DAM(JJ(1)+I)
2862 DAM2(I)=LBUF%DAM(JJ(2)+I)
2863 WPLA(I) = ABS(LBUF%PLA(I))
2864 DMAX(I) = PM(64,IMAT)
2865 WPMAX(I)= PM(41,IMAT)
2866.OR..OR. IF (DAM1(I) >= DMAX(I)DAM2(I) >= DMAX(I)
2867.OR. . WPLA(I) < ZEROWPLA(I) >= WPMAX(I))
2868 . FAIL(I) = FAIL(I) + ONE
2869 ELSE ! available law127. save info in lbuf%off
2870 IF(LBUF%OFF(I) < ONE) FAIL(I) = FAIL(I) + 1
2871 ENDIF
2872 ENDDO
2873 ENDDO
2874 ENDDO ! DO IL=1,NLAY
2875 DO I=1,NEL
2876 VALUE(I) = FAIL(I)
2877 IS_WRITTEN_VALUE(I) = 1
2878 ENDDO
2879 ENDIF
2880 ENDIF ! IGTYP
2881C--------------------------------------------------
2882 ELSE IF (KEYWORD == 'dama') THEN
2883C--------------------------------------------------
2884.OR..OR. IF( IGTYP == 10 IGTYP == 11
2885.OR..OR. . IGTYP == 17 IGTYP == 51 IGTYP == 52 ) THEN
2886 IF(ITY == 3)THEN
2887 DO I=1,NEL
2888 MAT(I)=IXC(1,NFT+I)
2889 PID(I)=IXC(6,NFT+I)
2890 END DO
2891 ELSE
2892 DO I=1,NEL
2893 MAT(I)=IXTG(1,NFT+I)
2894 PID(I)=IXTG(5,NFT+I)
2895 END DO
2896 END IF
2897 IF (IGTYP == 11) THEN
2898 IPMAT = 100
2899 DO N=1,NLAY
2900 IADR = (N-1)*NEL
2901 DO I=1,NEL
2902 J = IADR+I
2903 MATLY(J) = IGEO(IPMAT+N,PID(I))
2904 END DO
2905 END DO
2906 ELSEIF (IGTYP == 10) THEN
2907 DO N=1,NPT
2908 IADR = (N-1)*NEL
2909 DO I=1,NEL
2910 J = IADR+I
2911 MATLY(J)=MAT(I)
2912 END DO
2913 END DO
2914.OR..OR. ELSEIF (IGTYP == 17 IGTYP == 51 IGTYP == 52) THEN
2915 IPMAT = 2 + NLAY
2916 DO N=1,NLAY
2917 IADR = (N-1)*NEL
2918 DO I=1,NEL
2919 J = IADR+I
2920 MATLY(J) = STACK%IGEO(IPMAT+N,ISUBSTACK)
2921 END DO
2922 END DO
2923 END IF
2924 ENDIF
2925c
2926c IPLY=NULL ILAYER=NULL NPT=NULL
2927.AND..AND. IF ( ILAY == -1 IPT == -1 IPLY == -1) THEN
2928 IF(IFAILURE > 0) THEN
2929 IF (NLAY > 1) THEN
2930 DO I=1,NEL
2931 DO N = 1,NLAY
2932 NPTT = ELBUF_TAB(NG)%BUFLY(N)%NPTT
2933 DO IT = 1,NPTT
2934 DMGMX = ZERO
2935 DO IR = 1,NPTR
2936 DO IS = 1,NPTS
2937 FBUF => ELBUF_TAB(NG)%BUFLY(N)%FAIL(IR,IS,IT)
2938 DO IFAIL = 1,ELBUF_TAB(NG)%BUFLY(N)%NFAIL
2939 DMGMX = MAX(DMGMX,FBUF%FLOC(IFAIL)%DAMMX(I))
2940 ENDDO
2941 ENDDO
2942 ENDDO
2943 VALUE(I) = VALUE(I) + DMGMX/NPTT
2944 ENDDO ! DO IT = 1,NPTT
2945 ENDDO ! N=1,NLAY
2946 VALUE(I) = VALUE(I) / NLAY
2947 IS_WRITTEN_VALUE(I) = 1
2948 ENDDO
2949
2950 ELSEIF (MPT > 0) THEN ! NLAY = 1
2951 NPTT = ELBUF_TAB(NG)%BUFLY(1)%NPTT
2952 DO I=1,NEL
2953 DO IT = 1,NPTT
2954 DMGMX = ZERO
2955 DO IR = 1,NPTR
2956 DO IS = 1,NPTS
2957 FBUF => ELBUF_TAB(NG)%BUFLY(1)%FAIL(IR,IS,IT)
2958 DO IFAIL = 1,ELBUF_TAB(NG)%BUFLY(1)%NFAIL
2959 DMGMX = MAX(DMGMX, FBUF%FLOC(IFAIL)%DAMMX(I))
2960 ENDDO
2961 ENDDO
2962 ENDDO
2963 VALUE(I) = VALUE(I) + DMGMX
2964 ENDDO ! N=1,NPTT
2965 VALUE(I) = VALUE(I) / NPTT
2966 IS_WRITTEN_VALUE(I) = 1
2967 ENDDO ! I=1,NEL
2968 ENDIF
2969 ENDIF
2970.OR..OR..OR. IF (IGTYP == 10 IGTYP == 11 IGTYP == 17
2971.OR. . IGTYP == 51 IGTYP == 52 ) THEN
2972C
2973 DO I=1,NEL
2974 VE(1:5) = ZERO
2975 NLAY_COUNT = 0
2976 DO IL=1,NLAY
2977 NPTT = ELBUF_TAB(NG)%BUFLY(IL)%NPTT
2978 BUFLY => ELBUF_TAB(NG)%BUFLY(IL)
2979 IADR = (IL-1)*NEL
2980 J = IADR + I
2981 MLW_LAY = MATPARAM(MATLY(J))%ILAW
2982 IF (MLW_LAY == 25) THEN
2983 NLAY_COUNT = NLAY_COUNT + 1
2984 VLY(1:5) = ZERO
2985 DO IT=1,NPTT
2986 VG(1:5)= ZERO
2987 DO IR=1,NPTR
2988 DO IS=1,NPTS
2989 LBUF => ELBUF_TAB(NG)%BUFLY(IL)%LBUF(IR,IS,IT)
2990 DMAX(I) = ONE/PM(64,MATLY(J))
2991 WPMAX(I)= ONE/PM(41,MATLY(J))
2992 EPST1(I)= PM(60,MATLY(J))
2993 EPST2(I)= PM(61,MATLY(J))
2994 EPSF1(I)= ONE/PM(98,MATLY(J))
2995 EPSF2(I)= ONE/PM(99,MATLY(J))
2996C
2997 VG(1) = MAX(VG(1),LBUF%DMG(JJ(1)+I)*DMAX(I))
2998 VG(2) = MAX(VG(2),LBUF%DMG(JJ(2)+I)*DMAX(I))
2999 VG(3)=MAX(VG(3),ABS(LBUF%PLA(I))*WPMAX(I))
3000 IF(LBUF%CRAK(JJ(1)+I) > ZERO) VG(4)= MAX(VG(4),
3001 . (LBUF%CRAK(JJ(1)+I)+EPST1(I))*EPSF1(I))
3002 IF(LBUF%CRAK(JJ(2)+I) > ZERO )VG(5) = MAX(VG(5),
3003 . (LBUF%CRAK(JJ(2)+I)+EPST2(I))*EPSF2(I))
3004 ENDDO
3005 ENDDO
3006 VLY(1) = VLY(1) + VG(1)
3007 VLY(2) = VLY(2) + VG(2)
3008 VLY(3) = VLY(3) + VG(3)
3009 VLY(4) = VLY(4) + VG(4)
3010 VLY(5) = VLY(5) + VG(5)
3011 ENDDO ! NPTT
3012 VE(1) = VE(1) + VLY(1)/NPTT
3013 VE(2) = VE(2) + VLY(2)/NPTT
3014 VE(3) = VE(3) + VLY(3)/NPTT
3015 VE(4) = VE(4) + VLY(4)/NPTT
3016 VE(5) = VE(5) + VLY(5)/NPTT
3017 ENDIF
3018 ENDDO ! DO IL=1,NLAY
3019 IF (NLAY_COUNT > 0) THEN
3020 VE(1) = VE(1)/NLAY_COUNT
3021 VE(2) = VE(2)/NLAY_COUNT
3022 VE(3) = VE(3)/NLAY_COUNT
3023 VE(4) = VE(4)/NLAY_COUNT
3024 VE(5) = VE(5)/NLAY_COUNT
3025 ENDIF
3026 VALUE(I) = MAX(VALUE(I),VE(1),VE(2),VE(3),
3027 . VE(4),VE(5))
3028 IS_WRITTEN_VALUE(I) = 1
3029 ENDDO ! I=1,JLT
3030 ENDIF ! law 25 + SHell Composite PID
3031.AND..AND. ELSEIF ( IPLY > 0 IPT <= MPT IPT > 0 ) THEN
3032c PLY=IPLY NPT=IPT
3033 IF(IFAILURE > 0) THEN
3034 DO J=1,NLAY
3035 NPTT = ELBUF_TAB(NG)%BUFLY(J)%NPTT
3036 ID_PLY = 0
3037.OR. IF (IGTYP == 17 IGTYP == 51) THEN
3038 ID_PLY = IGEO(1,STACK%IGEO(2+J,ISUBSTACK))
3039 ELSEIF (IGTYP == 52) THEN
3040 ID_PLY=PLY_INFO(1,STACK%IGEO(2+J,ISUBSTACK)-NUMSTACK)
3041 ENDIF
3042 IF (ID_PLY == IPLY )THEN
3043 IF (IPT <= NPTT) THEN
3044 DO I=1,NEL
3045 DO IR = 1, NPTR
3046 DO IS = 1, NPTS
3047 FBUF => ELBUF_TAB(NG)%BUFLY(J)%FAIL(IR,IS,IPT)
3048 DO IFAIL = 1, ELBUF_TAB(NG)%BUFLY(J)%NFAIL
3049 VALUE(I) = MAX(VALUE(I) , FBUF%FLOC(IFAIL)%DAMMX(I))
3050 ENDDO
3051 ENDDO
3052 ENDDO
3053 IS_WRITTEN_VALUE(I) = 1
3054 ENDDO
3055 ENDIF
3056 ENDIF
3057 ENDDO
3058 ENDIF
3059c
3060.OR..OR. IF (IGTYP == 17 IGTYP == 51 IGTYP == 52) THEN
3061 DO J=1,NLAY
3062 ID_PLY = 0
3063.OR. IF (IGTYP == 17 IGTYP == 51) THEN
3064 ID_PLY = IGEO(1,STACK%IGEO(2+J,ISUBSTACK))
3065 ELSEIF (IGTYP == 52) THEN
3066 ID_PLY=PLY_INFO(1,STACK%IGEO(2+J,ISUBSTACK)-NUMSTACK)
3067 ENDIF
3068c
3069 IF (ID_PLY == IPLY )THEN
3070 BUFLY => ELBUF_TAB(NG)%BUFLY(J)
3071 DO I=1,NEL
3072 NPTT = ELBUF_TAB(NG)%BUFLY(J)%NPTT
3073 IADR = (J - 1)*NEL
3074 MLW_LAY = MATPARAM(MATLY(IADR + I))%ILAW
3075 IF (MLW_LAY == 25) THEN
3076 VLY(1:5) = ZERO
3077 VG(1:5)= ZERO
3078 DO IR=1,NPTR
3079 DO IS=1,NPTS
3080 LBUF=> ELBUF_TAB(NG)%BUFLY(J)%LBUF(IR,IS,IPT)
3081 DMAX(I) = ONE/PM(64,MATLY(IADR + I))
3082 WPMAX(I)= ONE/PM(41,MATLY(IADR + I))
3083 EPST1(I)= PM(60,MATLY(IADR + I))
3084 EPST2(I)= PM(61,MATLY(IADR + I))
3085 EPSF1(I)= ONE/PM(98,MATLY(IADR + I))
3086 EPSF2(I)= ONE/PM(99,MATLY(IADR + I))
3087C
3088 VG(1) = MAX(VG(1),LBUF%DMG(JJ(1)+I)*DMAX(I))
3089 VG(2) = MAX(VG(2),LBUF%DMG(JJ(2)+I)*DMAX(I))
3090 VG(3)= MAX(VG(3),ABS(LBUF%PLA(I))*WPMAX(I))
3091 IF(LBUF%CRAK(JJ(1)+I) > ZERO) VG(4)= MAX(VG(4),
3092 . (LBUF%CRAK(JJ(1)+I)+EPST1(I))*EPSF1(I))
3093 IF(LBUF%CRAK(JJ(2)+I) > ZERO )VG(5) = MAX(VG(5),
3094 . (LBUF%CRAK(JJ(2)+I)+EPST2(I))*EPSF2(I))
3095 ENDDO
3096 ENDDO
3097 VLY(1) =VG(1)
3098 VLY(2) =VG(2)
3099 VLY(3) =VG(3)
3100 VLY(4) =VG(4)
3101 VLY(5) =VG(5)
3102C
3103 VALUE(I) = MAX(VALUE(I),VLY(1),VLY(2),VLY(3),VLY(4),VLY(5))
3104 IS_WRITTEN_VALUE(I) = 1
3105 ENDIF
3106 ENDDO ! I=1,JLT
3107
3108 ENDIF
3109 ENDDO
3110 ENDIF
3111.AND. ELSEIF ( IPLY > 0 IPT == -1 ) THEN
3112c PLY=IPLY NPT=-1
3113 IF(IFAILURE > 0) THEN
3114 DO J=1,NLAY
3115 NPTT = ELBUF_TAB(NG)%BUFLY(J)%NPTT
3116 ID_PLY = 0
3117.OR. IF (IGTYP == 17 IGTYP == 51) THEN
3118 ID_PLY = IGEO(1,STACK%IGEO(2+J,ISUBSTACK))
3119 ELSEIF (IGTYP == 52) THEN
3120 ID_PLY=PLY_INFO(1,STACK%IGEO(2+J,ISUBSTACK)-NUMSTACK)
3121 ENDIF
3122 IF (ID_PLY == IPLY )THEN
3123 DO I=1,NEL
3124 DO IR = 1, NPTR
3125 DO IS = 1, NPTS
3126 DO IT = 1, NPTT
3127 FBUF => ELBUF_TAB(NG)%BUFLY(J)%FAIL(IR,IS,IT)
3128 DO IFAIL = 1, ELBUF_TAB(NG)%BUFLY(J)%NFAIL
3129 VALUE(I) = MAX(VALUE(I) , FBUF%FLOC(IFAIL)%DAMMX(I))
3130 ENDDO
3131 ENDDO
3132 ENDDO
3133 ENDDO
3134 IS_WRITTEN_VALUE(I) = 1
3135 ENDDO
3136 ENDIF
3137 ENDDO
3138 ENDIF
3139c
3140.OR..OR. IF (IGTYP == 17 IGTYP == 51 IGTYP == 52) THEN
3141 DO J=1,NLAY
3142 ID_PLY = 0
3143.OR. IF (IGTYP == 17 IGTYP == 51) THEN
3144 ID_PLY = IGEO(1,STACK%IGEO(2+J,ISUBSTACK))
3145 ELSEIF (IGTYP == 52) THEN
3146 ID_PLY=PLY_INFO(1,STACK%IGEO(2+J,ISUBSTACK)-NUMSTACK)
3147 ENDIF
3148c
3149 IF (ID_PLY == IPLY )THEN
3150 BUFLY => ELBUF_TAB(NG)%BUFLY(J)
3151 DO I=1,NEL
3152 NPTT = ELBUF_TAB(NG)%BUFLY(J)%NPTT
3153 IADR = (J - 1)*NEL
3154 MLW_LAY = MATPARAM(MATLY(IADR + I))%ILAW
3155 IF (MLW_LAY == 25) THEN
3156 VLY(1:5) = ZERO
3157 VG(1:5)= ZERO
3158 DO IR=1,NPTR
3159 DO IS=1,NPTS
3160 DO IT=1,NPTT
3161 LBUF=> ELBUF_TAB(NG)%BUFLY(J)%LBUF(IR,IS,IT)
3162 DMAX(I) = ONE/PM(64,MATLY(IADR + I))
3163 WPMAX(I)= ONE/PM(41,MATLY(IADR + I))
3164 EPST1(I)= PM(60,MATLY(IADR + I))
3165 EPST2(I)= PM(61,MATLY(IADR + I))
3166 EPSF1(I)= ONE/PM(98,MATLY(IADR + I))
3167 EPSF2(I)= ONE/PM(99,MATLY(IADR + I))
3168C
3169 VG(1) = MAX(VG(1),LBUF%DMG(JJ(1)+I)*DMAX(I))
3170 VG(2) = MAX(VG(2),LBUF%DMG(JJ(2)+I)*DMAX(I))
3171 VG(3)= MAX(VG(3),ABS(LBUF%PLA(I))*WPMAX(I))
3172 IF(LBUF%CRAK(JJ(1)+I) > ZERO) VG(4)= MAX(VG(4),
3173 . (LBUF%CRAK(JJ(1)+I)+EPST1(I))*EPSF1(I))
3174 IF(LBUF%CRAK(JJ(2)+I) > ZERO )VG(5) = MAX(VG(5),
3175 . (LBUF%CRAK(JJ(2)+I)+EPST2(I))*EPSF2(I))
3176 ENDDO
3177 ENDDO
3178 ENDDO
3179 VLY(1) =VG(1)
3180 VLY(2) =VG(2)
3181 VLY(3) =VG(3)
3182 VLY(4) =VG(4)
3183 VLY(5) =VG(5)
3184C
3185 VALUE(I) = MAX(VALUE(I),VLY(1),VLY(2),VLY(3),VLY(4),VLY(5))
3186 IS_WRITTEN_VALUE(I) = 1
3187 ENDIF
3188 ENDDO ! I=1,JLT
3189 ENDIF
3190 ENDDO
3191 ENDIF
3192c ILAYER=ILAY NPT=IPT
3193.AND..AND..AND. ELSEIF (ILAY <= NLAY ILAY > 0 IPT <= MPT IPT > 0 ) THEN
3194.OR. IF (IGTYP == 51 IGTYP == 52) THEN
3195 NPTT = ELBUF_TAB(NG)%BUFLY(ILAY)%NPTT
3196 DO I=1,NEL
3197 DMGMX = ZERO
3198 DO IR = 1,NPTR
3199 DO IS = 1,NPTS
3200 FBUF => ELBUF_TAB(NG)%BUFLY(ILAY)%FAIL(IR,IS,IPT)
3201 DO IFAIL = 1,ELBUF_TAB(NG)%BUFLY(ILAY)%NFAIL
3202 VALUE(I) = MAX(VALUE(I),FBUF%FLOC(IFAIL)%DAMMX(I))
3203 IS_WRITTEN_VALUE(I) = 1
3204 ENDDO
3205 ENDDO
3206 ENDDO
3207 VALUE(I) = VALUE(I) + DMGMX
3208 ENDDO ! I=1,NEL
3209 !< Check damage for law 25
3210 DO I=1,NEL
3211 K1 = 2*I-1
3212 K2 = 2*I
3213 NPTT = ELBUF_TAB(NG)%BUFLY(ILAY)%NPTT
3214 BUFLY => ELBUF_TAB(NG)%BUFLY(ILAY)
3215 IADR = (IPT - 1)*NEL
3216 J = IADR + I
3217 MLW_LAY = MATPARAM(MATLY(IADR + I))%ILAW
3218 IF (MLW_LAY == 25) THEN
3219 VLY(1:5) = ZERO
3220 VG(1:5)= ZERO
3221 DO IR=1,NPTR
3222 DO IS=1,NPTS
3223 LBUF => ELBUF_TAB(NG)%BUFLY(ILAY)%LBUF(IR,IS,IPT)
3224 DMAX(I) = ONE/PM(64,MATLY(J))
3225 WPMAX(I)= ONE/PM(41,MATLY(J))
3226 EPST1(I)= PM(60,MATLY(J))
3227 EPST2(I)= PM(61,MATLY(J))
3228 EPSF1(I)= ONE/PM(98,MATLY(J))
3229 EPSF2(I)= ONE/PM(99,MATLY(J))
3230C
3231 VG(1) = MAX(VG(1),LBUF%DMG(JJ(1)+I)*DMAX(I))
3232 VG(2) = MAX(VG(2),LBUF%DMG(JJ(2)+I)*DMAX(I))
3233 VG(3)= MAX(VG(3),ABS(LBUF%PLA(I))*WPMAX(I))
3234 IF(LBUF%CRAK(JJ(1)+I) > ZERO) VG(4)= MAX(VG(4),
3235 . (LBUF%CRAK(JJ(1)+I)+EPST1(I))*EPSF1(I))
3236 IF(LBUF%CRAK(JJ(2)+I) > ZERO )VG(5) = MAX(VG(5),
3237 . (LBUF%CRAK(JJ(2)+I)+EPST2(I))*EPSF2(I))
3238 ENDDO
3239 ENDDO
3240 VLY(1) =VLY(1) + VG(1)
3241 VLY(2) =VLY(2) + VG(2)
3242 VLY(3) =VLY(3) + VG(3)
3243 VLY(4) =VLY(4) + VG(4)
3244 VLY(5) =VLY(5) + VG(5)
3245C
3246 VALUE(I) = MAX(VALUE(I),VLY(1),VLY(2),VLY(3),VLY(4),VLY(5))
3247 IS_WRITTEN_VALUE(I) = 1
3248 ENDIF
3249 ENDDO ! I=1,JLT
3250 ENDIF
3251c ILAYER=IL NPT=NULL
3252.AND. ELSEIF ( ILAY <= NLAY ILAY > 0) THEN
3253 IPT = 1
3254.OR..OR..OR. IF (IGTYP == 10 IGTYP == 11 IGTYP == 16 IGTYP == 17) THEN
3255 DO I=1,NEL
3256 DMGMX = ZERO
3257 DO IR = 1,NPTR
3258 DO IS = 1,NPTS
3259 FBUF => ELBUF_TAB(NG)%BUFLY(ILAY)%FAIL(IR,IS,1)
3260 DO IFAIL = 1,ELBUF_TAB(NG)%BUFLY(ILAY)%NFAIL
3261 DMGMX = MAX(DMGMX,FBUF%FLOC(IFAIL)%DAMMX(I))
3262 IS_WRITTEN_VALUE(I) = 1
3263 ENDDO
3264 ENDDO
3265 ENDDO
3266 VALUE(I) = VALUE(I) + DMGMX
3267 ENDDO ! I=1,NEL
3268 !< Check damage for law 25
3269 DO I=1,NEL
3270 K1 = 2*I-1
3271 K2 = 2*I
3272 BUFLY => ELBUF_TAB(NG)%BUFLY(ILAY)
3273 IADR = (IPT - 1)*NEL
3274 J = IADR + I
3275 MLW_LAY = MATPARAM(MATLY(J))%ILAW
3276 IF (MLW_LAY == 25) THEN
3277 VLY(1:5) = ZERO
3278 VG(1:5)= ZERO
3279 DO IR=1,NPTR
3280 DO IS=1,NPTS
3281 LBUF => ELBUF_TAB(NG)%BUFLY(ILAY)%LBUF(IR,IS,1)
3282 DMAX(I) = ONE/PM(64,MATLY(J))
3283 WPMAX(I)= ONE/PM(41,MATLY(J))
3284 EPST1(I)= PM(60,MATLY(J))
3285 EPST2(I)= PM(61,MATLY(J))
3286 EPSF1(I)= ONE/PM(98,MATLY(J))
3287 EPSF2(I)= ONE/PM(99,MATLY(J))
3288C
3289 VG(1) = MAX(VG(1),LBUF%DMG(JJ(1)+I)*DMAX(I))
3290 VG(2) = MAX(VG(2),LBUF%DMG(JJ(2)+I)*DMAX(I))
3291 VG(3)= MAX(VG(3),ABS(LBUF%PLA(I))*WPMAX(I))
3292 IF(LBUF%CRAK(JJ(1)+I) > ZERO) VG(4)= MAX(VG(4),
3293 . (LBUF%CRAK(JJ(1)+I)+EPST1(I))*EPSF1(I))
3294 IF(LBUF%CRAK(JJ(2)+I) > ZERO )VG(5) = MAX(VG(5),
3295 . (LBUF%CRAK(JJ(2)+I)+EPST2(I))*EPSF2(I))
3296 ENDDO
3297 ENDDO
3298 VLY(1) =VLY(1) + VG(1)
3299 VLY(2) =VLY(2) + VG(2)
3300 VLY(3) =VLY(3) + VG(3)
3301 VLY(4) =VLY(4) + VG(4)
3302 VLY(5) =VLY(5) + VG(5)
3303 VLY(1) =VLY(1)/NPTT
3304 VLY(2) =VLY(2)/NPTT
3305 VLY(3) =VLY(3)/NPTT
3306 VLY(4) =VLY(4)/NPTT
3307 VLY(5) =VLY(5)/NPTT
3308C
3309 VALUE(I) = MAX(VALUE(I),VLY(1),VLY(2),VLY(3),
3310 . VLY(4),VLY(5))
3311 IS_WRITTEN_VALUE(I) = 1
3312 ENDIF
3313 ENDDO ! I=1,JLT
3314
3315.OR. ELSEIF (IGTYP == 51 IGTYP == 52) THEN
3316 NPTT = ELBUF_TAB(NG)%BUFLY(ILAY)%NPTT
3317 DO I=1,NEL
3318 DO IT = 1,NPTT
3319 DMGMX = ZERO
3320 DO IR = 1,NPTR
3321 DO IS = 1,NPTS
3322 FBUF => ELBUF_TAB(NG)%BUFLY(ILAY)%FAIL(IR,IS,IT)
3323 DO IFAIL = 1,ELBUF_TAB(NG)%BUFLY(ILAY)%NFAIL
3324 DMGMX = MAX(DMGMX,FBUF%FLOC(IFAIL)%DAMMX(I))
3325 ENDDO
3326 ENDDO
3327 ENDDO
3328 VALUE(I) = VALUE(I) + DMGMX
3329 IS_WRITTEN_VALUE(I) = 1
3330 ENDDO ! DO IT = 1,NPTT
3331 VALUE(I) = VALUE(I) / NPTT
3332 ENDDO ! I=1,NEL
3333 !< Check damage for law 25
3334 DO I=1,NEL
3335 K1 = 2*I-1
3336 K2 = 2*I
3337 NPTT = ELBUF_TAB(NG)%BUFLY(ILAY)%NPTT
3338 BUFLY => ELBUF_TAB(NG)%BUFLY(ILAY)
3339 IADR = (IPT - 1)*NEL
3340 J = IADR + I
3341 MLW_LAY = MATPARAM(MATLY(J))%ILAW
3342 IF (MLW_LAY == 25) THEN
3343 VLY(1:5) = ZERO
3344 DO IT=1,NPTT
3345 VG(1:5)= ZERO
3346 DO IR=1,NPTR
3347 DO IS=1,NPTS
3348 LBUF => ELBUF_TAB(NG)%BUFLY(ILAY)%LBUF(IR,IS,IT)
3349 DMAX(I) = ONE/PM(64,MATLY(J))
3350 WPMAX(I)= ONE/PM(41,MATLY(J))
3351 EPST1(I)= PM(60,MATLY(J))
3352 EPST2(I)= PM(61,MATLY(J))
3353 EPSF1(I)= ONE/PM(98,MATLY(J))
3354 EPSF2(I)= ONE/PM(99,MATLY(J))
3355C
3356 VG(1) = MAX(VG(1),LBUF%DMG(JJ(1)+I)*DMAX(I))
3357 VG(2) = MAX(VG(2),LBUF%DMG(JJ(2)+I)*DMAX(I))
3358 VG(3)= MAX(VG(3),ABS(LBUF%PLA(I))*WPMAX(I))
3359 IF(LBUF%CRAK(JJ(1)+I) > ZERO) VG(4)= MAX(VG(4),
3360 . (LBUF%CRAK(JJ(1)+I)+EPST1(I))*EPSF1(I))
3361 IF(LBUF%CRAK(JJ(2)+I) > ZERO )VG(5) = MAX(VG(5),
3362 . (LBUF%CRAK(JJ(2)+I)+EPST2(I))*EPSF2(I))
3363 ENDDO
3364 ENDDO
3365 VLY(1) =VLY(1) + VG(1)
3366 VLY(2) =VLY(2) + VG(2)
3367 VLY(3) =VLY(3) + VG(3)
3368 VLY(4) =VLY(4) + VG(4)
3369 VLY(5) =VLY(5) + VG(5)
3370 ENDDO ! NPTT
3371 VLY(1) =VLY(1)/NPTT
3372 VLY(2) =VLY(2)/NPTT
3373 VLY(3) =VLY(3)/NPTT
3374 VLY(4) =VLY(4)/NPTT
3375 VLY(5) =VLY(5)/NPTT
3376C
3377 VALUE(I) = MAX(VALUE(I),VLY(1),VLY(2),VLY(3),
3378 . VLY(4),VLY(5))
3379 IS_WRITTEN_VALUE(I) = 1
3380 ENDIF
3381 ENDDO ! I=1,JLT
3382 ENDIF
3383c NPT=IPT
3384.AND. ELSEIF ( IPT <= NPT IPT > 0) THEN
3385.OR. IF (IGTYP == 1 IGTYP == 9 ) THEN
3386 DO I=1,NEL
3387 DMGMX = ZERO
3388 DO IR = 1,NPTR
3389 DO IS = 1,NPTS
3390 FBUF => ELBUF_TAB(NG)%BUFLY(1)%FAIL(IR,IS,IPT)
3391 DO IFAIL = 1,ELBUF_TAB(NG)%BUFLY(1)%NFAIL
3392 DMGMX = MAX(DMGMX,FBUF%FLOC(IFAIL)%DAMMX(I))
3393 IS_WRITTEN_VALUE(I) = 1
3394 ENDDO
3395 ENDDO
3396 ENDDO
3397 VALUE(I) = VALUE(I) + DMGMX
3398 ENDDO ! I=1,NEL
3399 !< Check damage for law 25
3400 DO I=1,NEL
3401 K1 = 2*I-1
3402 K2 = 2*I
3403 BUFLY => ELBUF_TAB(NG)%BUFLY(1)
3404 IADR = (IPT - 1)*NEL
3405 J = IADR + I
3406 IF (MLW == 25) THEN
3407 VLY(1:5) = ZERO
3408 VG(1:5)= ZERO
3409 DO IR=1,NPTR
3410 DO IS=1,NPTS
3411 LBUF => ELBUF_TAB(NG)%BUFLY(1)%LBUF(IR,IS,IPT)
3412 DMAX(I) = ONE/PM(64,MID)
3413 WPMAX(I)= ONE/PM(41,MID)
3414 EPST1(I)= PM(60,MID)
3415 EPST2(I)= PM(61,MID)
3416 EPSF1(I)= ONE/PM(98,MID)
3417 EPSF2(I)= ONE/PM(99,MID)
3418C
3419 VG(1) = MAX(VG(1),LBUF%DMG(JJ(1)+I)*DMAX(I))
3420 VG(2) = MAX(VG(2),LBUF%DMG(JJ(2)+I)*DMAX(I))
3421 VG(3)= MAX(VG(3),ABS(LBUF%PLA(I))*WPMAX(I))
3422 IF(LBUF%CRAK(JJ(1)+I) > ZERO) VG(4)= MAX(VG(4),
3423 . (LBUF%CRAK(JJ(1)+I)+EPST1(I))*EPSF1(I))
3424 IF(LBUF%CRAK(JJ(2)+I) > ZERO )VG(5) = MAX(VG(5),
3425 . (LBUF%CRAK(JJ(2)+I)+EPST2(I))*EPSF2(I))
3426 ENDDO
3427 ENDDO
3428 VLY(1) =VLY(1) + VG(1)
3429 VLY(2) =VLY(2) + VG(2)
3430 VLY(3) =VLY(3) + VG(3)
3431 VLY(4) =VLY(4) + VG(4)
3432 VLY(5) =VLY(5) + VG(5)
3433 VLY(1) =VLY(1)/NPTT
3434 VLY(2) =VLY(2)/NPTT
3435 VLY(3) =VLY(3)/NPTT
3436 VLY(4) =VLY(4)/NPTT
3437 VLY(5) =VLY(5)/NPTT
3438C
3439 VALUE(I) = MAX(VALUE(I),VLY(1),VLY(2),VLY(3),
3440 . VLY(4),VLY(5))
3441 IS_WRITTEN_VALUE(I) = 1
3442 ENDIF
3443 ENDDO ! I=1,JLT
3444 ENDIF
3445 ENDIF
3446C--------------------------------------------------
3447 ELSE IF (KEYWORD == 'dama/memb') THEN
3448C--------------------------------------------------
3449 IPT = IABS(NPT)/2 + 1
3450c
3451 IF(IFAILURE > 0) THEN
3452 IF (NLAY > 1) THEN
3453 NPTT = ELBUF_TAB(NG)%BUFLY(IPT)%NPTT
3454 DO I=1,NEL
3455 DO IT = 1,NPTT
3456 DMGMX = ZERO
3457 DO IR = 1,NPTR
3458 DO IS = 1,NPTS
3459 FBUF => ELBUF_TAB(NG)%BUFLY(IPT)%FAIL(IR,IS,IT)
3460 DO IFAIL = 1,ELBUF_TAB(NG)%BUFLY(IPT)%NFAIL
3461 VALUE(I) = MAX(VALUE(I),FBUF%FLOC(IFAIL)%DAMMX(I))
3462 IS_WRITTEN_VALUE(I) = 1
3463 ENDDO
3464 ENDDO
3465 ENDDO
3466 VALUE(I) = VALUE(I) + DMGMX
3467 ENDDO ! DO IT = 1,NPTT
3468 VALUE(I) = VALUE(I) / NPTT
3469 ENDDO ! I=1,NEL
3470 ELSEIF (MPT > 0) THEN ! NLAY = 1
3471 DO I=1,NEL
3472 DO IR = 1, NPTR
3473 DO IS = 1, NPTS
3474 FBUF => ELBUF_TAB(NG)%BUFLY(1)%FAIL(IR,IS,IPT)
3475 DO IFAIL = 1, ELBUF_TAB(NG)%BUFLY(1)%NFAIL
3476 VALUE(I) = MAX(VALUE(I), FBUF%FLOC(IFAIL)%DAMMX(I))
3477 IS_WRITTEN_VALUE(I) = 1
3478 ENDDO
3479 ENDDO
3480 ENDDO
3481 ENDDO ! I=1,NEL
3482 ENDIF
3483 ENDIF ! IFAILURE
3484C
3485C for outp of dam inside law25
3486CMATLY
3487.OR..OR. IF (IGTYP == 10 IGTYP == 11
3488.OR..OR. . IGTYP == 17 IGTYP == 51 IGTYP == 52 ) THEN
3489 IF(ITY == 3)THEN
3490 DO I=1,NEL
3491 MAT(I)=IXC(1,NFT+I)
3492 PID(I)=IXC(6,NFT+I)
3493 END DO
3494 ELSE
3495 DO I=1,NEL
3496 MAT(I)=IXTG(1,NFT+I)
3497 PID(I)=IXTG(5,NFT+I)
3498 END DO
3499 END IF
3500 IF (IGTYP == 11) THEN
3501 IPMAT = 100
3502 DO N=1,NPT
3503 IADR = (N-1)*NEL
3504 DO I=1,NEL
3505 J = IADR+I
3506 MATLY(J) = IGEO(IPMAT+N,PID(I))
3507 END DO
3508 END DO
3509 ELSEIF (IGTYP == 10) THEN
3510 DO N=1,NPT
3511 IADR = (N-1)*NEL
3512 DO I=1,NEL
3513 J = IADR+I
3514 MATLY(J)=MAT(I)
3515 END DO
3516 END DO
3517.OR..OR. ELSEIF (IGTYP == 17 IGTYP == 51 IGTYP == 52) THEN
3518 IPMAT = 2 + NLAY
3519 DO N=1,NLAY
3520 IADR = (N-1)*NEL
3521 DO I=1,NEL
3522 J = IADR+I
3523 MATLY(J) = STACK%IGEO(IPMAT+N,ISUBSTACK)
3524 END DO
3525 END DO
3526 END IF
3527C
3528.AND. IF(MPT >= IPT IPT > 0) THEN
3529!! DO IL=1,NLAY ! we are in the case IL=IPT
3530 DO I=1,NEL
3531 K1 = 2*I-1
3532 K2 = 2*I
3533 NPTT = ELBUF_TAB(NG)%BUFLY(IPT)%NPTT
3534 BUFLY => ELBUF_TAB(NG)%BUFLY(IPT)
3535 IADR = (IPT - 1)*NEL
3536 J = IADR + I
3537 MLW_LAY = MATPARAM(MATLY(J))%ILAW
3538 IF (MLW_LAY == 25) THEN
3539 VLY(1:5) = ZERO
3540 DO IT=1,NPTT
3541 VG(1:5)= ZERO
3542 DO IR=1,NPTR
3543 DO IS=1,NPTS
3544 LBUF => ELBUF_TAB(NG)%BUFLY(IPT)%LBUF(IR,IS,IT)
3545 DMAX(I) = ONE/PM(64,MATLY(J))
3546 WPMAX(I)= ONE/PM(41,MATLY(J))
3547 EPST1(I)= PM(60,MATLY(J))
3548 EPST2(I)= PM(61,MATLY(J))
3549 EPSF1(I)= ONE/PM(98,MATLY(J))
3550 EPSF2(I)= ONE/PM(99,MATLY(J))
3551C
3552 VG(1) = MAX(VG(1),LBUF%DMG(JJ(1)+I)*DMAX(I))
3553 VG(2) = MAX(VG(2),LBUF%DMG(JJ(2)+I)*DMAX(I))
3554 VG(3)= MAX(VG(3),ABS(LBUF%PLA(I))*WPMAX(I))
3555 IF(LBUF%CRAK(JJ(1)+I) > ZERO) VG(4)= MAX(VG(4),
3556 . (LBUF%CRAK(JJ(1)+I)+EPST1(I))*EPSF1(I))
3557 IF(LBUF%CRAK(JJ(2)+I) > ZERO )VG(5) = MAX(VG(5),
3558 . (LBUF%CRAK(JJ(2)+I)+EPST2(I))*EPSF2(I))
3559 ENDDO
3560 ENDDO
3561 VLY(1) =VLY(1) + VG(1)
3562 VLY(2) =VLY(2) + VG(2)
3563 VLY(3) =VLY(3) + VG(3)
3564 VLY(4) =VLY(4) + VG(4)
3565 VLY(5) =VLY(5) + VG(5)
3566 ENDDO ! NPTT
3567 VLY(1) =VLY(1)/NPTT
3568 VLY(2) =VLY(2)/NPTT
3569 VLY(3) =VLY(3)/NPTT
3570 VLY(4) =VLY(4)/NPTT
3571 VLY(5) =VLY(5)/NPTT
3572C
3573 VALUE(I) = MAX(VALUE(I),VLY(1),VLY(2),VLY(3),VLY(4),VLY(5))
3574 IS_WRITTEN_VALUE(I) = 1
3575 ENDIF
3576 ENDDO ! I=1,JLT
3577 ENDIF
3578 ENDIF ! law 25 + SHell Composite PID
3579C--------------------------------------------------
3580 ELSE IF (KEYWORD == 'failure') THEN
3581C--------------------------------------------------
3582c
3583 !< Check if the variable can be lightened
3584 IS_LIGHTER = .TRUE.
3585c
3586 IF (MODE == -1) THEN
3587c IPLY=NULL ILAYER=NULL NPT=NULL
3588.AND..AND. IF ( ILAY == -1 IPT == -1 IPLY == -1) THEN
3589 IF(IFAILURE > 0) THEN
3590 IF (NLAY > 1) THEN
3591 DO I=1,NEL
3592 NLAY_FAIL = 0
3593 DO N = 1,NLAY
3594 NPTT = ELBUF_TAB(NG)%BUFLY(N)%NPTT
3595 DO IT = 1,NPTT
3596 DO IR = 1,NPTR
3597 DO IS = 1,NPTS
3598 FBUF => ELBUF_TAB(NG)%BUFLY(N)%FAIL(IR,IS,IT)
3599 DMGMX = ZERO
3600 DO IFAIL = 1,ELBUF_TAB(NG)%BUFLY(N)%NFAIL
3601 IF (FBUF%FLOC(IFAIL)%IDFAIL == ID) THEN
3602 DMGMX = FBUF%FLOC(IFAIL)%DAMMX(I)
3603 IS_WRITTEN_VALUE(I) = 1
3604 NLAY_FAIL = NLAY_FAIL + 1
3605 ENDIF
3606 ENDDO
3607 VALUE(I) = VALUE(I) + DMGMX/(NPTT*NPTS*NPTR)
3608 ENDDO
3609 ENDDO
3610 ENDDO ! DO IT = 1,NPTT
3611 ENDDO ! N=1,NLAY
3612 VALUE(I) = VALUE(I) / NLAY_FAIL
3613 ENDDO
3614 ELSEIF (MPT > 0) THEN ! NLAY = 1
3615 NPTT = ELBUF_TAB(NG)%BUFLY(1)%NPTT
3616 DO I=1,NEL
3617 DO IT = 1,NPTT
3618 DO IR = 1,NPTR
3619 DO IS = 1,NPTS
3620 FBUF => ELBUF_TAB(NG)%BUFLY(1)%FAIL(IR,IS,IT)
3621 DMGMX = ZERO
3622 DO IFAIL = 1,ELBUF_TAB(NG)%BUFLY(1)%NFAIL
3623 IF (FBUF%FLOC(IFAIL)%IDFAIL == ID) THEN
3624 DMGMX = FBUF%FLOC(IFAIL)%DAMMX(I)
3625 IS_WRITTEN_VALUE(I) = 1
3626 ENDIF
3627 ENDDO
3628 VALUE(I) = VALUE(I) + DMGMX/(NPTT*NPTS*NPTR)
3629 ENDDO
3630 ENDDO
3631 ENDDO ! N=1,NPTT
3632 ENDDO ! I=1,NEL
3633 ENDIF
3634 ENDIF
3635.AND..AND. ELSEIF ( IPLY > 0 IPT <= MPT IPT > 0 ) THEN
3636c PLY=IPLY NPT=IPT
3637 IF (IFAILURE > 0) THEN
3638 DO J=1,NLAY
3639 NPTT = ELBUF_TAB(NG)%BUFLY(J)%NPTT
3640 ID_PLY = 0
3641.OR. IF (IGTYP == 17 IGTYP == 51) THEN
3642 ID_PLY = IGEO(1,STACK%IGEO(2+J,ISUBSTACK))
3643 ELSEIF (IGTYP == 52) THEN
3644 ID_PLY=PLY_INFO(1,STACK%IGEO(2+J,ISUBSTACK)-NUMSTACK)
3645 ENDIF
3646 IF (ID_PLY == IPLY )THEN
3647 IF (IPT <= NPTT) THEN
3648 DO I=1,NEL
3649 DO IR = 1, NPTR
3650 DO IS = 1, NPTS
3651 FBUF => ELBUF_TAB(NG)%BUFLY(J)%FAIL(IR,IS,IPT)
3652 DO IFAIL = 1,ELBUF_TAB(NG)%BUFLY(J)%NFAIL
3653 IF (FBUF%FLOC(IFAIL)%IDFAIL == ID) THEN
3654 VALUE(I) = VALUE(I) + FBUF%FLOC(IFAIL)%DAMMX(I)/(NPTR*NPTS)
3655 IS_WRITTEN_VALUE(I) = 1
3656 ENDIF
3657 ENDDO
3658 ENDDO
3659 ENDDO
3660 ENDDO
3661 ENDIF
3662 ENDIF
3663 ENDDO
3664 ENDIF
3665c
3666.AND. ELSEIF ( IPLY > 0 IPT == -1 ) THEN
3667c PLY=IPLY NPT=-1
3668 IF (IFAILURE > 0) THEN
3669 DO J=1,NLAY
3670 NPTT = ELBUF_TAB(NG)%BUFLY(J)%NPTT
3671 ID_PLY = 0
3672.OR. IF (IGTYP == 17 IGTYP == 51) THEN
3673 ID_PLY = IGEO(1,STACK%IGEO(2+J,ISUBSTACK))
3674 ELSEIF (IGTYP == 52) THEN
3675 ID_PLY=PLY_INFO(1,STACK%IGEO(2+J,ISUBSTACK)-NUMSTACK)
3676 ENDIF
3677 IF (ID_PLY == IPLY )THEN
3678 DO I=1,NEL
3679 DO IR = 1, NPTR
3680 DO IS = 1, NPTS
3681 DO IT = 1, NPTT
3682 FBUF => ELBUF_TAB(NG)%BUFLY(J)%FAIL(IR,IS,IT)
3683 DO IFAIL = 1,ELBUF_TAB(NG)%BUFLY(J)%NFAIL
3684 IF (FBUF%FLOC(IFAIL)%IDFAIL == ID) THEN
3685 VALUE(I) = VALUE(I) +
3686 . FBUF%FLOC(IFAIL)%DAMMX(I)/(NPTR*NPTS*NPTT)
3687 IS_WRITTEN_VALUE(I) = 1
3688 ENDIF
3689 ENDDO
3690 ENDDO
3691 ENDDO
3692 ENDDO
3693 ENDDO
3694 ENDIF
3695 ENDDO
3696 ENDIF
3697c
3698.AND. ELSEIF ( IPLY > 0 IPT == -4 ) THEN
3699 DO J=1,NLAY
3700 NPTT = ELBUF_TAB(NG)%BUFLY(J)%NPTT
3701 ID_PLY = 0
3702.OR. IF (IGTYP == 17 IGTYP == 51) THEN
3703 ID_PLY = IGEO(1,STACK%IGEO(2+J,ISUBSTACK))
3704 ELSEIF (IGTYP == 52) THEN
3705 ID_PLY=PLY_INFO(1,STACK%IGEO(2+J,ISUBSTACK)-NUMSTACK)
3706 ENDIF
3707 IF (ID_PLY == IPLY ) THEN
3708 IF (MOD(NPTT,2) == 0) THEN
3709 DO I=1,NEL
3710 DO IR = 1, NPTR
3711 DO IS = 1, NPTS
3712 FBUF1 => ELBUF_TAB(NG)%BUFLY(J)%FAIL(IR,IS,NINT(HALF*NPTT))
3713 FBUF2 => ELBUF_TAB(NG)%BUFLY(J)%FAIL(IR,IS,NINT(HALF*NPTT)+1)
3714 DMGMX = ZERO
3715 DO IFAIL = 1,ELBUF_TAB(NG)%BUFLY(J)%NFAIL
3716 IF (FBUF1%FLOC(IFAIL)%IDFAIL == ID) THEN
3717 DMGMX = HALF*(FBUF1%FLOC(IFAIL)%DAMMX(I) +
3718 . FBUF2%FLOC(IFAIL)%DAMMX(I))
3719 VALUE(I) = VALUE(I) + DMGMX/(NPTR*NPTS)
3720 IS_WRITTEN_VALUE(I) = 1
3721 ENDIF
3722 ENDDO
3723 ENDDO
3724 ENDDO
3725 ENDDO
3726 ELSE
3727 DO I=1,NEL
3728 DO IR = 1, NPTR
3729 DO IS = 1, NPTS
3730 FBUF => ELBUF_TAB(NG)%BUFLY(J)%FAIL(IR,IS,NINT(HALF*NPTT))
3731 DMGMX = ZERO
3732 DO IFAIL = 1,ELBUF_TAB(NG)%BUFLY(J)%NFAIL
3733 IF (FBUF%FLOC(IFAIL)%IDFAIL == ID) THEN
3734 DMGMX = FBUF%FLOC(IFAIL)%DAMMX(I)
3735 VALUE(I) = VALUE(I) + DMGMX/(NPTR*NPTS)
3736 IS_WRITTEN_VALUE(I) = 1
3737 ENDIF
3738 ENDDO
3739 ENDDO
3740 ENDDO
3741 ENDDO
3742 ENDIF
3743 ENDIF
3744 ENDDO
3745c
3746c ILAYER=ILAY NPT=IPT
3747.AND..AND..AND. ELSEIF (ILAY <= NLAY ILAY > 0 IPT <= MPT IPT > 0 ) THEN
3748 IF (IFAILURE > 0) THEN
3749.OR. IF (IGTYP == 51 IGTYP == 52) THEN
3750 NPTT = ELBUF_TAB(NG)%BUFLY(ILAY)%NPTT
3751 IF (IPT <= NPTT) THEN
3752 DO I=1,NEL
3753 DO IR = 1,NPTR
3754 DO IS = 1,NPTS
3755 FBUF => ELBUF_TAB(NG)%BUFLY(ILAY)%FAIL(IR,IS,IPT)
3756 DMGMX = ZERO
3757 DO IFAIL = 1,ELBUF_TAB(NG)%BUFLY(ILAY)%NFAIL
3758 IF (FBUF%FLOC(IFAIL)%IDFAIL == ID) THEN
3759 DMGMX = FBUF%FLOC(IFAIL)%DAMMX(I)
3760 IS_WRITTEN_VALUE(I) = 1
3761 ENDIF
3762 ENDDO
3763 VALUE(I) = VALUE(I) + DMGMX/(NPTR*NPTS)
3764 ENDDO
3765 ENDDO
3766 ENDDO ! I=1,NEL
3767 ENDIF
3768 ENDIF
3769 ENDIF
3770c ILAYER=IL NPT=NULL
3771.AND..AND. ELSEIF (ILAY <= NLAY ILAY > 0 IPT == -1) THEN
3772 IF (IFAILURE > 0) THEN
3773 IPT = 1
3774.OR..OR..OR. IF (IGTYP == 10 IGTYP == 11 IGTYP == 16 IGTYP == 17) THEN
3775 DO I=1,NEL
3776 DO IR = 1,NPTR
3777 DO IS = 1,NPTS
3778 FBUF => ELBUF_TAB(NG)%BUFLY(ILAY)%FAIL(IR,IS,1)
3779 DMGMX = ZERO
3780 DO IFAIL = 1,ELBUF_TAB(NG)%BUFLY(ILAY)%NFAIL
3781 IF (FBUF%FLOC(IFAIL)%IDFAIL == ID) THEN
3782 DMGMX = FBUF%FLOC(IFAIL)%DAMMX(I)
3783 IS_WRITTEN_VALUE(I) = 1
3784 ENDIF
3785 ENDDO
3786 VALUE(I) = VALUE(I) + DMGMX/(NPTR*NPTS)
3787 ENDDO
3788 ENDDO
3789 ENDDO ! I=1,NEL
3790c
3791.OR. ELSEIF (IGTYP == 51 IGTYP == 52) THEN
3792 NPTT = ELBUF_TAB(NG)%BUFLY(ILAY)%NPTT
3793 DO I=1,NEL
3794 DO IT = 1,NPTT
3795 DO IR = 1,NPTR
3796 DO IS = 1,NPTS
3797 FBUF => ELBUF_TAB(NG)%BUFLY(ILAY)%FAIL(IR,IS,IT)
3798 DMGMX = ZERO
3799 DO IFAIL = 1,ELBUF_TAB(NG)%BUFLY(ILAY)%NFAIL
3800 IF (FBUF%FLOC(IFAIL)%IDFAIL == ID) THEN
3801 DMGMX = FBUF%FLOC(IFAIL)%DAMMX(I)
3802 IS_WRITTEN_VALUE(I) = 1
3803 ENDIF
3804 ENDDO
3805 VALUE(I) = VALUE(I) + DMGMX/(NPTT*NPTR*NPTS)
3806 ENDDO
3807 ENDDO
3808 ENDDO ! DO IT = 1,NPTT
3809 ENDDO ! I=1,NEL
3810 ENDIF
3811 ENDIF
3812c NPT=IPT
3813.AND. ELSEIF ( IPT <= NPT IPT > 0) THEN
3814 IF (IFAILURE > 0) THEN
3815.OR. IF (IGTYP == 1 IGTYP == 9 ) THEN
3816 DO I=1,NEL
3817 DO IR = 1,NPTR
3818 DO IS = 1,NPTS
3819 FBUF => ELBUF_TAB(NG)%BUFLY(1)%FAIL(IR,IS,IPT)
3820 DMGMX = ZERO
3821 DO IFAIL = 1,ELBUF_TAB(NG)%BUFLY(1)%NFAIL
3822 IF (FBUF%FLOC(IFAIL)%IDFAIL == ID) THEN
3823 DMGMX = FBUF%FLOC(IFAIL)%DAMMX(I)
3824 IS_WRITTEN_VALUE(I) = 1
3825 ENDIF
3826 ENDDO
3827 VALUE(I) = VALUE(I) + DMGMX/(NPTR*NPTS)
3828 ENDDO
3829 ENDDO
3830 ENDDO ! I=1,NEL
3831 ENDIF
3832 ENDIF
3833c NPT=MEMB
3834 ELSEIF (IPT == -4) THEN
3835 IF (IFAILURE > 0) THEN
3836.OR. IF (IGTYP == 1 IGTYP == 9 ) THEN
3837 IF (MOD(NPT,2) == 0) THEN
3838 DO I = 1,NEL
3839 DO IR = 1,NPTR
3840 DO IS = 1,NPTS
3841 FBUF1 => ELBUF_TAB(NG)%BUFLY(1)%FAIL(IR,IS,NINT(HALF*NPT))
3842 FBUF2 => ELBUF_TAB(NG)%BUFLY(1)%FAIL(IR,IS,NINT(HALF*NPT)+1)
3843 DMGMX = ZERO
3844 DO IFAIL = 1,ELBUF_TAB(NG)%BUFLY(1)%NFAIL
3845 IF (FBUF1%FLOC(IFAIL)%IDFAIL == ID) THEN
3846 DMGMX = HALF*(FBUF1%FLOC(IFAIL)%DAMMX(I) +
3847 . FBUF2%FLOC(IFAIL)%DAMMX(I))
3848 IS_WRITTEN_VALUE(I) = 1
3849 ENDIF
3850 ENDDO
3851 VALUE(I) = VALUE(I) + DMGMX/(NPTR*NPTS)
3852 ENDDO
3853 ENDDO
3854 ENDDO
3855 ELSE
3856 DO I = 1,NEL
3857 DO IR = 1,NPTR
3858 DO IS = 1,NPTS
3859 FBUF => ELBUF_TAB(NG)%BUFLY(1)%FAIL(IR,IS,NINT(HALF*NPT))
3860 DMGMX = ZERO
3861 DO IFAIL = 1,ELBUF_TAB(NG)%BUFLY(1)%NFAIL
3862 IF (FBUF%FLOC(IFAIL)%IDFAIL == ID) THEN
3863 DMGMX = FBUF%FLOC(IFAIL)%DAMMX(I)
3864 IS_WRITTEN_VALUE(I) = 1
3865 ENDIF
3866 ENDDO
3867 VALUE(I) = VALUE(I) + DMGMX/(NPTR*NPTS)
3868 ENDDO
3869 ENDDO
3870 ENDDO
3871 ENDIF
3872 ENDIF
3873 ENDIF
3874 ENDIF
3875c
3876!============================================================================================
3877 ELSE
3878.AND..AND. IF (ILAY == -1 IPT == -1 IPLY == -1) THEN
3879 IF(IFAILURE > 0) THEN
3880 IF (NLAY > 1) THEN
3881 DO I=1,NEL
3882 NLAY_FAIL = 0
3883 DO N = 1,NLAY
3884 NPTT = ELBUF_TAB(NG)%BUFLY(N)%NPTT
3885 DO IT = 1,NPTT
3886 DO IR = 1,NPTR
3887 DO IS = 1,NPTS
3888 FBUF => ELBUF_TAB(NG)%BUFLY(N)%FAIL(IR,IS,IT)
3889 DMGMX = ZERO
3890 DO IFAIL = 1,ELBUF_TAB(NG)%BUFLY(N)%NFAIL
3891 IF (FBUF%FLOC(IFAIL)%IDFAIL == ID) THEN
3892 DMGMX = FBUF%FLOC(IFAIL)%DAMMX(NEL*MODE+I)
3893 IS_WRITTEN_VALUE(I) = 1
3894 NLAY_FAIL = NLAY_FAIL + 1
3895 ENDIF
3896 ENDDO
3897 VALUE(I) = VALUE(I) + DMGMX/(NPTT*NPTS*NPTR)
3898 ENDDO
3899 ENDDO
3900 ENDDO ! DO IT = 1,NPTT
3901 ENDDO ! N=1,NLAY
3902 VALUE(I) = VALUE(I) / NLAY_FAIL
3903 ENDDO
3904 ELSEIF (MPT > 0) THEN ! NLAY = 1
3905 NPTT = ELBUF_TAB(NG)%BUFLY(1)%NPTT
3906 DO I=1,NEL
3907 DO IT = 1,NPTT
3908 DO IR = 1,NPTR
3909 DO IS = 1,NPTS
3910 FBUF => ELBUF_TAB(NG)%BUFLY(1)%FAIL(IR,IS,IT)
3911 DMGMX = ZERO
3912 DO IFAIL = 1,ELBUF_TAB(NG)%BUFLY(1)%NFAIL
3913 IF (FBUF%FLOC(IFAIL)%IDFAIL == ID) THEN
3914 DMGMX = FBUF%FLOC(IFAIL)%DAMMX(NEL*MODE+I)
3915 IS_WRITTEN_VALUE(I) = 1
3916 ENDIF
3917 ENDDO
3918 VALUE(I) = VALUE(I) + DMGMX/(NPTT*NPTS*NPTR)
3919 ENDDO
3920 ENDDO
3921 ENDDO ! N=1,NPTT
3922 ENDDO ! I=1,NEL
3923 ENDIF
3924 ENDIF
3925.AND..AND. ELSEIF ( IPLY > 0 IPT <= MPT IPT > 0 ) THEN
3926c PLY=IPLY NPT=IPT
3927 IF (IFAILURE > 0) THEN
3928 DO J=1,NLAY
3929 NPTT = ELBUF_TAB(NG)%BUFLY(J)%NPTT
3930 ID_PLY = 0
3931.OR. IF (IGTYP == 17 IGTYP == 51) THEN
3932 ID_PLY = IGEO(1,STACK%IGEO(2+J,ISUBSTACK))
3933 ELSEIF (IGTYP == 52) THEN
3934 ID_PLY=PLY_INFO(1,STACK%IGEO(2+J,ISUBSTACK)-NUMSTACK)
3935 ENDIF
3936 IF (ID_PLY == IPLY )THEN
3937 IF (IPT <= NPTT) THEN
3938 DO I=1,NEL
3939 DO IR = 1, NPTR
3940 DO IS = 1, NPTS
3941 FBUF => ELBUF_TAB(NG)%BUFLY(J)%FAIL(IR,IS,IPT)
3942 DO IFAIL = 1,ELBUF_TAB(NG)%BUFLY(J)%NFAIL
3943 IF (FBUF%FLOC(IFAIL)%IDFAIL == ID) THEN
3944 VALUE(I) = VALUE(I) + FBUF%FLOC(IFAIL)%DAMMX(NEL*MODE+I)/(NPTR*NPTS)
3945 IS_WRITTEN_VALUE(I) = 1
3946 ENDIF
3947 ENDDO
3948 ENDDO
3949 ENDDO
3950 ENDDO
3951 ENDIF
3952 ENDIF
3953 ENDDO
3954 ENDIF
3955c
3956.AND. ELSEIF ( IPLY > 0 IPT == -1 ) THEN
3957c PLY=IPLY NPT=-1
3958 IF (IFAILURE > 0) THEN
3959 DO J=1,NLAY
3960 NPTT = ELBUF_TAB(NG)%BUFLY(J)%NPTT
3961 ID_PLY = 0
3962.OR. IF (IGTYP == 17 IGTYP == 51) THEN
3963 ID_PLY = IGEO(1,STACK%IGEO(2+J,ISUBSTACK))
3964 ELSEIF (IGTYP == 52) THEN
3965 ID_PLY=PLY_INFO(1,STACK%IGEO(2+J,ISUBSTACK)-NUMSTACK)
3966 ENDIF
3967 IF (ID_PLY == IPLY )THEN
3968 DO I=1,NEL
3969 DO IR = 1, NPTR
3970 DO IS = 1, NPTS
3971 DO IT = 1, NPTT
3972 FBUF => ELBUF_TAB(NG)%BUFLY(J)%FAIL(IR,IS,IT)
3973 DO IFAIL = 1,ELBUF_TAB(NG)%BUFLY(J)%NFAIL
3974 IF (FBUF%FLOC(IFAIL)%IDFAIL == ID) THEN
3975 VALUE(I) = VALUE(I) +
3976 . FBUF%FLOC(IFAIL)%DAMMX(NEL*MODE+I)/(NPTR*NPTS*NPTT)
3977 IS_WRITTEN_VALUE(I) = 1
3978 ENDIF
3979 ENDDO
3980 ENDDO
3981 ENDDO
3982 ENDDO
3983 ENDDO
3984 ENDIF
3985 ENDDO
3986 ENDIF
3987c
3988.AND. ELSEIF ( IPLY > 0 IPT == -4 ) THEN
3989 DO J=1,NLAY
3990 NPTT = ELBUF_TAB(NG)%BUFLY(J)%NPTT
3991 ID_PLY = 0
3992.OR. IF (IGTYP == 17 IGTYP == 51) THEN
3993 ID_PLY = IGEO(1,STACK%IGEO(2+J,ISUBSTACK))
3994 ELSEIF (IGTYP == 52) THEN
3995 ID_PLY=PLY_INFO(1,STACK%IGEO(2+J,ISUBSTACK)-NUMSTACK)
3996 ENDIF
3997 IF (ID_PLY == IPLY ) THEN
3998 IF (MOD(NPTT,2) == 0) THEN
3999 DO I=1,NEL
4000 DO IR = 1, NPTR
4001 DO IS = 1, NPTS
4002 FBUF1 => ELBUF_TAB(NG)%BUFLY(J)%FAIL(IR,IS,NINT(HALF*NPTT))
4003 FBUF2 => ELBUF_TAB(NG)%BUFLY(J)%FAIL(IR,IS,NINT(HALF*NPTT)+1)
4004 DMGMX = ZERO
4005 DO IFAIL = 1,ELBUF_TAB(NG)%BUFLY(J)%NFAIL
4006 IF (FBUF1%FLOC(IFAIL)%IDFAIL == ID) THEN
4007 DMGMX = HALF*(FBUF1%FLOC(IFAIL)%DAMMX(NEL*MODE+I) +
4008 . FBUF2%FLOC(IFAIL)%DAMMX(NEL*MODE+I))
4009 VALUE(I) = VALUE(I) + DMGMX/(NPTR*NPTS)
4010 IS_WRITTEN_VALUE(I) = 1
4011 ENDIF
4012 ENDDO
4013 ENDDO
4014 ENDDO
4015 ENDDO
4016 ELSE
4017 DO I=1,NEL
4018 DO IR = 1, NPTR
4019 DO IS = 1, NPTS
4020 FBUF => ELBUF_TAB(NG)%BUFLY(J)%FAIL(IR,IS,NINT(HALF*NPTT))
4021 DMGMX = ZERO
4022 DO IFAIL = 1,ELBUF_TAB(NG)%BUFLY(J)%NFAIL
4023 IF (FBUF%FLOC(IFAIL)%IDFAIL == ID) THEN
4024 DMGMX = FBUF%FLOC(IFAIL)%DAMMX(NEL*MODE+I)
4025 VALUE(I) = VALUE(I) + DMGMX/(NPTR*NPTS)
4026 IS_WRITTEN_VALUE(I) = 1
4027 ENDIF
4028 ENDDO
4029 ENDDO
4030 ENDDO
4031 ENDDO
4032 ENDIF
4033 ENDIF
4034 ENDDO
4035c
4036c ILAYER=ILAY NPT=IPT
4037.AND..AND..AND. ELSEIF (ILAY <= NLAY ILAY > 0 IPT <= MPT IPT > 0 ) THEN
4038 IF (IFAILURE > 0) THEN
4039.OR. IF (IGTYP == 51 IGTYP == 52) THEN
4040 NPTT = ELBUF_TAB(NG)%BUFLY(ILAY)%NPTT
4041 IF (IPT <= NPTT) THEN
4042 DO I=1,NEL
4043 DO IR = 1,NPTR
4044 DO IS = 1,NPTS
4045 FBUF => ELBUF_TAB(NG)%BUFLY(ILAY)%FAIL(IR,IS,IPT)
4046 DMGMX = ZERO
4047 DO IFAIL = 1,ELBUF_TAB(NG)%BUFLY(ILAY)%NFAIL
4048 IF (FBUF%FLOC(IFAIL)%IDFAIL == ID) THEN
4049 DMGMX = FBUF%FLOC(IFAIL)%DAMMX(NEL*MODE+I)
4050 IS_WRITTEN_VALUE(I) = 1
4051 ENDIF
4052 ENDDO
4053 VALUE(I) = VALUE(I) + DMGMX/(NPTR*NPTS)
4054 ENDDO
4055 ENDDO
4056 ENDDO ! I=1,NEL
4057 ENDIF
4058 ENDIF
4059 ENDIF
4060c ILAYER=IL NPT=NULL
4061.AND..AND. ELSEIF (ILAY <= NLAY ILAY > 0 IPT == -1) THEN
4062 IF (IFAILURE > 0) THEN
4063 IPT = 1
4064.OR..OR..OR. IF (IGTYP == 10 IGTYP == 11 IGTYP == 16 IGTYP == 17) THEN
4065 DO I=1,NEL
4066 DO IR = 1,NPTR
4067 DO IS = 1,NPTS
4068 FBUF => ELBUF_TAB(NG)%BUFLY(ILAY)%FAIL(IR,IS,1)
4069 DMGMX = ZERO
4070 DO IFAIL = 1,ELBUF_TAB(NG)%BUFLY(ILAY)%NFAIL
4071 IF (FBUF%FLOC(IFAIL)%IDFAIL == ID) THEN
4072 DMGMX = FBUF%FLOC(IFAIL)%DAMMX(NEL*MODE+I)
4073 IS_WRITTEN_VALUE(I) = 1
4074 ENDIF
4075 ENDDO
4076 VALUE(I) = VALUE(I) + DMGMX/(NPTR*NPTS)
4077 ENDDO
4078 ENDDO
4079 ENDDO ! I=1,NEL
4080c
4081.OR. ELSEIF (IGTYP == 51 IGTYP == 52) THEN
4082 NPTT = ELBUF_TAB(NG)%BUFLY(ILAY)%NPTT
4083 DO I=1,NEL
4084 DO IT = 1,NPTT
4085 DO IR = 1,NPTR
4086 DO IS = 1,NPTS
4087 FBUF => ELBUF_TAB(NG)%BUFLY(ILAY)%FAIL(IR,IS,IT)
4088 DMGMX = ZERO
4089 DO IFAIL = 1,ELBUF_TAB(NG)%BUFLY(ILAY)%NFAIL
4090 IF (FBUF%FLOC(IFAIL)%IDFAIL == ID) THEN
4091 DMGMX = FBUF%FLOC(IFAIL)%DAMMX(NEL*MODE+I)
4092 IS_WRITTEN_VALUE(I) = 1
4093 ENDIF
4094 ENDDO
4095 VALUE(I) = VALUE(I) + DMGMX/(NPTT*NPTR*NPTS)
4096 ENDDO
4097 ENDDO
4098 ENDDO ! DO IT = 1,NPTT
4099 ENDDO ! I=1,NEL
4100 ENDIF
4101 ENDIF
4102c NPT=IPT
4103.AND. ELSEIF ( IPT <= NPT IPT > 0) THEN
4104 IF (IFAILURE > 0) THEN
4105.OR. IF (IGTYP == 1 IGTYP == 9 ) THEN
4106 DO I=1,NEL
4107 DO IR = 1,NPTR
4108 DO IS = 1,NPTS
4109 FBUF => ELBUF_TAB(NG)%BUFLY(1)%FAIL(IR,IS,IPT)
4110 DMGMX = ZERO
4111 DO IFAIL = 1,ELBUF_TAB(NG)%BUFLY(1)%NFAIL
4112 IF (FBUF%FLOC(IFAIL)%IDFAIL == ID) THEN
4113 DMGMX = FBUF%FLOC(IFAIL)%DAMMX(NEL*MODE+I)
4114 IS_WRITTEN_VALUE(I) = 1
4115 ENDIF
4116 ENDDO
4117 VALUE(I) = VALUE(I) + DMGMX/(NPTR*NPTS)
4118 ENDDO
4119 ENDDO
4120 ENDDO ! I=1,NEL
4121 ENDIF
4122 ENDIF
4123c NPT=MEMB
4124 ELSEIF (IPT == -4) THEN
4125 IF (IFAILURE > 0) THEN
4126.OR. IF (IGTYP == 1 IGTYP == 9 ) THEN
4127 IF (MOD(NPT,2) == 0) THEN
4128 DO I = 1,NEL
4129 DO IR = 1,NPTR
4130 DO IS = 1,NPTS
4131 FBUF1 => ELBUF_TAB(NG)%BUFLY(1)%FAIL(IR,IS,NINT(HALF*NPT))
4132 FBUF2 => ELBUF_TAB(NG)%BUFLY(1)%FAIL(IR,IS,NINT(HALF*NPT)+1)
4133 DMGMX = ZERO
4134 DO IFAIL = 1,ELBUF_TAB(NG)%BUFLY(1)%NFAIL
4135 IF (FBUF1%FLOC(IFAIL)%IDFAIL == ID) THEN
4136 DMGMX = HALF*(FBUF1%FLOC(IFAIL)%DAMMX(NEL*MODE+I) +
4137 . FBUF2%FLOC(IFAIL)%DAMMX(NEL*MODE+I))
4138 IS_WRITTEN_VALUE(I) = 1
4139 ENDIF
4140 ENDDO
4141 VALUE(I) = VALUE(I) + DMGMX/(NPTR*NPTS)
4142 ENDDO
4143 ENDDO
4144 ENDDO
4145 ELSE
4146 DO I = 1,NEL
4147 DO IR = 1,NPTR
4148 DO IS = 1,NPTS
4149 FBUF => ELBUF_TAB(NG)%BUFLY(1)%FAIL(IR,IS,NINT(HALF*NPT))
4150 DMGMX = ZERO
4151 DO IFAIL = 1,ELBUF_TAB(NG)%BUFLY(1)%NFAIL
4152 IF (FBUF%FLOC(IFAIL)%IDFAIL == ID) THEN
4153 DMGMX = FBUF%FLOC(IFAIL)%DAMMX(NEL*MODE+I)
4154 IS_WRITTEN_VALUE(I) = 1
4155 ENDIF
4156 ENDDO
4157 VALUE(I) = VALUE(I) + DMGMX/(NPTR*NPTS)
4158 ENDDO
4159 ENDDO
4160 ENDDO
4161 ENDIF
4162 ENDIF
4163 ENDIF
4164 ENDIF
4165!============================================================================================
4166 ENDIF
4167C--------------------------------------------------
4168 ELSEIF (KEYWORD == 'damg/memb') THEN
4169C--------------------------------------------------
4170c
4171 ! Output only if global damage flag is activated
4172 IF (GBUF%G_DMG > 0) THEN
4173c
4174 ! Resetting values
4175 DO I = 1,NEL
4176 VALUE(I) = ZERO
4177 ENDDO
4178c
4179 ! Multilayer properties TYPE 10/11/16/17/51/52
4180 IF (NLAY > 1) THEN
4181 IPT = IABS(NLAY)/2 + 1
4182 IF (ELBUF_TAB(NG)%BUFLY(IPT)%L_DMG > 0) THEN
4183 NPTT = ELBUF_TAB(NG)%BUFLY(IPT)%NPTT
4184 DO I = 1,NEL
4185 DO IT = 1,NPTT
4186 DO IR = 1,NPTR
4187 DO IS = 1,NPTS
4188 LBUF => ELBUF_TAB(NG)%BUFLY(IPT)%LBUF(IR,IS,IT)
4189 VALUE(I) = VALUE(I) + LBUF%DMG(I)/(NPTR*NPTS*NPTT)
4190 ENDDO
4191 ENDDO
4192 ENDDO
4193 IS_WRITTEN_VALUE(I) = 1
4194 ENDDO
4195 ENDIF
4196 ! Single layer properties TYPE 1/9
4197 ELSEIF (MPT > 0) THEN
4198 IPT = IABS(NPT)/2 + 1
4199 IF (ELBUF_TAB(NG)%BUFLY(1)%L_DMG > 0) THEN
4200 DO I = 1,NEL
4201 DO IR = 1, NPTR
4202 DO IS = 1, NPTS
4203 LBUF => ELBUF_TAB(NG)%BUFLY(1)%LBUF(IR,IS,IPT)
4204 VALUE(I) = VALUE(I) + LBUF%DMG(I)/(NPTR*NPTS)
4205 ENDDO
4206 ENDDO
4207 IS_WRITTEN_VALUE(I) = 1
4208 ENDDO
4209 ENDIF
4210 ENDIF
4211 ENDIF
4212C--------------------------------------------------
4213 ELSEIF (KEYWORD == 'damg') THEN
4214C--------------------------------------------------
4215c
4216 ! Check if the variable can be lightened
4217 IS_LIGHTER = .TRUE.
4218c
4219 ! Output only if global damage flag is activated
4220 IF (GBUF%G_DMG > 0) THEN
4221c
4222 ! Resetting values
4223 DO I = 1,NEL
4224 VALUE(I) = ZERO
4225 ENDDO
4226c
4227 ! If no MODE is requested
4228 IF (MODE == -1) THEN
4229 ! If no specific input PLY=null LAYER=null NPT=null
4230.AND..AND. IF (ILAY == -1 IPT == -1 IPLY == -1) THEN
4231 ! Multilayer properties TYPE 10/11/16/17/51/52
4232 ! -> Mean value among all layers and integration points
4233 IF (NLAY > 1) THEN
4234 DO I = 1,NEL
4235 DO N = 1,NLAY
4236 IMAT = ELBUF_TAB(NG)%BUFLY(N)%IMAT
4237 MAT_ID = MATPARAM(IMAT)%MAT_ID
4238.OR..AND. IF ((ID == -1) ((ID > 0)(MAT_ID == ID))) THEN
4239 IF (ELBUF_TAB(NG)%BUFLY(N)%L_DMG > 0) THEN
4240 NPTT = ELBUF_TAB(NG)%BUFLY(N)%NPTT
4241 DO IT = 1,NPTT
4242 DO IR = 1,NPTR
4243 DO IS = 1,NPTS
4244 LBUF => ELBUF_TAB(NG)%BUFLY(N)%LBUF(IR,IS,IT)
4245 VALUE(I) = VALUE(I) + LBUF%DMG(I)/(NPTT*NPTR*NPTS)
4246 ENDDO
4247 ENDDO
4248 ENDDO
4249 ENDIF
4250 IS_WRITTEN_VALUE(I) = 1
4251 ENDIF
4252 ENDDO
4253 VALUE(I) = VALUE(I) / NLAY
4254 ENDDO
4255 ! Single layer properties TYPE 1/9
4256 ! -> Mean value among all layers and integration points
4257 ELSEIF (MPT > 0) THEN
4258 IF (ELBUF_TAB(NG)%BUFLY(1)%L_DMG > 0) THEN
4259 NPTT = ELBUF_TAB(NG)%BUFLY(1)%NPTT
4260 IMAT = ELBUF_TAB(NG)%BUFLY(1)%IMAT
4261 MAT_ID = MATPARAM(IMAT)%MAT_ID
4262.OR..AND. IF ((ID == -1) ((ID > 0)(MAT_ID == ID))) THEN
4263 DO I = 1,NEL
4264 DO IT = 1,NPTT
4265 DO IR = 1,NPTR
4266 DO IS = 1,NPTS
4267 LBUF => ELBUF_TAB(NG)%BUFLY(1)%LBUF(IR,IS,IT)
4268 VALUE(I) = VALUE(I) + LBUF%DMG(I)/(NPTT*NPTR*NPTS)
4269 ENDDO
4270 ENDDO
4271 ENDDO
4272 IS_WRITTEN_VALUE(I) = 1
4273 ENDDO
4274 ENDIF
4275 ENDIF
4276 ENDIF
4277c
4278 ! If ply and int. point input: PLY=IPLY LAYER=null NPT=IPT
4279 ! -> Properties type 17/51/52 only
4280.AND..AND. ELSEIF (IPLY > 0 IPT <= MPT IPT > 0) THEN
4281 DO J = 1,NLAY
4282 IMAT = ELBUF_TAB(NG)%BUFLY(J)%IMAT
4283 MAT_ID = MATPARAM(IMAT)%MAT_ID
4284.OR..AND. IF ((ID == -1) ((ID > 0)(MAT_ID == ID))) THEN
4285 IF (ELBUF_TAB(NG)%BUFLY(J)%L_DMG > 0) THEN
4286 NPTT = ELBUF_TAB(NG)%BUFLY(J)%NPTT
4287 ID_PLY = 0
4288.OR. IF (IGTYP == 17 IGTYP == 51) THEN
4289 ID_PLY = IGEO(1,STACK%IGEO(2+J,ISUBSTACK))
4290 ELSEIF (IGTYP == 52) THEN
4291 ID_PLY = PLY_INFO(1,STACK%IGEO(2+J,ISUBSTACK)-NUMSTACK)
4292 ENDIF
4293 IF (ID_PLY == IPLY) THEN
4294 IF (IPT <= NPTT) THEN
4295 DO I = 1,NEL
4296 DO IR = 1,NPTR
4297 DO IS = 1,NPTS
4298 LBUF => ELBUF_TAB(NG)%BUFLY(J)%LBUF(IR,IS,IPT)
4299 VALUE(I) = VALUE(I) + LBUF%DMG(I)/(NPTR*NPTS)
4300 ENDDO
4301 ENDDO
4302 IS_WRITTEN_VALUE(I) = 1
4303 ENDDO
4304 ENDIF
4305 ENDIF
4306 ENDIF
4307 ENDIF
4308 ENDDO
4309c
4310 ! If ply input only: PLY=IPLY LAYER=null NPT=null
4311 ! -> Properties type 17/51/52 only
4312.AND. ELSEIF (IPLY > 0 IPT == -1) THEN
4313 DO J = 1,NLAY
4314 IMAT = ELBUF_TAB(NG)%BUFLY(J)%IMAT
4315 MAT_ID = MATPARAM(IMAT)%MAT_ID
4316.OR..AND. IF ((ID == -1) ((ID > 0)(MAT_ID == ID))) THEN
4317 IF (ELBUF_TAB(NG)%BUFLY(J)%L_DMG > 0) THEN
4318 NPTT = ELBUF_TAB(NG)%BUFLY(J)%NPTT
4319 ID_PLY = 0
4320.OR. IF (IGTYP == 17 IGTYP == 51) THEN
4321 ID_PLY = IGEO(1,STACK%IGEO(2+J,ISUBSTACK))
4322 ELSEIF (IGTYP == 52) THEN
4323 ID_PLY = PLY_INFO(1,STACK%IGEO(2+J,ISUBSTACK)-NUMSTACK)
4324 ENDIF
4325 IF (ID_PLY == IPLY) THEN
4326 DO I = 1,NEL
4327 DO IR = 1,NPTR
4328 DO IS = 1,NPTS
4329 DO IT = 1,NPTT
4330 LBUF => ELBUF_TAB(NG)%BUFLY(J)%LBUF(IR,IS,IT)
4331 VALUE(I) = VALUE(I) + LBUF%DMG(I)/(NPTR*NPTS*NPTT)
4332 ENDDO
4333 ENDDO
4334 ENDDO
4335 IS_WRITTEN_VALUE(I) = 1
4336 ENDDO
4337 ENDIF
4338 ENDIF
4339 ENDIF
4340 ENDDO
4341c
4342 ! If ply input + membrane: PLY=IPLY LAYER=null NPT=MEMB
4343 ! -> Properties type 17/51/52 only
4344.AND. ELSEIF ( IPLY > 0 IPT == -4 ) THEN
4345 DO J=1,NLAY
4346 IMAT = ELBUF_TAB(NG)%BUFLY(J)%IMAT
4347 MAT_ID = MATPARAM(IMAT)%MAT_ID
4348.OR..AND. IF ((ID == -1) ((ID > 0)(MAT_ID == ID))) THEN
4349 IF (ELBUF_TAB(NG)%BUFLY(J)%L_DMG > 0) THEN
4350 NPTT = ELBUF_TAB(NG)%BUFLY(J)%NPTT
4351 ID_PLY = 0
4352.OR. IF (IGTYP == 17 IGTYP == 51) THEN
4353 ID_PLY = IGEO(1,STACK%IGEO(2+J,ISUBSTACK))
4354 ELSEIF (IGTYP == 52) THEN
4355 ID_PLY=PLY_INFO(1,STACK%IGEO(2+J,ISUBSTACK)-NUMSTACK)
4356 ENDIF
4357 IF (ID_PLY == IPLY ) THEN
4358 IF (MOD(NPTT,2) == 0) THEN
4359 DO I=1,NEL
4360 DO IR = 1, NPTR
4361 DO IS = 1, NPTS
4362 LBUF1 => ELBUF_TAB(NG)%BUFLY(J)%LBUF(IR,IS,NINT(HALF*NPTT))
4363 LBUF2 => ELBUF_TAB(NG)%BUFLY(J)%LBUF(IR,IS,NINT(HALF*NPTT)+1)
4364 VALUE(I) = VALUE(I) + HALF*(LBUF1%DMG(I) + LBUF2%DMG(I)
4365 . /(NPTR*NPTS))
4366 IS_WRITTEN_VALUE(I) = 1
4367 ENDDO
4368 ENDDO
4369 ENDDO
4370 ENDIF
4371 ELSE
4372 DO I=1,NEL
4373 DO IR = 1, NPTR
4374 DO IS = 1, NPTS
4375 LBUF => ELBUF_TAB(NG)%BUFLY(J)%LBUF(IR,IS,NINT(HALF*NPTT))
4376 VALUE(I) = VALUE(I) + LBUF%DMG(I)/(NPTR*NPTS)
4377 IS_WRITTEN_VALUE(I) = 1
4378 ENDDO
4379 ENDDO
4380 ENDDO
4381 ENDIF
4382 ENDIF
4383 ENDIF
4384 ENDDO
4385c
4386 ! If layer input : PLY=null LAYER=ILAY NPT=null/IPT
4387 ! -> Properties type 10/11/16 only
4388.AND. ELSEIF (ILAY <= NLAY ILAY > 0) THEN
4389 IPT = 1
4390.OR..OR. IF (IGTYP == 10 IGTYP == 11 IGTYP == 16) THEN
4391 IMAT = ELBUF_TAB(NG)%BUFLY(ILAY)%IMAT
4392 MAT_ID = MATPARAM(IMAT)%MAT_ID
4393.OR..AND. IF ((ID == -1) ((ID > 0)(MAT_ID == ID))) THEN
4394 IF (ELBUF_TAB(NG)%BUFLY(ILAY)%L_DMG > 0) THEN
4395 DO I=1,NEL
4396 DO IR = 1,NPTR
4397 DO IS = 1,NPTS
4398 LBUF => ELBUF_TAB(NG)%BUFLY(ILAY)%LBUF(IR,IS,1)
4399 VALUE(I) = VALUE(I) + LBUF%DMG(I)/(NPTR*NPTS)
4400 ENDDO
4401 ENDDO
4402 IS_WRITTEN_VALUE(I) = 1
4403 ENDDO
4404 ENDIF
4405 ENDIF
4406 ENDIF
4407c
4408 ! If intg. point input : PLY=null LAYER=null NPT=IPT
4409 ! -> Properties type 1/9 only
4410.AND. ELSEIF (IPT <= NPT IPT > 0) THEN
4411.OR. IF (IGTYP == 1 IGTYP == 9) THEN
4412 IMAT = ELBUF_TAB(NG)%BUFLY(1)%IMAT
4413 MAT_ID = MATPARAM(IMAT)%MAT_ID
4414.OR..AND. IF ((ID == -1) ((ID > 0)(MAT_ID == ID))) THEN
4415 IF (ELBUF_TAB(NG)%BUFLY(1)%L_DMG > 0) THEN
4416 DO I=1,NEL
4417 DO IR = 1,NPTR
4418 DO IS = 1,NPTS
4419 LBUF => ELBUF_TAB(NG)%BUFLY(1)%LBUF(IR,IS,IPT)
4420 VALUE(I) = VALUE(I) + LBUF%DMG(I)/(NPTR*NPTS)
4421 ENDDO
4422 ENDDO
4423 IS_WRITTEN_VALUE(I) = 1
4424 ENDDO
4425 ENDIF
4426 ENDIF
4427 ENDIF
4428c
4429 ELSEIF (IPT == -4) THEN
4430.OR. IF (IGTYP == 1 IGTYP == 9 ) THEN
4431 IMAT = ELBUF_TAB(NG)%BUFLY(1)%IMAT
4432 MAT_ID = MATPARAM(IMAT)%MAT_ID
4433.OR..AND. IF ((ID == -1) ((ID > 0)(MAT_ID == ID))) THEN
4434 IF (ELBUF_TAB(NG)%BUFLY(1)%L_DMG > 0) THEN
4435 IF (MOD(NPT,2) == 0) THEN
4436 DO I = 1,NEL
4437 DO IR = 1,NPTR
4438 DO IS = 1,NPTS
4439 LBUF1 => ELBUF_TAB(NG)%BUFLY(1)%LBUF(IR,IS,NINT(HALF*NPT))
4440 LBUF2 => ELBUF_TAB(NG)%BUFLY(1)%LBUF(IR,IS,NINT(HALF*NPT)+1)
4441 VALUE(I) = VALUE(I) + HALF*(LBUF1%DMG(I) + LBUF2%DMG(I))/(NPTR*NPTS)
4442 ENDDO
4443 ENDDO
4444 IS_WRITTEN_VALUE(I) = 1
4445 ENDDO
4446 ELSE
4447 DO I = 1,NEL
4448 DO IR = 1,NPTR
4449 DO IS = 1,NPTS
4450 LBUF => ELBUF_TAB(NG)%BUFLY(1)%LBUF(IR,IS,NINT(HALF*NPT))
4451 VALUE(I) = VALUE(I) + LBUF%DMG(I)/(NPTR*NPTS)
4452 ENDDO
4453 ENDDO
4454 IS_WRITTEN_VALUE(I) = 1
4455 ENDDO
4456 ENDIF
4457 ENDIF
4458 ENDIF
4459 ENDIF
4460 ENDIF
4461c
4462 ! If MODE is requested (MODE > 0) with a specific ID (ID > 0)
4463 ELSE
4464 ! If no specific input PLY=null LAYER=null NPT=null
4465.AND..AND. IF (ILAY == -1 IPT == -1 IPLY == -1) THEN
4466 ! Multilayer properties TYPE 10/11/16/17/51/52
4467 ! -> Mean value among all layers and integration points
4468 IF (NLAY > 1) THEN
4469 DO I = 1,NEL
4470 DO N = 1,NLAY
4471 IMAT = ELBUF_TAB(NG)%BUFLY(N)%IMAT
4472 NMOD = MATPARAM(IMAT)%NMOD
4473 MAT_ID = MATPARAM(IMAT)%MAT_ID
4474.AND..AND. IF ((NMOD > 0 MODE <= NMOD) (MAT_ID == ID)) THEN
4475 IF (ELBUF_TAB(NG)%BUFLY(N)%L_DMG > 0) THEN
4476 NPTT = ELBUF_TAB(NG)%BUFLY(N)%NPTT
4477 DO IT = 1,NPTT
4478 DO IR = 1,NPTR
4479 DO IS = 1,NPTS
4480 LBUF => ELBUF_TAB(NG)%BUFLY(N)%LBUF(IR,IS,IT)
4481 VALUE(I) = VALUE(I) + LBUF%DMG(NEL*MODE+I)/(NPTT*NPTR*NPTS)
4482 ENDDO
4483 ENDDO
4484 ENDDO
4485 ENDIF
4486 IS_WRITTEN_VALUE(I) = 1
4487 ENDIF
4488 ENDDO
4489 VALUE(I) = VALUE(I) / NLAY
4490 ENDDO
4491 ! Single layer properties TYPE 1/9
4492 ! -> Mean value among all layers and integration points
4493 ELSEIF (MPT > 0) THEN
4494 IMAT = ELBUF_TAB(NG)%BUFLY(1)%IMAT
4495 NMOD = MATPARAM(IMAT)%NMOD
4496 MAT_ID = MATPARAM(IMAT)%MAT_ID
4497.AND..AND. IF ((NMOD > 0 MODE <= NMOD) (MAT_ID == ID)) THEN
4498 IF (ELBUF_TAB(NG)%BUFLY(1)%L_DMG > 0) THEN
4499 NPTT = ELBUF_TAB(NG)%BUFLY(1)%NPTT
4500 DO I = 1,NEL
4501 DO IT = 1,NPTT
4502 DO IR = 1,NPTR
4503 DO IS = 1,NPTS
4504 LBUF => ELBUF_TAB(NG)%BUFLY(1)%LBUF(IR,IS,IT)
4505 VALUE(I) = VALUE(I) + LBUF%DMG(NEL*MODE+I)/(NPTT*NPTR*NPTS)
4506 ENDDO
4507 ENDDO
4508 ENDDO
4509 IS_WRITTEN_VALUE(I) = 1
4510 ENDDO
4511 ENDIF
4512 ENDIF
4513 ENDIF
4514c
4515 ! If ply and int. point input: PLY=IPLY LAYER=null NPT=IPT
4516 ! -> Properties type 17/51/52 only
4517.AND..AND. ELSEIF (IPLY > 0 IPT <= MPT IPT > 0) THEN
4518 DO J = 1,NLAY
4519 IMAT = ELBUF_TAB(NG)%BUFLY(J)%IMAT
4520 NMOD = MATPARAM(IMAT)%NMOD
4521 MAT_ID = MATPARAM(IMAT)%MAT_ID
4522.AND..AND. IF ((NMOD > 0 MODE <= NMOD) (MAT_ID == ID)) THEN
4523 IF (ELBUF_TAB(NG)%BUFLY(J)%L_DMG > 0) THEN
4524 NPTT = ELBUF_TAB(NG)%BUFLY(J)%NPTT
4525 ID_PLY = 0
4526.OR. IF (IGTYP == 17 IGTYP == 51) THEN
4527 ID_PLY = IGEO(1,STACK%IGEO(2+J,ISUBSTACK))
4528 ELSEIF (IGTYP == 52) THEN
4529 ID_PLY = PLY_INFO(1,STACK%IGEO(2+J,ISUBSTACK)-NUMSTACK)
4530 ENDIF
4531 IF (ID_PLY == IPLY) THEN
4532 IF (IPT <= NPTT) THEN
4533 DO I = 1,NEL
4534 DO IR = 1,NPTR
4535 DO IS = 1,NPTS
4536 LBUF => ELBUF_TAB(NG)%BUFLY(J)%LBUF(IR,IS,IPT)
4537 VALUE(I) = VALUE(I) + LBUF%DMG(NEL*MODE+I)/(NPTR*NPTS)
4538 ENDDO
4539 ENDDO
4540 IS_WRITTEN_VALUE(I) = 1
4541 ENDDO
4542 ENDIF
4543 ENDIF
4544 ENDIF
4545 ENDIF
4546 ENDDO
4547c
4548 ! If ply input only: PLY=IPLY LAYER=null NPT=null
4549 ! -> Properties type 17/51/52 only
4550.AND. ELSEIF (IPLY > 0 IPT == -1) THEN
4551 DO J = 1,NLAY
4552 IMAT = ELBUF_TAB(NG)%BUFLY(J)%IMAT
4553 NMOD = MATPARAM(IMAT)%NMOD
4554 MAT_ID = MATPARAM(IMAT)%MAT_ID
4555.AND..AND. IF ((NMOD > 0 MODE <= NMOD) (MAT_ID == ID)) THEN
4556 IF (ELBUF_TAB(NG)%BUFLY(J)%L_DMG > 0) THEN
4557 NPTT = ELBUF_TAB(NG)%BUFLY(J)%NPTT
4558 ID_PLY = 0
4559.OR. IF (IGTYP == 17 IGTYP == 51) THEN
4560 ID_PLY = IGEO(1,STACK%IGEO(2+J,ISUBSTACK))
4561 ELSEIF (IGTYP == 52) THEN
4562 ID_PLY = PLY_INFO(1,STACK%IGEO(2+J,ISUBSTACK)-NUMSTACK)
4563 ENDIF
4564 IF (ID_PLY == IPLY) THEN
4565 DO I = 1,NEL
4566 DO IR = 1,NPTR
4567 DO IS = 1,NPTS
4568 DO IT = 1,NPTT
4569 LBUF => ELBUF_TAB(NG)%BUFLY(J)%LBUF(IR,IS,IT)
4570 VALUE(I) = VALUE(I) + LBUF%DMG(NEL*MODE+I)/(NPTR*NPTS*NPTT)
4571 ENDDO
4572 ENDDO
4573 ENDDO
4574 IS_WRITTEN_VALUE(I) = 1
4575 ENDDO
4576 ENDIF
4577 ENDIF
4578 ENDIF
4579 ENDDO
4580c
4581 ! If ply input + membrane: PLY=IPLY LAYER=null NPT=MEMB
4582 ! -> Properties type 17/51/52 only
4583.AND. ELSEIF ( IPLY > 0 IPT == -4 ) THEN
4584 DO J=1,NLAY
4585 IMAT = ELBUF_TAB(NG)%BUFLY(J)%IMAT
4586 MAT_ID = MATPARAM(IMAT)%MAT_ID
4587.OR..AND. IF ((ID == -1) ((ID > 0)(MAT_ID == ID))) THEN
4588 IF (ELBUF_TAB(NG)%BUFLY(J)%L_DMG > 0) THEN
4589 NPTT = ELBUF_TAB(NG)%BUFLY(J)%NPTT
4590 ID_PLY = 0
4591.OR. IF (IGTYP == 17 IGTYP == 51) THEN
4592 ID_PLY = IGEO(1,STACK%IGEO(2+J,ISUBSTACK))
4593 ELSEIF (IGTYP == 52) THEN
4594 ID_PLY=PLY_INFO(1,STACK%IGEO(2+J,ISUBSTACK)-NUMSTACK)
4595 ENDIF
4596 IF (ID_PLY == IPLY ) THEN
4597 IF (MOD(NPTT,2) == 0) THEN
4598 DO I=1,NEL
4599 DO IR = 1, NPTR
4600 DO IS = 1, NPTS
4601 LBUF1 => ELBUF_TAB(NG)%BUFLY(J)%LBUF(IR,IS,NINT(HALF*NPTT))
4602 LBUF2 => ELBUF_TAB(NG)%BUFLY(J)%LBUF(IR,IS,NINT(HALF*NPTT)+1)
4603 VALUE(I) = VALUE(I) + HALF*(LBUF1%DMG(NEL*MODE+I) +
4604 . LBUF2%DMG(NEL*MODE+I)/(NPTR*NPTS))
4605 IS_WRITTEN_VALUE(I) = 1
4606 ENDDO
4607 ENDDO
4608 ENDDO
4609 ELSE
4610 DO I=1,NEL
4611 DO IR = 1, NPTR
4612 DO IS = 1, NPTS
4613 LBUF => ELBUF_TAB(NG)%BUFLY(J)%LBUF(IR,IS,NINT(HALF*NPTT))
4614 VALUE(I) = VALUE(I) + LBUF%DMG(NEL*MODE+I)/(NPTR*NPTS)
4615 IS_WRITTEN_VALUE(I) = 1
4616 ENDDO
4617 ENDDO
4618 ENDDO
4619 ENDIF
4620 ENDIF
4621 ENDIF
4622 ENDIF
4623 ENDDO
4624c
4625 ! If layer input : PLY=null LAYER=ILAY NPT=null/IPT
4626 ! -> Properties type 10/11/16 only
4627.AND. ELSEIF (ILAY <= NLAY ILAY > 0) THEN
4628 IPT = 1
4629.OR..OR. IF (IGTYP == 10 IGTYP == 11 IGTYP == 16) THEN
4630 IMAT = ELBUF_TAB(NG)%BUFLY(ILAY)%IMAT
4631 NMOD = MATPARAM(IMAT)%NMOD
4632 MAT_ID = MATPARAM(IMAT)%MAT_ID
4633.AND..AND. IF ((NMOD > 0 MODE <= NMOD) (MAT_ID == ID)) THEN
4634 IF (ELBUF_TAB(NG)%BUFLY(ILAY)%L_DMG > 0) THEN
4635 DO I=1,NEL
4636 DO IR = 1,NPTR
4637 DO IS = 1,NPTS
4638 LBUF => ELBUF_TAB(NG)%BUFLY(ILAY)%LBUF(IR,IS,1)
4639 VALUE(I) = VALUE(I) + LBUF%DMG(NEL*MODE+I)/(NPTR*NPTS)
4640 ENDDO
4641 ENDDO
4642 IS_WRITTEN_VALUE(I) = 1
4643 ENDDO
4644 ENDIF
4645 ENDIF
4646 ENDIF
4647c
4648 ! If intg. point input : PLY=null LAYER=null NPT=IPT
4649 ! -> Properties type 1/9 only
4650.AND. ELSEIF (IPT <= NPT IPT > 0) THEN
4651.OR. IF (IGTYP == 1 IGTYP == 9) THEN
4652 IMAT = ELBUF_TAB(NG)%BUFLY(1)%IMAT
4653 NMOD = MATPARAM(IMAT)%NMOD
4654 MAT_ID = MATPARAM(IMAT)%MAT_ID
4655.AND..AND. IF ((NMOD > 0 MODE <= NMOD) (MAT_ID == ID)) THEN
4656 IF (ELBUF_TAB(NG)%BUFLY(1)%L_DMG > 0) THEN
4657 DO I=1,NEL
4658 DO IR = 1,NPTR
4659 DO IS = 1,NPTS
4660 LBUF => ELBUF_TAB(NG)%BUFLY(1)%LBUF(IR,IS,IPT)
4661 VALUE(I) = VALUE(I) + LBUF%DMG(NEL*MODE+I)/(NPTR*NPTS)
4662 ENDDO
4663 ENDDO
4664 IS_WRITTEN_VALUE(I) = 1
4665 ENDDO
4666 ENDIF
4667 ENDIF
4668 ENDIF
4669c
4670 ELSEIF (IPT == -4) THEN
4671.OR. IF (IGTYP == 1 IGTYP == 9) THEN
4672 IMAT = ELBUF_TAB(NG)%BUFLY(1)%IMAT
4673 NMOD = MATPARAM(IMAT)%NMOD
4674 MAT_ID = MATPARAM(IMAT)%MAT_ID
4675.AND..AND. IF ((NMOD > 0 MODE <= NMOD) (MAT_ID == ID)) THEN
4676 IF (ELBUF_TAB(NG)%BUFLY(1)%L_DMG > 0) THEN
4677 IF (MOD(NPT,2) == 0) THEN
4678 DO I = 1,NEL
4679 DO IR = 1,NPTR
4680 DO IS = 1,NPTS
4681 LBUF1 => ELBUF_TAB(NG)%BUFLY(1)%LBUF(IR,IS,NINT(HALF*NPT))
4682 LBUF2 => ELBUF_TAB(NG)%BUFLY(1)%LBUF(IR,IS,NINT(HALF*NPT)+1)
4683 VALUE(I) = VALUE(I) + HALF*(LBUF1%DMG(NEL*MODE+I) +
4684 . LBUF2%DMG(NEL*MODE+I))/(NPTR*NPTS)
4685 ENDDO
4686 ENDDO
4687 IS_WRITTEN_VALUE(I) = 1
4688 ENDDO
4689 ELSE
4690 DO I = 1,NEL
4691 DO IR = 1,NPTR
4692 DO IS = 1,NPTS
4693 LBUF => ELBUF_TAB(NG)%BUFLY(1)%LBUF(IR,IS,NINT(HALF*NPT))
4694 VALUE(I) = VALUE(I) + LBUF%DMG(NEL*MODE+I)/(NPTR*NPTS)
4695 ENDDO
4696 ENDDO
4697 IS_WRITTEN_VALUE(I) = 1
4698 ENDDO
4699 ENDIF
4700 ENDIF
4701 ENDIF
4702 ENDIF
4703 ENDIF
4704 ENDIF
4705 ENDIF
4706C--------------------------------------------------
4707 ELSEIF (KEYWORD == 'damini') THEN
4708C--------------------------------------------------
4709 IF (IFAILURE > 0) THEN
4710c
4711 ! Resetting values
4712 DO I = 1,NEL
4713 VALUE(I) = ZERO
4714 ENDDO
4715c
4716c IPLY=NULL ILAYER=NULL NPT=NULL
4717.AND..AND. IF ( ILAY == -1 IPT == -1 IPLY == -1) THEN
4718 IF (NLAY > 1) THEN
4719 DO I=1,NEL
4720 DO N = 1,NLAY
4721 NPTT = ELBUF_TAB(NG)%BUFLY(N)%NPTT
4722 DO IT = 1,NPTT
4723 DO IR = 1,NPTR
4724 DO IS = 1,NPTS
4725 FBUF => ELBUF_TAB(NG)%BUFLY(N)%FAIL(IR,IS,IT)
4726 MAXDAMINI = ZERO
4727 DO IFAIL = 1,ELBUF_TAB(NG)%BUFLY(N)%NFAIL
4728 IF (FBUF%FLOC(IFAIL)%LF_DAMINI > 0) THEN
4729 MAXDAMINI = MAX(MAXDAMINI,FBUF%FLOC(IFAIL)%DAMINI(I))
4730 ENDIF
4731 ENDDO
4732 VALUE(I) = VALUE(I) + MAXDAMINI/(NPTT*NPTR*NPTS)
4733 ENDDO
4734 ENDDO
4735 ENDDO ! DO IT = 1,NPTT
4736 ENDDO ! N=1,NLAY
4737 VALUE(I) = VALUE(I) / NLAY
4738 IS_WRITTEN_VALUE(I) = 1
4739 ENDDO
4740 ELSEIF (MPT > 0) THEN ! NLAY = 1
4741 NPTT = ELBUF_TAB(NG)%BUFLY(1)%NPTT
4742 DO I = 1,NEL
4743 DO IT = 1,NPTT
4744 DO IR = 1,NPTR
4745 DO IS = 1,NPTS
4746 FBUF => ELBUF_TAB(NG)%BUFLY(1)%FAIL(IR,IS,IT)
4747 MAXDAMINI = ZERO
4748 DO IFAIL = 1,ELBUF_TAB(NG)%BUFLY(1)%NFAIL
4749 IF (FBUF%FLOC(IFAIL)%LF_DAMINI > 0) THEN
4750 MAXDAMINI = MAX(MAXDAMINI,FBUF%FLOC(IFAIL)%DAMINI(I))
4751 ENDIF
4752 ENDDO
4753 VALUE(I) = VALUE(I) + MAXDAMINI/(NPTT*NPTR*NPTS)
4754 ENDDO
4755 ENDDO
4756 ENDDO
4757 IS_WRITTEN_VALUE(I) = 1
4758 ENDDO
4759 ENDIF
4760c PLY=IPLY NPT=IPT
4761.AND..AND. ELSEIF ( IPLY > 0 IPT <= MPT IPT > 0 ) THEN
4762 DO J=1,NLAY
4763 NPTT = ELBUF_TAB(NG)%BUFLY(J)%NPTT
4764 ID_PLY = 0
4765.OR. IF (IGTYP == 17 IGTYP == 51) THEN
4766 ID_PLY = IGEO(1,STACK%IGEO(2+J,ISUBSTACK))
4767 ELSEIF (IGTYP == 52) THEN
4768 ID_PLY = PLY_INFO(1,STACK%IGEO(2+J,ISUBSTACK)-NUMSTACK)
4769 ENDIF
4770 IF (ID_PLY == IPLY) THEN
4771 IF (IPT <= NPTT) THEN
4772 DO I = 1,NEL
4773 DO IR = 1,NPTR
4774 DO IS = 1,NPTS
4775 FBUF => ELBUF_TAB(NG)%BUFLY(J)%FAIL(IR,IS,IPT)
4776 MAXDAMINI = ZERO
4777 DO IFAIL = 1, ELBUF_TAB(NG)%BUFLY(J)%NFAIL
4778 IF (FBUF%FLOC(IFAIL)%LF_DAMINI > 0) THEN
4779 MAXDAMINI = MAX(MAXDAMINI,FBUF%FLOC(IFAIL)%DAMINI(I))
4780 ENDIF
4781 ENDDO
4782 VALUE(I) = VALUE(I) + MAXDAMINI/(NPTR*NPTS)
4783 ENDDO
4784 ENDDO
4785 IS_WRITTEN_VALUE(I) = 1
4786 ENDDO
4787 ENDIF
4788 ENDIF
4789 ENDDO
4790c PLY=IPLY NPT=-1
4791.AND. ELSEIF ( IPLY > 0 IPT == -1 ) THEN
4792 DO J = 1,NLAY
4793 NPTT = ELBUF_TAB(NG)%BUFLY(J)%NPTT
4794 ID_PLY = 0
4795.OR. IF (IGTYP == 17 IGTYP == 51) THEN
4796 ID_PLY = IGEO(1,STACK%IGEO(2+J,ISUBSTACK))
4797 ELSEIF (IGTYP == 52) THEN
4798 ID_PLY = PLY_INFO(1,STACK%IGEO(2+J,ISUBSTACK)-NUMSTACK)
4799 ENDIF
4800 IF (ID_PLY == IPLY) THEN
4801 DO I = 1,NEL
4802 DO IR = 1,NPTR
4803 DO IS = 1,NPTS
4804 DO IT = 1,NPTT
4805 FBUF => ELBUF_TAB(NG)%BUFLY(J)%FAIL(IR,IS,IT)
4806 MAXDAMINI = ZERO
4807 DO IFAIL = 1, ELBUF_TAB(NG)%BUFLY(J)%NFAIL
4808 IF (FBUF%FLOC(IFAIL)%LF_DAMINI > 0) THEN
4809 MAXDAMINI = MAX(MAXDAMINI,FBUF%FLOC(IFAIL)%DAMINI(I))
4810 ENDIF
4811 ENDDO
4812 VALUE(I) = VALUE(I) + MAXDAMINI/(NPTR*NPTS*NPTT)
4813 ENDDO
4814 ENDDO
4815 ENDDO
4816 IS_WRITTEN_VALUE(I) = 1
4817 ENDDO
4818 ENDIF
4819 ENDDO
4820c ILAYER=ILAY NPT=IPT
4821.AND..AND..AND. ELSEIF (ILAY <= NLAY ILAY > 0 IPT <= MPT IPT > 0 ) THEN
4822.OR. IF (IGTYP == 51 IGTYP == 52) THEN
4823 DO I=1,NEL
4824 DO IR = 1,NPTR
4825 DO IS = 1,NPTS
4826 FBUF => ELBUF_TAB(NG)%BUFLY(ILAY)%FAIL(IR,IS,IPT)
4827 MAXDAMINI = ZERO
4828 DO IFAIL = 1,ELBUF_TAB(NG)%BUFLY(ILAY)%NFAIL
4829 IF (FBUF%FLOC(IFAIL)%LF_DAMINI > 0) THEN
4830 MAXDAMINI = MAX(MAXDAMINI,FBUF%FLOC(IFAIL)%DAMINI(I))
4831 ENDIF
4832 ENDDO
4833 VALUE(I) = VALUE(I) + MAXDAMINI/(NPTR*NPTS)
4834 IS_WRITTEN_VALUE(I) = 1
4835 ENDDO
4836 ENDDO
4837 ENDDO
4838 ENDIF
4839c ILAYER=IL NPT=NULL
4840.AND. ELSEIF ( ILAY <= NLAY ILAY > 0) THEN
4841 IPT = 1
4842.OR..OR..OR. IF (IGTYP == 10 IGTYP == 11 IGTYP == 16 IGTYP == 17) THEN
4843 DO I=1,NEL
4844 DO IR = 1,NPTR
4845 DO IS = 1,NPTS
4846 FBUF => ELBUF_TAB(NG)%BUFLY(ILAY)%FAIL(IR,IS,1)
4847 MAXDAMINI = ZERO
4848 DO IFAIL = 1,ELBUF_TAB(NG)%BUFLY(ILAY)%NFAIL
4849 IF (FBUF%FLOC(IFAIL)%LF_DAMINI > 0) THEN
4850 MAXDAMINI = MAX(MAXDAMINI,FBUF%FLOC(IFAIL)%DAMINI(I))
4851 ENDIF
4852 ENDDO
4853 VALUE(I) = VALUE(I) + MAXDAMINI/(NPTR*NPTS)
4854 ENDDO
4855 ENDDO
4856 IS_WRITTEN_VALUE(I) = 1
4857 ENDDO ! I=1,NEL
4858.OR. ELSEIF (IGTYP == 51 IGTYP == 52) THEN
4859 NPTT = ELBUF_TAB(NG)%BUFLY(ILAY)%NPTT
4860 DO I=1,NEL
4861 DO IT = 1,NPTT
4862 DO IR = 1,NPTR
4863 DO IS = 1,NPTS
4864 FBUF => ELBUF_TAB(NG)%BUFLY(ILAY)%FAIL(IR,IS,IT)
4865 MAXDAMINI = ZERO
4866 DO IFAIL = 1,ELBUF_TAB(NG)%BUFLY(ILAY)%NFAIL
4867 IF (FBUF%FLOC(IFAIL)%LF_DAMINI > 0) THEN
4868 MAXDAMINI = MAX(MAXDAMINI,FBUF%FLOC(IFAIL)%DAMINI(I))
4869 ENDIF
4870 ENDDO
4871 VALUE(I) = VALUE(I) + MAXDAMINI/(NPTT*NPTR*NPTS)
4872 ENDDO
4873 ENDDO
4874 ENDDO ! DO IT = 1,NPTT
4875 IS_WRITTEN_VALUE(I) = 1
4876 ENDDO ! I=1,NEL
4877 ENDIF
4878c NPT=IPT
4879.AND. ELSEIF ( IPT <= NPT IPT > 0) THEN
4880.OR. IF (IGTYP == 1 IGTYP == 9 ) THEN
4881 DO I=1,NEL
4882 DO IR = 1,NPTR
4883 DO IS = 1,NPTS
4884 FBUF => ELBUF_TAB(NG)%BUFLY(1)%FAIL(IR,IS,IPT)
4885 MAXDAMINI = ZERO
4886 DO IFAIL = 1,ELBUF_TAB(NG)%BUFLY(1)%NFAIL
4887 IF (FBUF%FLOC(IFAIL)%LF_DAMINI > 0) THEN
4888 MAXDAMINI = MAX(MAXDAMINI,FBUF%FLOC(IFAIL)%DAMINI(I))
4889 ENDIF
4890 ENDDO
4891 VALUE(I) = VALUE(I) + MAXDAMINI/(NPTR*NPTS)
4892 IS_WRITTEN_VALUE(I) = 1
4893 ENDDO
4894 ENDDO
4895 ENDDO ! I=1,NEL
4896 ENDIF
4897 ENDIF
4898 ENDIF
4899C--------------------------------------------------
4900 ELSE IF (KEYWORD == 'tdel') THEN
4901C FAIL TIME : ELEMENT DELETED
4902C--------------------------------------------------
4903c
4904 DO IL=1,NLAY
4905 NFAIL = ELBUF_TAB(NG)%BUFLY(IL)%NFAIL
4906 DO IS=1,NPTS
4907 DO IT=1,NPTT
4908 DO IR=1,NPTR
4909 FBUF => ELBUF_TAB(NG)%BUFLY(IL)%FAIL(IR,IS,IT)
4910 DO IFAIL=1,NFAIL
4911 DO I=1,NEL
4912 VALUE(I) = MAX(VALUE(I),FBUF%FLOC(IFAIL)%TDEL(I))
4913 IS_WRITTEN_VALUE(I) = 1
4914 ENDDO
4915 ENDDO
4916 ENDDO
4917 ENDDO
4918 ENDDO
4919 ENDDO
4920C--------------------------------------------------
4921 ELSE IF (KEYWORD == 'ssp') THEN
4922C SOUND SPEED
4923 ! /ANIM/ELEM/SSP
4924C--------------------------------------------------
4925 IF (MLW == 151) THEN
4926 DO I = 1, NEL
4927 VALUE(I) = MULTI_FVM%SOUND_SPEED(I + NFT)
4928 IS_WRITTEN_VALUE(I) = 1
4929 ENDDO
4930 ELSE
4931 L = ELBUF_TAB(NG)%BUFLY(1)%L_SSP
4932 IF(L /= 0)THEN
4933 LBUF => ELBUF_TAB(NG)%BUFLY(1)%LBUF(1,1,1)
4934 DO I=1,NEL
4935 VALUE(I) = LBUF%SSP(I)
4936 IS_WRITTEN_VALUE(I) = 1
4937 ENDDO
4938 ENDIF
4939 ENDIF
4940C--------------------------------------------------
4941 ELSEIF(KEYWORD == 'schlieren') THEN
4942C--------------------------------------------------
4943 IALEL=IPARG(7,NG)+IPARG(11,NG)
4944 IF(IALEL /= 0)THEN
4945.AND. IF(ITY ==7 N2D /= 0)THEN
4946 EVAR(1:NEL)=ZERO
4947 LFT=1
4948 LLT=NEL
4949 CALL OUTPUT_SCHLIEREN(
4950 1 EVAR , IXTG , X ,
4951 2 IPARG , WA_L , ELBUF_TAB , ALE_CONNECT , GBUF%VOL,
4952 3 NG , NIXTG, ITY)
4953 DO I=1,NEL
4954 VALUE(I) = EVAR(I)
4955 IS_WRITTEN_VALUE(I) = 1
4956 ENDDO
4957 ENDIF
4958 ENDIF
4959C--------------------------------------------------
4960 ELSE IF ( KEYWORD == 'error/thick') THEN
4961C--------------------------------------------------
4962 IF (ITY == 3) THEN
4963 DO I=1,NEL
4964 VALUE(I) = ERR_THK_SH4(I)
4965 IS_WRITTEN_VALUE(I) = 1
4966 END DO
4967 ELSE
4968 DO I=1,NEL
4969 VALUE(I) = ERR_THK_SH3(I)
4970 IS_WRITTEN_VALUE(I) = 1
4971 END DO
4972 ENDIF
4973C--------------------------------------------------
4974 ELSE IF (KEYWORD == 'domain') THEN
4975C SPMD DOMAIN
4976C--------------------------------------------------
4977 DO I=1,NEL
4978 VALUE(I) = ISPMD
4979 IS_WRITTEN_VALUE(I) = 1
4980 ENDDO
4981C--------------------------------------------------
4982 ELSEIF (KEYWORD == 'sigeq') THEN ! equiv stress (mid layer : npt/2 + 1)
4983C equivalent stress - other than VON MISES
4984C--------------------------------------------------
4985 IF (GBUF%G_SEQ > 0) THEN
4986C------------------
4987 ! Total number of integration points
4988 NPTG = 0
4989 DO IL=1,NLAY
4990 BUFLY => ELBUF_TAB(NG)%BUFLY(IL)
4991 NPTG = NPTG + BUFLY%NPTT*NPTR*NPTS
4992 ENDDO
4993 ! Average equivalent stress on integration points
4994 VALUE(1:NEL) = ZERO
4995 DO IL=1,NLAY
4996 BUFLY => ELBUF_TAB(NG)%BUFLY(IL)
4997 DO IT=1,BUFLY%NPTT
4998 DO IR=1,NPTR
4999 DO IS=1,NPTS
5000 LBUF => ELBUF_TAB(NG)%BUFLY(IL)%LBUF(IR,IS,IT)
5001 DO I=1,NEL
5002 VALUE(I) = VALUE(I) + LBUF%SEQ(I)/NPTG
5003 IS_WRITTEN_VALUE(I) = 1
5004 ENDDO
5005 ENDDO
5006 ENDDO
5007 ENDDO
5008 ENDDO
5009C------------------
5010 ELSE ! VON MISES
5011 DO I=1,NEL
5012 S1 = GBUF%FOR(JJ(1)+I)
5013 S2 = GBUF%FOR(JJ(2)+I)
5014 S12= GBUF%FOR(JJ(3)+I)
5015 VONM2= S1*S1 + S2*S2 - S1*S2 + THREE*S12*S12
5016 VALUE(I) = SQRT(VONM2)
5017 IS_WRITTEN_VALUE(I) = 1
5018 ENDDO
5019 ENDIF
5020C--------------------------------------------------
5021 ELSEIF (KEYWORD == 'nl_epsp') THEN
5022 IF (GBUF%G_PLANL > 0) THEN
5023 ! Resetting values
5024 DO I = 1,NEL
5025 VALUE(I) = ZERO
5026 ENDDO
5027 ! Mean value through all integration points in the thickness
5028 IF (IPT == -1) THEN
5029 NPTT = ELBUF_TAB(NG)%BUFLY(1)%NPTT
5030 NPTG = NPTR*NPTS*NPTT
5031 DO I=1,NEL
5032 DO IT = 1,NPTT
5033 DO IR = 1,NPTR
5034 DO IS = 1,NPTS
5035 LBUF => ELBUF_TAB(NG)%BUFLY(1)%LBUF(IR,IS,IT)
5036 VALUE(I) = VALUE(I) + LBUF%PLANL(I)/NPTG
5037 ENDDO
5038 ENDDO
5039 ENDDO
5040 IS_WRITTEN_VALUE(I) = 1
5041 ENDDO
5042 ! Value at a given integration point in the thickness
5043.AND. ELSEIF ( IPT <= NPT IPT > 0) THEN
5044 NPTG = NPTR*NPTS
5045 DO I=1,NEL
5046 DO IR = 1,NPTR
5047 DO IS = 1,NPTS
5048 LBUF => ELBUF_TAB(NG)%BUFLY(1)%LBUF(IR,IS,IPT)
5049 VALUE(I) = VALUE(I) + LBUF%PLANL(I)/NPTG
5050 ENDDO
5051 ENDDO
5052 IS_WRITTEN_VALUE(I) = 1
5053 ENDDO
5054 ENDIF
5055 ENDIF
5056C--------------------------------------------------
5057 ELSEIF (KEYWORD == 'nl_epsd') THEN
5058C--------------------------------------------------
5059 IF (GBUF%G_EPSDNL > 0) THEN
5060C------------------
5061 ! Resetting values
5062 DO I = 1,NEL
5063 VALUE(I) = ZERO
5064 ENDDO
5065 ! Mean value through all integration points in the thickness
5066 IF (IPT == -1) THEN
5067 NPTT = ELBUF_TAB(NG)%BUFLY(1)%NPTT
5068 NPTG = NPTR*NPTS*NPTT
5069 DO I=1,NEL
5070 DO IT = 1,NPTT
5071 DO IR = 1,NPTR
5072 DO IS = 1,NPTS
5073 LBUF => ELBUF_TAB(NG)%BUFLY(1)%LBUF(IR,IS,IT)
5074 VALUE(I) = VALUE(I) + LBUF%EPSDNL(I)/NPTG
5075 ENDDO
5076 ENDDO
5077 ENDDO
5078 IS_WRITTEN_VALUE(I) = 1
5079 ENDDO
5080 ! Value at a given integration point in the thickness
5081.AND. ELSEIF ( IPT <= NPT IPT > 0) THEN
5082 NPTG = NPTR*NPTS
5083 DO I=1,NEL
5084 DO IR = 1,NPTR
5085 DO IS = 1,NPTS
5086 LBUF => ELBUF_TAB(NG)%BUFLY(1)%LBUF(IR,IS,IPT)
5087 VALUE(I) = VALUE(I) + LBUF%EPSDNL(I)/NPTG
5088 ENDDO
5089 ENDDO
5090 IS_WRITTEN_VALUE(I) = 1
5091 ENDDO
5092 ENDIF
5093 ENDIF
5094C--------------------------------------------------
5095 ELSEIF (KEYWORD == 'tsaiwu') THEN
5096 ! ---
5097.AND..AND..AND. IF ( ILAY == -1 IPT == -1 IPLY == -1 GBUF%G_TSAIWU > 0) THEN
5098 IF (NLAY > 1) THEN
5099 IPT = IABS(NLAY)/2 + 1
5100 BUFLY => ELBUF_TAB(NG)%BUFLY(IPT)
5101 IF (BUFLY%L_TSAIWU > 0) THEN
5102 NPTT = BUFLY%NPTT
5103 DO IR = 1,NPTR
5104 DO IS = 1,NPTS
5105 DO IT = 1,NPTT
5106 DO I=1,NEL
5107 VALUE(I) = VALUE(I) + BUFLY%LBUF(IR,IS,IT)%TSAIWU(I)/(NPTT*NPTR*NPTS)
5108 IS_WRITTEN_VALUE(I) = 1
5109 ENDDO
5110 ENDDO
5111 ENDDO
5112 ENDDO
5113 ENDIF
5114 ELSE
5115 BUFLY => ELBUF_TAB(NG)%BUFLY(1)
5116 IF (BUFLY%L_TSAIWU > 0) THEN
5117 NPTT = BUFLY%NPTT
5118 IPT = IABS(NPTT)/2 + 1
5119 DO IR = 1,NPTR
5120 DO IS = 1,NPTS
5121 DO I=1,NEL
5122 VALUE(I) = VALUE(I) + BUFLY%LBUF(IR,IS,IPT)%TSAIWU(I)/(NPTR*NPTS)
5123 IS_WRITTEN_VALUE(I) = 1
5124 ENDDO
5125 ENDDO
5126 ENDDO
5127 ENDIF
5128 ENDIF
5129c
5130 ! -- PLY=IPLY NPT=IPT
5131.AND..AND..AND. ELSEIF ( IPLY > 0 (IPT <= MPT IPT > 0 ) GBUF%G_TSAIWU > 0) THEN
5132c
5133 DO J=1,NLAY
5134 ID_PLY = 0
5135.OR. IF (IGTYP == 17 IGTYP == 51) THEN
5136 ID_PLY = IGEO(1,STACK%IGEO(2+J,ISUBSTACK))
5137 ELSEIF (IGTYP == 52) THEN
5138 ID_PLY = PLY_INFO(1,STACK%IGEO(2+J,ISUBSTACK)-NUMSTACK)
5139 ENDIF
5140c
5141 IF (ID_PLY == IPLY ) THEN
5142 BUFLY => ELBUF_TAB(NG)%BUFLY(J)
5143.OR..OR. IF (IGTYP == 17 IGTYP == 51 IGTYP == 52 ) THEN
5144 NPTT = BUFLY%NPTT
5145 IF( IPT <= NPTT) THEN
5146 IF( NPG > 1 ) THEN
5147 DO IR=1,NPTR
5148 DO IS=1,NPTS
5149 DO I=1,NEL
5150 VALUE(I) = VALUE(I) + BUFLY%LBUF(IR,IS,IPT)%TSAIWU(I)/NPG
5151 IS_WRITTEN_VALUE(I) = 1
5152 ENDDO
5153 ENDDO
5154 ENDDO
5155 ELSE
5156 DO I=1,NEL
5157 VALUE(I) = BUFLY%LBUF(1,1,IPT)%TSAIWU(I)
5158 IS_WRITTEN_VALUE(I) = 1
5159 ENDDO
5160 ENDIF
5161 ENDIF
5162 ENDIF
5163 ENDIF
5164 ENDDO
5165c
5166 ! -- PLY=IPLY NPT=NULL
5167.AND..AND. ELSEIF ( IPLY > 0 IPT == -1 GBUF%G_TSAIWU > 0) THEN
5168c
5169 DO J=1,NLAY
5170 ID_PLY = 0
5171.OR. IF (IGTYP == 17 IGTYP == 51) THEN
5172 ID_PLY = IGEO(1,STACK%IGEO(2+J,ISUBSTACK))
5173 ELSEIF (IGTYP == 52) THEN
5174 ID_PLY = PLY_INFO(1,STACK%IGEO(2+J,ISUBSTACK)-NUMSTACK)
5175 ENDIF
5176c
5177 IF (ID_PLY == IPLY ) THEN
5178 BUFLY => ELBUF_TAB(NG)%BUFLY(J)
5179.OR..OR. IF (IGTYP == 17 IGTYP == 51 IGTYP == 52 ) THEN
5180 NPTT = BUFLY%NPTT
5181 DO IPT=1,NPTT
5182 IF (IPT <= NPTT) THEN
5183 IF (NPG > 1) THEN
5184 DO IR=1,NPTR
5185 DO IS=1,NPTS
5186 DO I=1,NEL
5187 VALUE(I) = VALUE(I) + BUFLY%LBUF(IR,IS,IPT)%TSAIWU(I)/(NPG*NPTT)
5188 IS_WRITTEN_VALUE(I) = 1
5189 ENDDO
5190 ENDDO
5191 ENDDO
5192 ELSE
5193 DO I=1,NEL
5194 VALUE(I) = VALUE(I) + BUFLY%LBUF(1,1,IPT)%TSAIWU(I)/NPTT
5195 IS_WRITTEN_VALUE(I) = 1
5196 ENDDO
5197 ENDIF
5198 ENDIF
5199 ENDDO
5200 ENDIF
5201 ENDIF
5202 ENDDO
5203c
5204 ! -- ILAYER= NPT=
5205.AND..AND..AND..AND. ELSEIF ( (ILAY <= NLAY ILAY > 0) (IPT <= MPT IPT > 0 ) GBUF%G_TSAIWU > 0) THEN
5206.OR. IF (IGTYP == 51 IGTYP == 52) THEN
5207 BUFLY => ELBUF_TAB(NG)%BUFLY(ILAY)
5208 NPTT = BUFLY%NPTT
5209.AND. IF ((BUFLY%L_TSAIWU > 0)(IPT <= NPTT)) THEN
5210 DO IR=1,NPTR
5211 DO IS=1,NPTS
5212 LBUF => BUFLY%LBUF(IR,IS,IPT)
5213 DO I=1,NEL
5214 VALUE(I) = VALUE(I) + LBUF%TSAIWU(I)/NPG
5215 IS_WRITTEN_VALUE(I) = 1
5216 ENDDO
5217 ENDDO
5218 ENDDO
5219 ENDIF
5220 ENDIF
5221c
5222 ! -- ILAYER=IL NPT=NULL
5223.AND..AND. ELSEIF ( ILAY <= NLAY ILAY > 0 GBUF%G_TSAIWU > 0) THEN
5224.OR..OR..OR. IF (IGTYP == 10 IGTYP == 11 IGTYP == 16 IGTYP == 17) THEN
5225 BUFLY => ELBUF_TAB(NG)%BUFLY(ILAY)
5226 IF (BUFLY%L_TSAIWU > 0) THEN
5227 DO IR=1,NPTR
5228 DO IS=1,NPTS
5229 LBUF => BUFLY%LBUF(IR,IS,1)
5230 DO I=1,NEL
5231 VALUE(I) = VALUE(I) + LBUF%TSAIWU(I)/NPG
5232 IS_WRITTEN_VALUE(I) = 1
5233 ENDDO
5234 ENDDO
5235 ENDDO
5236 ENDIF
5237.OR. ELSEIF (IGTYP == 51 IGTYP == 52) THEN
5238 BUFLY => ELBUF_TAB(NG)%BUFLY(ILAY)
5239 NPTT = BUFLY%NPTT
5240 IF (BUFLY%L_TSAIWU > 0) THEN
5241 DO IT=1,NPTT
5242 DO IR=1,NPTR
5243 DO IS=1,NPTS
5244 LBUF => BUFLY%LBUF(IR,IS,IT)
5245 DO I=1,NEL
5246 VALUE(I) = VALUE(I) + LBUF%TSAIWU(I)/(NPG*NPTT)
5247 IS_WRITTEN_VALUE(I) = 1
5248 ENDDO
5249 ENDDO
5250 ENDDO
5251 ENDDO
5252 ENDIF
5253 ENDIF
5254c
5255 ! -- ILAYER=NULL NPT=IPT
5256.AND..AND. ELSEIF ( IPT <= MPT IPT > 0 GBUF%G_TSAIWU > 0) THEN
5257.OR. IF (IGTYP == 1 IGTYP == 9) THEN
5258 BUFLY => ELBUF_TAB(NG)%BUFLY(1)
5259 IF (BUFLY%L_TSAIWU > 0) THEN
5260 DO IR=1,NPTR
5261 DO IS=1,NPTS
5262 LBUF => BUFLY%LBUF(IR,IS,IPT)
5263 DO I=1,NEL
5264 VALUE(I) = VALUE(I) + LBUF%TSAIWU(I)/NPG
5265 IS_WRITTEN_VALUE(I) = 1
5266 ENDDO
5267 ENDDO
5268 ENDDO
5269 ENDIF
5270 ENDIF
5271 ENDIF
5272C--------------------------------------------------
5273 ELSEIF (KEYWORD == 'temp') THEN ! ELEMENT TEMPERATURE
5274 IF (JTHE /= 0) THEN
5275 VALUE(1:NEL) = ELBUF_TAB(NG)%GBUF%TEMP(1:NEL)
5276 IS_WRITTEN_VALUE(1:NEL) = 1
5277 ELSE
5278 VALUE(1:NEL) = ZERO
5279 NPTT = 0
5280 DO IL=1,NLAY
5281 IF (ELBUF_TAB(NG)%BUFLY(IL)%L_TEMP > 0) THEN
5282 NPTT = NPTT + ELBUF_TAB(NG)%BUFLY(IL)%NPTT
5283 ENDIF
5284 END DO
5285 NPTG = NPTR*NPTS*NPTT
5286 DO IL=1,NLAY
5287 IF (ELBUF_TAB(NG)%BUFLY(IL)%L_TEMP > 0) THEN
5288 IS_WRITTEN_VALUE(1:NEL) = 1
5289 DO IT=1,ELBUF_TAB(NG)%BUFLY(IL)%NPTT
5290 DO IS=1,NPTS
5291 DO IR=1,NPTR
5292 LBUF => ELBUF_TAB(NG)%BUFLY(IL)%LBUF(IR,IS,IT)
5293 VALUE(1:NEL) = VALUE(1:NEL) + LBUF%TEMP(1:NEL)/NPTG
5294 ENDDO
5295 ENDDO
5296 ENDDO
5297 ENDIF
5298 ENDDO
5299 ENDIF
5300C--------------------------------------------------
5301 ELSEIF(KEYWORD == 'bulk')THEN
5302 !/ANIM/ELEM/BULK (QVIS)
5303C--------------------------------------------------
5304 IF (GBUF%G_QVIS > 0) THEN
5305 DO I=1,NEL
5306 VALUE(I) = GBUF%QVIS(I)
5307 IS_WRITTEN_VALUE(I) = 1
5308 ENDDO
5309 ENDIF
5310C--------------------------------------------------
5311 ELSEIF(KEYWORD == 'dt' )THEN
5312C--------------------------------------------------
5313 IF(GBUF%G_DT>0)THEN
5314 DO I=1,NEL
5315 VALUE(I) = GBUF%DT(I)
5316 IS_WRITTEN_VALUE(I) = 1
5317 ENDDO
5318 ENDIF
5319C--------------------------------------------------
5320 ELSEIF(KEYWORD == 'ams' )THEN
5321C--------------------------------------------------
5322 IF(GBUF%G_ISMS>0)THEN
5323 DO I=1,NEL
5324 VALUE(I) = GBUF%ISMS(I)
5325 IS_WRITTEN_VALUE(I) = 1
5326 ENDDO
5327 ENDIF
5328C--------------------------------------------------
5329 ELSEIF(KEYWORD == 'tdet' )THEN
5330C--------------------------------------------------
5331 IF (GBUF%G_TB > 0) THEN
5332 DO I=1,NEL
5333 VALUE(I) = -GBUF%TB(I)
5334 IS_WRITTEN_VALUE(I) = 1
5335 ENDDO
5336 ENDIF
5337C--------------------------------------------------
5338 ELSEIF(KEYWORD == 'bfrac' )THEN
5339C--------------------------------------------------
5340 IF(GBUF%G_BFRAC>0)THEN
5341 DO I=1,NEL
5342 VALUE(I) = GBUF%BFRAC(I)
5343 IS_WRITTEN_VALUE(I) = 1
5344 ENDDO
5345 ENDIF
5346c---------------------------------------------------------------------------
5347 ELSEIF (KEYWORD == 'alpha') THEN ! shear angle - law58
5348c---------------------------------------------------------------------------
5349.and. IF ( IPLY == -1 ILAY == -1) THEN ! output mid-layer
5350 IF (NLAY > 1) THEN
5351 IL = IABS(NLAY)/2 + 1
5352 IPT = 1
5353 ELSE
5354 IL = 1
5355 IPT = IABS(NPT)/2 + 1
5356 ENDIF
5357 BUFLY => ELBUF_TAB(NG)%BUFLY(IL)
5358c
5359 IF (BUFLY%L_ANG > 0)THEN
5360 IF (NPG > 1) THEN
5361 LBUF1 => BUFLY%LBUF(1,1,IPT)
5362 LBUF2 => BUFLY%LBUF(2,1,IPT)
5363 LBUF3 => BUFLY%LBUF(1,2,IPT)
5364 LBUF4 => BUFLY%LBUF(2,2,IPT)
5365 DO I=1,NEL
5366 A1 = ABS( ATAND(LBUF1%ANG(I) ))
5367 A2 = ABS( ATAND(LBUF2%ANG(I) ))
5368 A3 = ABS( ATAND(LBUF3%ANG(I) ))
5369 A4 = ABS( ATAND(LBUF4%ANG(I) ))
5370 VALUE(I) = FOURTH*(A1 + A2 + A3 + A4)
5371 IS_WRITTEN_VALUE(I) = 1
5372 ENDDO
5373 ELSE
5374 DO I=1,NEL
5375 VALUE(I) = ABS( ATAND(BUFLY%LBUF(1,1,IPT)%ANG(I) ))
5376 IS_WRITTEN_VALUE(I) = 1
5377 ENDDO
5378 ENDIF
5379 ENDIF
5380c
5381 ELSEIF (IPLY > 0) THEN ! PLY=IPLY
5382 DO J=1,NLAY
5383 ID_PLY = 0
5384.OR. IF (IGTYP == 17 IGTYP == 51) THEN
5385 ID_PLY = IGEO(1,STACK%IGEO(2+J,ISUBSTACK))
5386 ELSEIF (IGTYP == 52) THEN
5387 ID_PLY = PLY_INFO(1,STACK%IGEO(2+J,ISUBSTACK)-NUMSTACK)
5388 ENDIF
5389c
5390 IF (ID_PLY == IPLY ) THEN
5391 BUFLY => ELBUF_TAB(NG)%BUFLY(J)
5392 IF (BUFLY%L_ANG > 0)THEN
5393.OR..OR. IF (IGTYP == 17 IGTYP == 51 IGTYP == 52 ) THEN
5394 NPTT = BUFLY%NPTT
5395 IPT = IABS(NPTT)/2 + 1
5396 IF ( NPG > 1 ) THEN
5397 LBUF1 => BUFLY%LBUF(1,1,IPT)
5398 LBUF2 => BUFLY%LBUF(2,1,IPT)
5399 LBUF3 => BUFLY%LBUF(1,2,IPT)
5400 LBUF4 => BUFLY%LBUF(2,2,IPT)
5401 DO I=1,NEL
5402 A1 = ABS( ATAND(LBUF1%ANG(I) ))
5403 A2 = ABS( ATAND(LBUF2%ANG(I) ))
5404 A3 = ABS( ATAND(LBUF3%ANG(I) ))
5405 A4 = ABS( ATAND(LBUF4%ANG(I) ))
5406 VALUE(I) = FOURTH*(A1 + A2 + A3 + A4)
5407 IS_WRITTEN_VALUE(I) = 1
5408 ENDDO
5409 ELSE
5410 DO I=1,NEL
5411 VALUE(I) = ABS( ATAND(BUFLY%LBUF(1,1,IPT)%ANG(I) ))
5412 IS_WRITTEN_VALUE(I) = 1
5413 ENDDO
5414 ENDIF
5415 ENDIF
5416 ENDIF
5417 ENDIF
5418 ENDDO
5419c
5420.AND..AND. ELSEIF (IPLY == -1 ILAY <= NLAY ILAY > 0) THEN
5421 BUFLY => ELBUF_TAB(NG)%BUFLY(ILAY)
5422 IF (BUFLY%L_ANG > 0) THEN
5423 NPTT = BUFLY%NPTT
5424 IPT = IABS(NPTT)/2 + 1
5425 IF ( NPG > 1 ) THEN
5426 LBUF1 => BUFLY%LBUF(1,1,IPT)
5427 LBUF2 => BUFLY%LBUF(2,1,IPT)
5428 LBUF3 => BUFLY%LBUF(1,2,IPT)
5429 LBUF4 => BUFLY%LBUF(2,2,IPT)
5430 DO I=1,NEL
5431 A1 = ABS( ATAND(LBUF1%ANG(I) ))
5432 A2 = ABS( ATAND(LBUF2%ANG(I) ))
5433 A3 = ABS( ATAND(LBUF3%ANG(I) ))
5434 A4 = ABS( ATAND(LBUF4%ANG(I) ))
5435 VALUE(I) = FOURTH*(A1 + A2 + A3 + A4)
5436 IS_WRITTEN_VALUE(I) = 1
5437 ENDDO
5438 ELSE
5439 DO I=1,NEL
5440 VALUE(I) = ABS( ATAND(BUFLY%LBUF(1,1,IPT)%ANG(I) ))
5441 IS_WRITTEN_VALUE(I) = 1
5442 ENDDO
5443 ENDIF
5444 ENDIF
5445
5446 ENDIF
5447c---------------------------------------------------------------------------
5448 ELSEIF (KEYWORD == 'fldf/memb') THEN
5449c---------------------------------------------------------------------------
5450 IL = NLAY/2 + 1
5451 BUFLY => ELBUF_TAB(NG)%BUFLY(IL)
5452 NPTT = BUFLY%NPTT
5453 NFAIL = ELBUF_TAB(NG)%BUFLY(IL)%NFAIL
5454 NPTT = ELBUF_TAB(NG)%BUFLY(IL)%NPTT
5455 IPT = NPTT/2 + 1
5456 DO IS=1,NPTS
5457 DO IR=1,NPTR
5458 FBUF => BUFLY%FAIL(IR,IS,IPT)
5459 DO IFAIL=1,NFAIL
5460 IF (FBUF%FLOC(IFAIL)%ILAWF == 7) THEN ! check /FLD model
5461 DO I=1,NEL
5462 VALUE(I) = MAX(VALUE(I),FBUF%FLOC(IFAIL)%DAM(I))
5463 IS_WRITTEN_VALUE(I) = 1
5464 ENDDO
5465 ENDIF
5466 ENDDO
5467 ENDDO
5468 ENDDO
5469c---------------------------------------------------------------------------
5470 ELSEIF (KEYWORD == 'fldf') THEN
5471c---------------------------------------------------------------------------
5472c PLY=NULL ILAYER=IL NPT=NULL
5473.AND..AND..AND. IF (IPLY == -1 ILAY <= NLAY ILAY > 0 IPT == -1 ) THEN
5474.OR..OR..OR. IF (IGTYP == 10 IGTYP == 11 IGTYP == 16 IGTYP == 17) THEN
5475 NFAIL = ELBUF_TAB(NG)%BUFLY(ILAY)%NFAIL
5476 NPTT = ELBUF_TAB(NG)%BUFLY(ILAY)%NPTT
5477 DO IS=1,NPTS
5478 DO IR=1,NPTR
5479 DO IT=1,NPTT
5480 IPT = IT
5481 FBUF => ELBUF_TAB(NG)%BUFLY(ILAY)%FAIL(IR,IS,IPT)
5482 DO IFAIL=1,NFAIL
5483 IF (FBUF%FLOC(IFAIL)%ILAWF == 7) THEN ! check /FLD model
5484 DO I=1,NEL
5485 VALUE(I) = MAX(VALUE(I),FBUF%FLOC(IFAIL)%DAM(I))
5486 IS_WRITTEN_VALUE(I) = 1
5487 ENDDO
5488 ENDIF
5489 ENDDO
5490 ENDDO
5491 ENDDO
5492 ENDDO
5493 ENDIF
5494c PLY=NULL ILAYER=NULL NPT=IPT
5495.AND. ELSEIF ( IPT <= MPT IPT > 0) THEN
5496.OR. IF (IGTYP == 1 IGTYP == 9) THEN
5497 NFAIL = ELBUF_TAB(NG)%BUFLY(1)%NFAIL
5498 NPTT = ELBUF_TAB(NG)%BUFLY(1)%NPTT
5499 DO IS=1,NPTS
5500 DO IR=1,NPTR
5501 FBUF => ELBUF_TAB(NG)%BUFLY(1)%FAIL(IR,IS,IPT)
5502 DO IFAIL=1,NFAIL
5503 IF (FBUF%FLOC(IFAIL)%ILAWF == 7) THEN ! check /FLD model
5504 DO I=1,NEL
5505 VALUE(I) = MAX(VALUE(I),FBUF%FLOC(IFAIL)%DAM(I))
5506 IS_WRITTEN_VALUE(I) = 1
5507 ENDDO
5508 ENDIF
5509 ENDDO
5510 ENDDO
5511 ENDDO
5512
5513 ENDIF
5514 ENDIF
5515c---------------------------------------------------------------------------
5516 ELSEIF (KEYWORD == 'fldz/memb') THEN
5517c---------------------------------------------------------------------------
5518 IL = NLAY/2 + 1
5519 BUFLY => ELBUF_TAB(NG)%BUFLY(IL)
5520 NPTT = BUFLY%NPTT
5521 NFAIL = ELBUF_TAB(NG)%BUFLY(IL)%NFAIL
5522 NPTT = ELBUF_TAB(NG)%BUFLY(IL)%NPTT
5523 IPT = NPTT/2 + 1
5524 DO IS=1,NPTS
5525 DO IR=1,NPTR
5526 FBUF => BUFLY%FAIL(IR,IS,IPT)
5527 DO IFAIL=1,NFAIL
5528 IF (FBUF%FLOC(IFAIL)%ILAWF == 7) THEN ! check /FLD model
5529 DO I=1,NEL
5530 RINDX = FBUF%FLOC(IFAIL)%INDX(I)
5531 VALUE(I) = MAX(VALUE(I),RINDX)
5532 IS_WRITTEN_VALUE(I) = 1
5533 ENDDO
5534 ENDIF
5535 ENDDO
5536 ENDDO
5537 ENDDO
5538c---------------------------------------------------------------------------
5539 ELSEIF (KEYWORD == 'fldz') THEN
5540c---------------------------------------------------------------------------
5541c PLY=NULL ILAYER=IL NPT=NULL
5542.AND..AND..AND. IF (IPLY == -1 ILAY <= NLAY ILAY > 0 IPT == -1 ) THEN
5543.OR..OR..OR. IF (IGTYP == 10 IGTYP == 11 IGTYP == 16 IGTYP == 17) THEN
5544 NFAIL = ELBUF_TAB(NG)%BUFLY(ILAY)%NFAIL
5545 NPTT = ELBUF_TAB(NG)%BUFLY(ILAY)%NPTT
5546 DO IS=1,NPTS
5547 DO IR=1,NPTR
5548 DO IT=1,NPTT
5549 IPT = IT
5550 FBUF => ELBUF_TAB(NG)%BUFLY(ILAY)%FAIL(IR,IS,IPT)
5551 DO IFAIL=1,NFAIL
5552 IF (FBUF%FLOC(IFAIL)%ILAWF == 7) THEN ! check /FLD model
5553 DO I=1,NEL
5554 RINDX = FBUF%FLOC(IFAIL)%INDX(I)
5555 VALUE(I) = MAX(VALUE(I),RINDX)
5556 IS_WRITTEN_VALUE(I) = 1
5557 ENDDO
5558 ENDIF
5559 ENDDO
5560 ENDDO
5561 ENDDO
5562 ENDDO
5563 ENDIF
5564c PLY=NULL ILAYER=NULL NPT=IPT
5565.AND. ELSEIF ( IPT <= MPT IPT > 0) THEN
5566.OR. IF (IGTYP == 1 IGTYP == 9) THEN
5567 NFAIL = ELBUF_TAB(NG)%BUFLY(1)%NFAIL
5568 NPTT = ELBUF_TAB(NG)%BUFLY(1)%NPTT
5569 DO IS=1,NPTS
5570 DO IR=1,NPTR
5571 FBUF => ELBUF_TAB(NG)%BUFLY(1)%FAIL(IR,IS,IPT)
5572 DO IFAIL=1,NFAIL
5573 IF (FBUF%FLOC(IFAIL)%ILAWF == 7) THEN ! check /FLD model
5574 DO I=1,NEL
5575 RINDX = FBUF%FLOC(IFAIL)%INDX(I)
5576 VALUE(I) = MAX(VALUE(I),RINDX)
5577 IS_WRITTEN_VALUE(I) = 1
5578 ENDDO
5579 ENDIF
5580 ENDDO
5581 ENDDO
5582 ENDDO
5583
5584 ENDIF
5585 ENDIF
5586c---------------------------------------------------------------------------
5587 ELSEIF (KEYWORD == 'hc_dsse_f/memb') THEN
5588c---------------------------------------------------------------------------
5589 ! Multilayer properties TYPE 10/11/16/17/51/52
5590 IF (NLAY > 1) THEN
5591 IPT = IABS(NLAY)/2 + 1
5592 BUFLY => ELBUF_TAB(NG)%BUFLY(IPT)
5593 NPTT = BUFLY%NPTT
5594 NFAIL = BUFLY%NFAIL
5595 DO I = 1,NEL
5596 DO IT = 1,NPTT
5597 DO IR = 1,NPTR
5598 DO IS = 1,NPTS
5599 FBUF => BUFLY%FAIL(IR,IS,IT)
5600 DO IFAIL=1,NFAIL
5601 IF (FBUF%FLOC(IFAIL)%ILAWF == 32) THEN
5602 VALUE(I) = MAX(VALUE(I),FBUF%FLOC(IFAIL)%DAM(I))
5603 IS_WRITTEN_VALUE(I) = 1
5604 ENDIF
5605 ENDDO
5606 ENDDO
5607 ENDDO
5608 ENDDO
5609 ENDDO
5610 ! Single layer properties TYPE 1/9
5611 ELSEIF (MPT > 0) THEN
5612 IPT = IABS(NPT)/2 + 1
5613 BUFLY => ELBUF_TAB(NG)%BUFLY(1)
5614 NFAIL = BUFLY%NFAIL
5615 DO I = 1,NEL
5616 DO IR = 1,NPTR
5617 DO IS = 1,NPTS
5618 FBUF => BUFLY%FAIL(IR,IS,IPT)
5619 DO IFAIL = 1,NFAIL
5620 IF (FBUF%FLOC(IFAIL)%ILAWF == 32) THEN
5621 VALUE(I) = MAX(VALUE(I),FBUF%FLOC(IFAIL)%DAM(I))
5622 IS_WRITTEN_VALUE(I) = 1
5623 ENDIF
5624 ENDDO
5625 ENDDO
5626 ENDDO
5627 ENDDO
5628 ENDIF
5629c
5630c---------------------------------------------------------------------------
5631 ELSEIF (KEYWORD == 'hc_dsse_f') THEN
5632c---------------------------------------------------------------------------
5633 ! If no specific input PLY=null LAYER=null NPT=null
5634.AND..AND. IF (ILAY == -1 IPT == -1 IPLY == -1) THEN
5635 ! Multilayer properties TYPE 10/11/16/17/51/52
5636 ! -> Max value among all layers and integration points
5637 IF (NLAY > 1) THEN
5638 DO I = 1,NEL
5639 DO N = 1,NLAY
5640 BUFLY => ELBUF_TAB(NG)%BUFLY(N)
5641 NPTT = BUFLY%NPTT
5642 NFAIL = BUFLY%NFAIL
5643 DO IT = 1,NPTT
5644 DO IR = 1,NPTR
5645 DO IS = 1,NPTS
5646 FBUF => BUFLY%FAIL(IR,IS,IT)
5647 DO IFAIL=1,NFAIL
5648 IF (FBUF%FLOC(IFAIL)%ILAWF == 32) THEN
5649 VALUE(I) = MAX(VALUE(I),FBUF%FLOC(IFAIL)%DAM(I))
5650 IS_WRITTEN_VALUE(I) = 1
5651 ENDIF
5652 ENDDO
5653 ENDDO
5654 ENDDO
5655 ENDDO
5656 ENDDO
5657 ENDDO
5658 ! Single layer properties TYPE 1/9
5659 ! -> Max value among all layers and integration points
5660 ELSEIF (MPT > 0) THEN
5661 BUFLY => ELBUF_TAB(NG)%BUFLY(1)
5662 NPTT = BUFLY%NPTT
5663 NFAIL = BUFLY%NFAIL
5664 DO I = 1,NEL
5665 DO IT = 1,NPTT
5666 DO IR = 1,NPTR
5667 DO IS = 1,NPTS
5668 FBUF => BUFLY%FAIL(IR,IS,IT)
5669 DO IFAIL = 1,NFAIL
5670 IF (FBUF%FLOC(IFAIL)%ILAWF == 32) THEN
5671 VALUE(I) = MAX(VALUE(I),FBUF%FLOC(IFAIL)%DAM(I))
5672 IS_WRITTEN_VALUE(I) = 1
5673 ENDIF
5674 ENDDO
5675 ENDDO
5676 ENDDO
5677 ENDDO
5678 ENDDO
5679 ENDIF
5680c ! If ply and int. point input: PLY=IPLY LAYER=null NPT=IPT
5681 ! -> Properties type 17/51/52 only
5682.AND..AND. ELSEIF (IPLY > 0 IPT <= MPT IPT > 0) THEN
5683 DO J = 1,NLAY
5684 BUFLY => ELBUF_TAB(NG)%BUFLY(J)
5685 NPTT = BUFLY%NPTT
5686 NFAIL = BUFLY%NFAIL
5687 ID_PLY = 0
5688.OR. IF (IGTYP == 17 IGTYP == 51) THEN
5689 ID_PLY = IGEO(1,STACK%IGEO(2+J,ISUBSTACK))
5690 ELSEIF (IGTYP == 52) THEN
5691 ID_PLY = PLY_INFO(1,STACK%IGEO(2+J,ISUBSTACK)-NUMSTACK)
5692 ENDIF
5693 IF (ID_PLY == IPLY) THEN
5694 IF (IPT <= NPTT) THEN
5695 DO I = 1,NEL
5696 DO IR = 1,NPTR
5697 DO IS = 1,NPTS
5698 FBUF => BUFLY%FAIL(IR,IS,IPT)
5699 DO IFAIL = 1,NFAIL
5700 IF (FBUF%FLOC(IFAIL)%ILAWF == 32) THEN
5701 VALUE(I) = MAX(VALUE(I),FBUF%FLOC(IFAIL)%DAM(I))
5702 IS_WRITTEN_VALUE(I) = 1
5703 ENDIF
5704 ENDDO
5705 ENDDO
5706 ENDDO
5707 ENDDO
5708 ENDIF
5709 ENDIF
5710 ENDDO
5711c ! If ply input only: PLY=IPLY LAYER=null NPT=null
5712 ! -> Properties type 17/51/52 only
5713.AND. ELSEIF (IPLY > 0 IPT == -1) THEN
5714 DO J = 1,NLAY
5715 BUFLY => ELBUF_TAB(NG)%BUFLY(J)
5716 NPTT = BUFLY%NPTT
5717 NFAIL = BUFLY%NFAIL
5718 ID_PLY = 0
5719.OR. IF (IGTYP == 17 IGTYP == 51) THEN
5720 ID_PLY = IGEO(1,STACK%IGEO(2+J,ISUBSTACK))
5721 ELSEIF (IGTYP == 52) THEN
5722 ID_PLY = PLY_INFO(1,STACK%IGEO(2+J,ISUBSTACK)-NUMSTACK)
5723 ENDIF
5724 IF (ID_PLY == IPLY) THEN
5725 DO I = 1,NEL
5726 DO IR = 1,NPTR
5727 DO IS = 1,NPTS
5728 DO IT = 1,NPTT
5729 FBUF => BUFLY%FAIL(IR,IS,IT)
5730 DO IFAIL = 1,NFAIL
5731 IF (FBUF%FLOC(IFAIL)%ILAWF == 32) THEN
5732 VALUE(I) = MAX(VALUE(I),FBUF%FLOC(IFAIL)%DAM(I))
5733 IS_WRITTEN_VALUE(I) = 1
5734 ENDIF
5735 ENDDO
5736 ENDDO
5737 ENDDO
5738 ENDDO
5739 ENDDO
5740 ENDIF
5741 ENDDO
5742c ! If layer input : PLY=null LAYER=ILAY NPT=null/IPT
5743 ! -> Properties type 10/11/16 only
5744.AND. ELSEIF (ILAY <= NLAY ILAY > 0) THEN
5745 IPT = 1
5746.OR..OR. IF (IGTYP == 10 IGTYP == 11 IGTYP == 16) THEN
5747 BUFLY => ELBUF_TAB(NG)%BUFLY(ILAY)
5748 NFAIL = BUFLY%NFAIL
5749 DO I=1,NEL
5750 DO IR = 1,NPTR
5751 DO IS = 1,NPTS
5752 FBUF => BUFLY%FAIL(IR,IS,1)
5753 DO IFAIL = 1,NFAIL
5754 IF (FBUF%FLOC(IFAIL)%ILAWF == 32) THEN
5755 VALUE(I) = MAX(VALUE(I),FBUF%FLOC(IFAIL)%DAM(I))
5756 IS_WRITTEN_VALUE(I) = 1
5757 ENDIF
5758 ENDDO
5759 ENDDO
5760 ENDDO
5761 ENDDO
5762 ENDIF
5763c ! If intg. point input : PLY=null LAYER=null NPT=IPT
5764 ! -> Properties type 1/9 only
5765.AND. ELSEIF (IPT <= NPT IPT > 0) THEN
5766.OR. IF (IGTYP == 1 IGTYP == 9) THEN
5767 BUFLY => ELBUF_TAB(NG)%BUFLY(1)
5768 NFAIL = BUFLY%NFAIL
5769 DO I=1,NEL
5770 DO IR = 1,NPTR
5771 DO IS = 1,NPTS
5772 FBUF => BUFLY%FAIL(IR,IS,IPT)
5773 DO IFAIL = 1,NFAIL
5774 IF (FBUF%FLOC(IFAIL)%ILAWF == 32) THEN
5775 VALUE(I) = MAX(VALUE(I),FBUF%FLOC(IFAIL)%DAM(I))
5776 IS_WRITTEN_VALUE(I) = 1
5777 ENDIF
5778 ENDDO
5779 ENDDO
5780 ENDDO
5781 ENDDO
5782 ENDIF
5783 ENDIF
5784c---------------------------------------------------------------------------
5785 ELSEIF (KEYWORD == 'hc_dsse_z/memb') THEN
5786c---------------------------------------------------------------------------
5787 ! Multilayer properties TYPE 10/11/16/17/51/52
5788 IF (NLAY > 1) THEN
5789 IPT = IABS(NLAY)/2 + 1
5790 BUFLY => ELBUF_TAB(NG)%BUFLY(IPT)
5791 NPTT = BUFLY%NPTT
5792 NFAIL = BUFLY%NFAIL
5793 DO I = 1,NEL
5794 DO IT = 1,NPTT
5795 DO IR = 1,NPTR
5796 DO IS = 1,NPTS
5797 FBUF => BUFLY%FAIL(IR,IS,IT)
5798 DO IFAIL=1,NFAIL
5799 IF (FBUF%FLOC(IFAIL)%ILAWF == 32) THEN
5800 RINDX = FBUF%FLOC(IFAIL)%INDX(I)
5801 VALUE(I) = MAX(VALUE(I),RINDX)
5802 IS_WRITTEN_VALUE(I) = 1
5803 ENDIF
5804 ENDDO
5805 ENDDO
5806 ENDDO
5807 ENDDO
5808 ENDDO
5809 ! Single layer properties TYPE 1/9
5810 ELSEIF (MPT > 0) THEN
5811 IPT = IABS(NPT)/2 + 1
5812 BUFLY => ELBUF_TAB(NG)%BUFLY(1)
5813 NFAIL = BUFLY%NFAIL
5814 DO I = 1,NEL
5815 DO IR = 1,NPTR
5816 DO IS = 1,NPTS
5817 FBUF => BUFLY%FAIL(IR,IS,IPT)
5818 DO IFAIL = 1,NFAIL
5819 IF (FBUF%FLOC(IFAIL)%ILAWF == 32) THEN
5820 RINDX = FBUF%FLOC(IFAIL)%INDX(I)
5821 VALUE(I) = MAX(VALUE(I),RINDX)
5822 IS_WRITTEN_VALUE(I) = 1
5823 ENDIF
5824 ENDDO
5825 ENDDO
5826 ENDDO
5827 ENDDO
5828 ENDIF
5829c
5830c---------------------------------------------------------------------------
5831 ELSEIF (KEYWORD == 'hc_dsse_z') THEN
5832c---------------------------------------------------------------------------
5833 ! If no specific input PLY=null LAYER=null NPT=null
5834.AND..AND. IF (ILAY == -1 IPT == -1 IPLY == -1) THEN
5835 ! Multilayer properties TYPE 10/11/16/17/51/52
5836 ! -> Max value among all layers and integration points
5837 IF (NLAY > 1) THEN
5838 DO I = 1,NEL
5839 DO N = 1,NLAY
5840 BUFLY => ELBUF_TAB(NG)%BUFLY(N)
5841 NPTT = BUFLY%NPTT
5842 NFAIL = BUFLY%NFAIL
5843 DO IT = 1,NPTT
5844 DO IR = 1,NPTR
5845 DO IS = 1,NPTS
5846 FBUF => BUFLY%FAIL(IR,IS,IT)
5847 DO IFAIL=1,NFAIL
5848 IF (FBUF%FLOC(IFAIL)%ILAWF == 32) THEN
5849 RINDX = FBUF%FLOC(IFAIL)%INDX(I)
5850 VALUE(I) = MAX(VALUE(I),RINDX)
5851 IS_WRITTEN_VALUE(I) = 1
5852 ENDIF
5853 ENDDO
5854 ENDDO
5855 ENDDO
5856 ENDDO
5857 ENDDO
5858 ENDDO
5859 ! Single layer properties TYPE 1/9
5860 ! -> Max value among all layers and integration points
5861 ELSEIF (MPT > 0) THEN
5862 BUFLY => ELBUF_TAB(NG)%BUFLY(1)
5863 NPTT = BUFLY%NPTT
5864 NFAIL = BUFLY%NFAIL
5865 DO I = 1,NEL
5866 DO IT = 1,NPTT
5867 DO IR = 1,NPTR
5868 DO IS = 1,NPTS
5869 FBUF => BUFLY%FAIL(IR,IS,IT)
5870 DO IFAIL = 1,NFAIL
5871 IF (FBUF%FLOC(IFAIL)%ILAWF == 32) THEN
5872 RINDX = FBUF%FLOC(IFAIL)%INDX(I)
5873 VALUE(I) = MAX(VALUE(I),RINDX)
5874 IS_WRITTEN_VALUE(I) = 1
5875 ENDIF
5876 ENDDO
5877 ENDDO
5878 ENDDO
5879 ENDDO
5880 ENDDO
5881 ENDIF
5882c ! If ply and int. point input: PLY=IPLY LAYER=null NPT=IPT
5883 ! -> Properties type 17/51/52 only
5884.AND..AND. ELSEIF (IPLY > 0 IPT <= MPT IPT > 0) THEN
5885 DO J = 1,NLAY
5886 BUFLY => ELBUF_TAB(NG)%BUFLY(J)
5887 NPTT = BUFLY%NPTT
5888 NFAIL = BUFLY%NFAIL
5889 ID_PLY = 0
5890.OR. IF (IGTYP == 17 IGTYP == 51) THEN
5891 ID_PLY = IGEO(1,STACK%IGEO(2+J,ISUBSTACK))
5892 ELSEIF (IGTYP == 52) THEN
5893 ID_PLY = PLY_INFO(1,STACK%IGEO(2+J,ISUBSTACK)-NUMSTACK)
5894 ENDIF
5895 IF (ID_PLY == IPLY) THEN
5896 IF (IPT <= NPTT) THEN
5897 DO I = 1,NEL
5898 DO IR = 1,NPTR
5899 DO IS = 1,NPTS
5900 FBUF => BUFLY%FAIL(IR,IS,IPT)
5901 DO IFAIL = 1,NFAIL
5902 IF (FBUF%FLOC(IFAIL)%ILAWF == 32) THEN
5903 RINDX = FBUF%FLOC(IFAIL)%INDX(I)
5904 VALUE(I) = MAX(VALUE(I),RINDX)
5905 IS_WRITTEN_VALUE(I) = 1
5906 ENDIF
5907 ENDDO
5908 ENDDO
5909 ENDDO
5910 ENDDO
5911 ENDIF
5912 ENDIF
5913 ENDDO
5914c ! If ply input only: PLY=IPLY LAYER=null NPT=null
5915 ! -> Properties type 17/51/52 only
5916.AND. ELSEIF (IPLY > 0 IPT == -1) THEN
5917 DO J = 1,NLAY
5918 BUFLY => ELBUF_TAB(NG)%BUFLY(J)
5919 NPTT = BUFLY%NPTT
5920 NFAIL = BUFLY%NFAIL
5921 ID_PLY = 0
5922.OR. IF (IGTYP == 17 IGTYP == 51) THEN
5923 ID_PLY = IGEO(1,STACK%IGEO(2+J,ISUBSTACK))
5924 ELSEIF (IGTYP == 52) THEN
5925 ID_PLY = PLY_INFO(1,STACK%IGEO(2+J,ISUBSTACK)-NUMSTACK)
5926 ENDIF
5927 IF (ID_PLY == IPLY) THEN
5928 DO I = 1,NEL
5929 DO IR = 1,NPTR
5930 DO IS = 1,NPTS
5931 DO IT = 1,NPTT
5932 FBUF => BUFLY%FAIL(IR,IS,IT)
5933 DO IFAIL = 1,NFAIL
5934 IF (FBUF%FLOC(IFAIL)%ILAWF == 32) THEN
5935 RINDX = FBUF%FLOC(IFAIL)%INDX(I)
5936 VALUE(I) = MAX(VALUE(I),RINDX)
5937 IS_WRITTEN_VALUE(I) = 1
5938 ENDIF
5939 ENDDO
5940 ENDDO
5941 ENDDO
5942 ENDDO
5943 ENDDO
5944 ENDIF
5945 ENDDO
5946c ! If layer input : PLY=null LAYER=ILAY NPT=null/IPT
5947 ! -> Properties type 10/11/16 only
5948.AND. ELSEIF (ILAY <= NLAY ILAY > 0) THEN
5949 IPT = 1
5950.OR..OR. IF (IGTYP == 10 IGTYP == 11 IGTYP == 16) THEN
5951 BUFLY => ELBUF_TAB(NG)%BUFLY(ILAY)
5952 NFAIL = BUFLY%NFAIL
5953 DO I=1,NEL
5954 DO IR = 1,NPTR
5955 DO IS = 1,NPTS
5956 FBUF => BUFLY%FAIL(IR,IS,1)
5957 DO IFAIL = 1,NFAIL
5958 IF (FBUF%FLOC(IFAIL)%ILAWF == 32) THEN
5959 RINDX = FBUF%FLOC(IFAIL)%INDX(I)
5960 VALUE(I) = MAX(VALUE(I),RINDX)
5961 IS_WRITTEN_VALUE(I) = 1
5962 ENDIF
5963 ENDDO
5964 ENDDO
5965 ENDDO
5966 ENDDO
5967 ENDIF
5968c ! If intg. point input : PLY=null LAYER=null NPT=IPT
5969 ! -> Properties type 1/9 only
5970.AND. ELSEIF (IPT <= NPT IPT > 0) THEN
5971.OR. IF (IGTYP == 1 IGTYP == 9) THEN
5972 BUFLY => ELBUF_TAB(NG)%BUFLY(1)
5973 NFAIL = BUFLY%NFAIL
5974 DO I=1,NEL
5975 DO IR = 1,NPTR
5976 DO IS = 1,NPTS
5977 FBUF => BUFLY%FAIL(IR,IS,IPT)
5978 DO IFAIL = 1,NFAIL
5979 IF (FBUF%FLOC(IFAIL)%ILAWF == 32) THEN
5980 RINDX = FBUF%FLOC(IFAIL)%INDX(I)
5981 VALUE(I) = MAX(VALUE(I),RINDX)
5982 IS_WRITTEN_VALUE(I) = 1
5983 ENDIF
5984 ENDDO
5985 ENDDO
5986 ENDDO
5987 ENDDO
5988 ENDIF
5989 ENDIF
5990c---------------------------------------------------------------------------
5991c ELSEIF (KEYWORD == 'NEWKEY') THEN ! New Output Example
5992C---------------------------------------------------------------------------
5993c ILAYER=NULL NPT=NULL
5994c IF ( ILAY == -1 .AND. IPT == -1 .AND. IPLY == -1) THEN
5995c DO I=1,NEL
5996c VALUE(I) =
5997c ENDDO
5998c PLY=IPLY NPT=IPT
5999c ELSEIF ( IPLY > 0 .AND. IPT <= MPT .AND. IPT > 0 ) THEN
6000c IF (IGTYP == 17 .OR. IGTYP == 51 .OR. IGTYP == 52) THEN
6001c
6002c ENDIF
6003c
6004c PLY=NULL ILAYER=ILAY NPT=IPT
6005c ELSEIF (IPLY == -1 .AND. ILAY <= NLAY .AND. ILAY > 0 .AND. IPT <= MPT .AND. IPT > 0 ) THEN
6006c IF (IGTYP == 51 .OR. IGTYP == 52) THEN
6007c
6008c ENDIF
6009c PLY=NULL ILAYER=IL NPT=NULL
6010c ELSEIF (IPLY == -1 .AND. ILAY <= NLAY .AND. ILAY > 0 .AND. IPT == -1 ) THEN
6011c IF (IGTYP == 10 .OR. IGTYP == 11 .OR. IGTYP == 16 .OR. IGTYP == 17) THEN
6012c
6013c ELSEIF (IGTYP == 51 .OR. IGTYP == 52) THEN
6014c
6015c ENDIF
6016c PLY=NULL ILAYER=NULL NPT=IPT
6017c ELSEIF ( IPT <= MPT .AND. IPT > 0) THEN
6018c IF (IGTYP == 1 .OR. IGTYP == 9) THEN
6019c
6020c ENDIF
6021c ENDIF
6022C---------------------------------------------------------------------------
6023C--------------------------------------------------
6024 ELSEIF(KEYWORD == 'off')THEN
6025C--------------------------------------------------
6026 DO I=1,NEL
6027 IF (GBUF%G_OFF > 0) THEN
6028 IF(GBUF%OFF(I) > ONE) THEN
6029 VALUE(I) = GBUF%OFF(I) - ONE
6030.AND. ELSEIF((GBUF%OFF(I) >= ZERO GBUF%OFF(I) <= ONE)) THEN
6031 VALUE(I) = GBUF%OFF(I)
6032 ELSE
6033 VALUE(I) = -ONE
6034 ENDIF
6035 ENDIF
6036 IS_WRITTEN_VALUE(I) = 1
6037 ENDDO
6038C--------------------------------------------------
6039 ELSEIF(KEYWORD == 'mach')THEN
6040C--------------------------------------------------
6041!to be moved in h3d_tria_scalar when implemented.
6042 IF(N2D/=0)THEN
6043 IF (MLW == 151) THEN
6044 DO I = 1, NEL
6045 VEL(1) = MULTI_FVM%VEL(1, I + NFT)
6046 VEL(2) = MULTI_FVM%VEL(2, I + NFT)
6047 VEL(3) = MULTI_FVM%VEL(3, I + NFT)
6048 VEL(0) = SQRT(VEL(1)*VEL(1)+VEL(2)*VEL(2)+VEL(3)*VEL(3))
6049 VALUE(I) = VEL(0)/MULTI_FVM%SOUND_SPEED(I + NFT)
6050 IS_WRITTEN_VALUE(I) = 1
6051 ENDDO
6052 ELSEIF(ALEFVM_Param%ISOLVER>1)THEN
6053 L = ELBUF_TAB(NG)%BUFLY(1)%L_SSP
6054 IF(ELBUF_TAB(NG)%BUFLY(1)%L_SSP /= 0)THEN
6055 LBUF => ELBUF_TAB(NG)%BUFLY(1)%LBUF(1,1,1)
6056 DO I=1,NEL
6057 VEL(1) = GBUF%MOM(JJ(1) + I) / GBUF%RHO(I)
6058 VEL(2) = GBUF%MOM(JJ(2) + I) / GBUF%RHO(I)
6059 VEL(3) = GBUF%MOM(JJ(3) + I) / GBUF%RHO(I)
6060 VEL(0) = SQRT(VEL(1)*VEL(1)+VEL(2)*VEL(2)+VEL(3)*VEL(3))
6061 VALUE(I) = VEL(0)/LBUF%SSP(I)
6062 IS_WRITTEN_VALUE(I) = 1
6063 ENDDO
6064 ENDIF
6065 ELSE
6066 L = ELBUF_TAB(NG)%BUFLY(1)%L_SSP
6067 IF(ELBUF_TAB(NG)%BUFLY(1)%L_SSP /= 0)THEN
6068 LBUF => ELBUF_TAB(NG)%BUFLY(1)%LBUF(1,1,1)
6069 IF(IS_ALE /= 0)THEN
6070 !ale
6071 DO I=1,NEL
6072 TMP(1,1:3)=V(1,IXTG(2:4,I+NFT))-W(1,IXTG(2:4,I+NFT))
6073 TMP(2,1:3)=V(2,IXTG(2:4,I+NFT))-W(2,IXTG(2:4,I+NFT))
6074 TMP(3,1:3)=V(3,IXTG(2:4,I+NFT))-W(3,IXTG(2:4,I+NFT))
6075 VEL(1) = SUM(TMP(1,1:3))*THIRD
6076 VEL(2) = SUM(TMP(2,1:3))*THIRD
6077 VEL(3) = SUM(TMP(3,1:3))*THIRD
6078 VALUE(I) = SQRT(VEL(1)*VEL(1)+VEL(2)*VEL(2)+VEL(3)*VEL(3))/LBUF%SSP(I)
6079 IS_WRITTEN_VALUE(I) = 1
6080 ENDDO
6081 ELSE
6082 !euler and lagrange
6083 DO I=1,NEL
6084 TMP(1,1:3)=V(1,IXTG(2:4,I+NFT))
6085 TMP(2,1:3)=V(2,IXTG(2:4,I+NFT))
6086 TMP(3,1:3)=V(3,IXTG(2:4,I+NFT))
6087 VEL(1) = SUM(TMP(1,1:3))*THIRD
6088 VEL(2) = SUM(TMP(2,1:3))*THIRD
6089 VEL(3) = SUM(TMP(3,1:3))*THIRD
6090 VALUE(I) = SQRT(VEL(1)*VEL(1)+VEL(2)*VEL(2)+VEL(3)*VEL(3))/LBUF%SSP(I)
6091 IS_WRITTEN_VALUE(I) = 1
6092 ENDDO
6093 ENDIF
6094 ENDIF
6095 ENDIF
6096 ENDIF!N2D
6097C--------------------------------------------------
6098 ELSEIF(KEYWORD == 'color') THEN
6099C--------------------------------------------------
6100!to be moved in h3d_tria_scalar when implemented.
6101 GBUF => ELBUF_TAB(NG)%GBUF
6102 IF (MLW == 151) THEN
6103 NFRAC=MULTI_FVM%NBMAT
6104 DO IMAT=1,NFRAC
6105 LBUF => ELBUF_TAB(NG)%BUFLY(IMAT)%LBUF(1,1,1)
6106 DO I=1,NEL
6107 VFRAC(I,IMAT) = LBUF%VOL(I) / GBUF%VOL(I)
6108 ENDDO
6109 ENDDO
6110 ELSEIF(MLW == 20)THEN
6111 NFRAC=2
6112 DO I=1,NEL
6113 VFRAC(I,1) = ELBUF_TAB(NG)%BUFLY(1)%LBUF(1,1,1)%VOL(I) / GBUF%VOL(I)
6114 VFRAC(I,2) = ELBUF_TAB(NG)%BUFLY(2)%LBUF(1,1,1)%VOL(I) / GBUF%VOL(I)
6115 ENDDO
6116 ELSEIF(MLW == 37)THEN
6117 MBUF => ELBUF_TAB(NG)%BUFLY(1)%MAT(1,1,1)
6118 NFRAC=2
6119 DO I=1,NEL
6120 VFRAC(I,1) = MBUF%VAR(I+3*NEL)
6121 VFRAC(I,2) = MBUF%VAR(I+4*NEL)
6122 ENDDO
6123 ELSEIF(MLW == 51)THEN
6124 !get UPARAM
6125 IMAT = IXTG(1,NFT+1)
6126 IADBUF = IPM(7,IMAT)
6127 NUPARAM= IPM(9,IMAT)
6128 UPARAM => BUFMAT(IADBUF:IADBUF+NUPARAM)
6129 !bijective order !indexes
6130 ISUBMAT = UPARAM(276+1); IU(1)=M51_N0PHAS+(ISUBMAT-1)*M51_NVPHAS
6131 ISUBMAT = UPARAM(276+2); IU(2)=M51_N0PHAS+(ISUBMAT-1)*M51_NVPHAS
6132 ISUBMAT = UPARAM(276+3); IU(3)=M51_N0PHAS+(ISUBMAT-1)*M51_NVPHAS
6133 ISUBMAT = UPARAM(276+4); IU(4)=M51_N0PHAS+(ISUBMAT-1)*M51_NVPHAS
6134 MBUF => ELBUF_TAB(NG)%BUFLY(1)%MAT(1,1,1)
6135 NFRAC=4
6136 DO I=1,NEL
6137 VFRAC(I,1) = MBUF%VAR(I+IU(1)*NEL)
6138 VFRAC(I,2) = MBUF%VAR(I+IU(2)*NEL)
6139 VFRAC(I,3) = MBUF%VAR(I+IU(3)*NEL)
6140 VFRAC(I,4) = MBUF%VAR(I+IU(4)*NEL)
6141 ENDDO
6142 ELSE
6143 NFRAC=0
6144 !VFRAC(1:NEL,1:21)=ZERO
6145 ENDIF
6146 IF(NFRAC>0)THEN
6147 DO I=1,NEL
6148 VALUE(I)=ZERO
6149 DO IMAT=1,NFRAC
6150 VALUE(I) = VALUE(I) + VFRAC(I,IMAT)*IMAT
6151 ENDDO
6152 IS_WRITTEN_VALUE(I) = 1
6153 ENDDO
6154 ENDIF
6155C--------------------------------------------------
6156 ELSEIF(KEYWORD == 'vortx') THEN
6157C--------------------------------------------------
6158.OR. IF (MLW == 6 MLW == 17) THEN
6159 DO I=1,NEL
6160 VALUE(I) = ELBUF_TAB(NG)%BUFLY(1)%LBUF(1,1,1)%VK(I)
6161 IS_WRITTEN_VALUE(I) = 1
6162 ENDDO
6163.OR. ELSEIF(MLW == 46 MLW == 47)THEN
6164 DO I=1,NEL
6165 VALUE(I) = UVAR(NEL+I)
6166 IS_WRITTEN_VALUE(I) = 1
6167 ENDDO
6168 ELSEIF(MLW == 151)THEN
6169 !ITY = IPARG(5, NG)
6170 NB_FACE=3
6171 DO I=1,NEL
6172 II = I + NFT
6173 IAD2 = ALE_CONNECT%ee_connect%iad_connect(II)
6174 CUMUL(1:3)=ZERO
6175 DO KFACE = 1, NB_FACE
6176 IV = ALE_CONNECT%ee_connect%connected(IAD2 + KFACE - 1)
6177 NX = ZERO !MULTI_FVM%FACE_DATA%NORMAL(1, KFACE, II)
6178 NY = MULTI_FVM%FACE_DATA%NORMAL(2, KFACE, II)
6179 NZ = MULTI_FVM%FACE_DATA%NORMAL(3, KFACE, II)
6180 SURF = MULTI_FVM%FACE_DATA%SURF(KFACE, II)
6181 VX = ZERO !MULTI_FVM%VEL(1, II)
6182 VY = MULTI_FVM%VEL(2, II)
6183 VZ = MULTI_FVM%VEL(3, II)
6184 IF(IV /=0)THEN
6185 VX = ZERO ! HALF(VX + MULTI_FVM%VEL(1, IV))
6186 VY = HALF*(VY + MULTI_FVM%VEL(2, IV))
6187 VZ = HALF*(VZ + MULTI_FVM%VEL(3, IV))
6188 ENDIF
6189 CUMUL(1)=CUMUL(1)+SURF*(NY*VZ-NZ*VY)
6190 !CUMUL(2)=CUMUL(2)+NZ*VX-NX*VZ
6191 !CUMUL(3)=CUMUL(3)+NX*VY-NY*VX
6192 ENDDO
6193 CUMUL(1)=CUMUL(1)/GBUF%VOL(I)
6194 VALUE(I) = CUMUL(1)
6195 IS_WRITTEN_VALUE(I) = 1
6196 ENDDO
6197 ENDIF
6198C--------------------------------------------------
6199 ELSEIF(KEYWORD == 'group')THEN
6200C--------------------------------------------------
6201 DO I=1,NEL
6202 VALUE(I) = NG
6203 IS_WRITTEN_VALUE(I) = 1
6204 ENDDO
6205C--------------------------------------------------
6206 ELSEIF(KEYWORD == 'internal.id')THEN
6207C--------------------------------------------------
6208 DO I=1,NEL
6209 VALUE(I) = I+NFT
6210 IS_WRITTEN_VALUE(I) = 1
6211 ENDDO
6212C--------------------------------------------------
6213 ELSEIF(KEYWORD == 'local.id')THEN
6214C--------------------------------------------------
6215 DO I=1,NEL
6216 VALUE(I) = I
6217 IS_WRITTEN_VALUE(I) = 1
6218 ENDDO
6219
6220C--------------------------------------------------
6221 ELSEIF(KEYWORD == 'vonm/tmax') THEN
6222C--------------------------------------------------
6223 DO I=1,NEL
6224 VALUE(I) = GBUF%TM_YIELD(I)
6225 IS_WRITTEN_VALUE(I) = 1
6226 ENDDO
6227C--------------------------------------------------
6228 ELSEIF(KEYWORD == 'sigeq/tmax') THEN
6229C--------------------------------------------------
6230 DO I=1,NEL
6231 VALUE(I) = GBUF%TM_SEQ(I)
6232 IS_WRITTEN_VALUE(I) = 1
6233 ENDDO
6234C--------------------------------------------------
6235 ELSEIF(KEYWORD == 'ener/tmax') THEN
6236C--------------------------------------------------
6237 DO I=1,NEL
6238 VALUE(I) = GBUF%TM_EINT(I)
6239 IS_WRITTEN_VALUE(I) = 1
6240 ENDDO
6241C--------------------------------------------------
6242 ELSEIF(KEYWORD == 'dama/tmax') THEN
6243C--------------------------------------------------
6244 DO I=1,NEL
6245 VALUE(I) = GBUF%TM_DMG(I)
6246 IS_WRITTEN_VALUE(I) = 1
6247 ENDDO
6248C--------------------------------------------------
6249 ELSEIF(KEYWORD == 'div(u)') THEN
6250C--------------------------------------------------
6251 !2d triangles
6252 IALEL=IPARG(7,NG)+IPARG(11,NG)
6253 IF(IALEL /= 0)THEN
6254 CALL OUTPUT_DIV_U(
6255 1 EVAR ,IXTG ,X ,V ,IPARG ,ELBUF_TAB ,NG ,NIXTG ,7,
6256 2 NUMELTG,NEL ,NUMNOD,NPARG,NGROUP,N2D ,NFT )
6257 DO I=1,NEL
6258 VALUE(I) = EVAR(I)
6259 IS_WRITTEN_VALUE(I) = 1
6260 ENDDO
6261 ENDIF
6262!--------------------------------------------------
6263 elseif(keyword == 'vstrain.and.' N2D > 0) then
6264!--------------------------------------------------
6265 do i=1,nel
6266 mt = ixtg(1,i+nft)
6267 if(mlw == 151)then
6268 !multimaterial 151 (collocated scheme)
6269 do ilay=1,nlay
6270 mid = MATPARAM(mt)%multimat%mid(ilay)
6271 rho0i (ilay) = pm(89,mid)
6272 Vi (ilay) = multi_fvm%phase_alpha(ilay,i+nft) * gbuf%vol(i)
6273 V0i (ilay) = multi_fvm%phase_rho(ilay,i+nft) * Vi(ilay) / rho0i(ilay) !rho0.V0 = rho.V
6274 enddo
6275 V0g = sum(V0i)
6276 RHO0g = zero
6277 do ilay=1,nlay
6278 RHO0g = RHO0g + rho0i(ilay)*V0i(ilay)
6279 end do
6280 RHO0g = RHO0g / V0g
6281 value(i) = multi_fvm%rho(i+nft) / RHO0g - ONE
6282 is_written_value(i) = 1
6283
6284 elseif(mlw == 51)then
6285 !multimaterial 51 (staggered scheme)
6286 imat = ixtg(1,nft+1)
6287 iadbuf = ipm(7,imat)
6288 nuparam= ipm(9,imat)
6289 uparam => bufmat(iadbuf:iadbuf+nuparam)
6290 mbuf => elbuf_tab(ng)%bufly(1)%mat(1,1,1)
6291 ipos = 1
6292 !bijective order !indexes
6293 isubmat = nint(uparam(276+1)); iu(1)=m51_n0phas+(isubmat-1)*m51_nvphas + ipos-1
6294 isubmat = nint(uparam(276+2)); iu(2)=m51_n0phas+(isubmat-1)*m51_nvphas + ipos-1
6295 isubmat = nint(uparam(276+3)); iu(3)=m51_n0phas+(isubmat-1)*m51_nvphas + ipos-1
6296 isubmat = nint(uparam(276+4)); iu(4)=m51_n0phas+(isubmat-1)*m51_nvphas + ipos-1
6297 vfrac(i,1) = mbuf%var(i+iu(1)*nel)
6298 vfrac(i,2) = mbuf%var(i+iu(2)*nel)
6299 vfrac(i,3) = mbuf%var(i+iu(3)*nel)
6300 vfrac(i,4) = mbuf%var(i+iu(4)*nel)
6301 ipos = 12
6302 !bijective order !indexes
6303 isubmat = nint(uparam(276+1)); iu(1)=m51_n0phas+(isubmat-1)*m51_nvphas + ipos-1
6304 isubmat = nint(uparam(276+2)); iu(2)=m51_n0phas+(isubmat-1)*m51_nvphas + ipos-1
6305 isubmat = nint(uparam(276+3)); iu(3)=m51_n0phas+(isubmat-1)*m51_nvphas + ipos-1
6306 isubmat = nint(uparam(276+4)); iu(4)=m51_n0phas+(isubmat-1)*m51_nvphas + ipos-1
6307 rhoi(1) = mbuf%var(i+iu(1)*nel)
6308 rhoi(2) = mbuf%var(i+iu(2)*nel)
6309 rhoi(3) = mbuf%var(i+iu(3)*nel)
6310 rhoi(4) = mbuf%var(i+iu(4)*nel)
6311 do ilay=1,4
6312 mid = MATPARAM(mt)%multimat%mid(ilay)
6313 rho0i (ilay) = pm(89,mid)
6314 Vi (ilay) = vfrac(i,ilay) * gbuf%vol(i)
6315 ipos = 12
6316 V0i (ilay) = rhoi(ilay) * Vi(ilay) / rho0i(ilay) !rho0.V0 = rho.V
6317 enddo
6318 V0g = sum(V0i)
6319 RHO0g = zero
6320 do ilay=1,4
6321 RHO0g = RHO0g + rho0i(ilay)*V0i(ilay)
6322 end do
6323 RHO0g = RHO0g / V0g
6324 value(i) = gbuf%rho(i) / RHO0g - ONE
6325 is_written_value(i) = 1
6326
6327 elseif(mlw == 37)then
6328 !multimaterial 37 (staggered scheme)
6329 imat = ixtg(1,nft+1)
6330 iadbuf = ipm(7,imat)
6331 nuparam= ipm(9,imat)
6332 uparam => bufmat(iadbuf:iadbuf+nuparam)
6333 mbuf => elbuf_tab(ng)%bufly(1)%mat(1,1,1)
6334 rho0i(1) = uparam(11)
6335 rho0i(2) = uparam(12)
6336 Vi(1) = mbuf%var(i+3*nel) * gbuf%vol(i) !UVAR(I,4) = VFRAC1
6337 Vi(2) = mbuf%var(i+4*nel) * gbuf%vol(i) !UVAR(I,5) = VFRAC2
6338 rhoi(1) = mbuf%var(i+2*nel) !UVAR(I,3) = RHO1
6339 rhoi(2) = mbuf%var(i+1*nel) !UVAR(I,2) = RHO2
6340 V0i(1) = rhoi(1) * Vi(1) / rho0i(1) !rho0.V0 = rho.V
6341 V0i(2) = rhoi(2) * Vi(2) / rho0i(2) !rho0.V0 = rho.V
6342 V0g = sum(V0i)
6343 RHO0g = zero
6344 do ilay=1,nlay
6345 RHO0g = RHO0g + rho0i(ilay)*V0i(ilay)
6346 end do
6347 RHO0g = RHO0g / V0g
6348 value(i) = gbuf%rho(i) / RHO0g - ONE
6349 is_written_value(i) = 1
6350
6351 elseif(mlw == 20)then
6352 !multimaterial 20 (staggered scheme)
6353 lbuf1 => elbuf_tab(ng)%bufly(1)%lbuf(1,1,1)
6354 lbuf2 => elbuf_tab(ng)%bufly(2)%lbuf(1,1,1)
6355 mid = MATPARAM(mt)%multimat%mid(1)
6356 rho0i(1) = pm(89,mid)
6357 mid = MATPARAM(mt)%multimat%mid(2)
6358 rho0i(2) = pm(89,mid)
6359 Vi(1) = lbuf1%vol(i)
6360 Vi(2) = lbuf2%vol(i)
6361 rhoi(1) = lbuf1%rho(i)
6362 rhoi(2) = lbuf2%rho(i)
6363 V0i(1) = rhoi(1) * Vi(1) / rho0i(1) !rho0.V0 = rho.V
6364 V0i(2) = rhoi(2) * Vi(2) / rho0i(2) !rho0.V0 = rho.V
6365 V0g = sum(V0i)
6366 RHO0g = zero
6367 do ilay=1,nlay
6368 RHO0g = RHO0g + rho0i(ilay)*V0i(ilay)
6369 end do
6370 RHO0g = RHO0g / V0g
6371 value(i) = gbuf%rho(i) / RHO0g - ONE
6372 is_written_value(i) = 1
6373
6374 else
6375 !general case (monomaterial law)
6376 if(pm(89,mt) > zero)then
6377 value(i) = gbuf%rho(i) / pm(89,mt) - one
6378 is_written_value(i) = 1
6379 end if
6380 end if
6381
6382 enddo
6383!--------------------------------------------------
6384 elseif(keyword(1:8) == 'vstrain/.and.' N2D > 0) then
6385!--------------------------------------------------
6386 detected = .false.
6387 read(keyword(9:), '(i2)', IOSTAT=ierr) ilay
6388.and. if(ierr == 0 ilay > 0) then
6389.and. if(mlw == 151 ilay <= min(10,multi_fvm%nbmat))detected = .true.
6390.and. if(mlw == 51 ilay <= 4 )detected = .true.
6391.and. if(mlw == 37 ilay <= 2 )detected = .true.
6392.and. if(mlw == 20 ilay <= 2 )detected = .true.
6393 end if
6394 if(detected)then
6395 do i=1,nel
6396 mt = ixtg(1,i+nft)
6397
6398 if(mlw == 151)then
6399 !multimaterial 151 (collocated scheme)
6400 mid = MATPARAM(mt)%multimat%mid(ilay)
6401 rho0i(ilay) = pm(89,mid)
6402 Vi(ilay) = multi_fvm%phase_alpha(ilay,i+nft) * gbuf%vol(i)
6403 V0i(ilay) = multi_fvm%phase_rho(ilay,i+nft) * Vi(ilay) / rho0i(ilay) !rho0.V0 = rho.V
6404 value(i) = multi_fvm%phase_rho(ilay,i+nft) / rho0i(ilay) - ONE
6405 is_written_value(i) = 1
6406
6407 elseif(mlw == 51)then
6408 !multimaterial 51 (staggered scheme)
6409 imat = ixtg(1,nft+1)
6410 iadbuf = ipm(7,imat)
6411 nuparam= ipm(9,imat)
6412 uparam => bufmat(iadbuf:iadbuf+nuparam)
6413 mbuf => elbuf_tab(ng)%bufly(1)%mat(1,1,1)
6414 mid = MATPARAM(mt)%multimat%mid(ilay)
6415 rho0i(ilay) = pm(89,mid)
6416 ipos = 1
6417 !bijective order !indexes
6418 isubmat = nint(uparam(276+ilay)); iu(1)=m51_n0phas+(isubmat-1)*m51_nvphas + ipos-1
6419 vfrac(i,ilay) = mbuf%var(i+iu(ilay)*nel)
6420 Vi(ilay) = vfrac(i,ilay) * gbuf%vol(i)
6421 ipos = 12
6422 !bijective order !indexes
6423 isubmat = nint(uparam(276+ilay)); iu(ilay)=m51_n0phas+(isubmat-1)*m51_nvphas + ipos-1
6424 rhoi(ilay) = mbuf%var(i+iu(ilay)*nel)
6425 V0i (ilay) = rhoi(ilay) * Vi(ilay) / rho0i(ilay) !rho0.V0 = rho.V
6426 value(i) = rhoi(ilay) / rho0i(ilay) - ONE
6427 is_written_value(i) = 1
6428
6429 elseif(mlw == 37)then
6430 !multimaterial 37 (staggered scheme)
6431 imat = ixtg(1,nft+1)
6432 iadbuf = ipm(7,imat)
6433 nuparam= ipm(9,imat)
6434 uparam => bufmat(iadbuf:iadbuf+nuparam)
6435 mbuf => elbuf_tab(ng)%bufly(1)%mat(1,1,1)
6436 rho0i(ilay) = uparam(10+ilay)
6437 Vi(ilay) = mbuf%var(i+(ilay+2)*nel) * gbuf%vol(i)
6438 rhoi(ilay) = mbuf%var(i+(3-ilay)*nel) !UVAR(I,3) = RHO1
6439 V0i(ilay) = rhoi(ilay) * Vi(ilay) / rho0i(ilay)
6440 value(i) = rhoi(ilay) / rho0i(ilay) - ONE
6441 is_written_value(i) = 1
6442
6443 elseif(mlw == 20)then
6444 !multimaterial 20 (staggered scheme)
6445 lbuf => elbuf_tab(ng)%bufly(ilay)%lbuf(1,1,1)
6446 mid = MATPARAM(mt)%multimat%mid(ilay)
6447 rho0i(ilay) = pm(89,mid)
6448 Vi(ilay) = lbuf%vol(i)
6449 rhoi(ilay) = lbuf%rho(i)
6450 V0i(ilay) = rhoi(ilay) * Vi(ilay) / rho0i(ilay) !rho0.V0 = rho.V
6451 value(i) = rhoi(ilay) / rho0i(ilay) - ONE
6452 is_written_value(i) = 1
6453
6454 else
6455 !general case (monomaterial law)
6456 is_written_value(i) = 0
6457 end if
6458 enddo
6459
6460 end if
6461!--------------------------------------------------
6462C--------------------------------------------------
6463 ENDIF ! KEYWORD
6464C--------------------------------------------------
6465 IF(CALLED_FROM_PYTHON) THEN
6466 SHELL_SCALAR(1:MVSIZ) = VALUE(1:MVSIZ)
6467 ELSE
6468 !< If LIGHT output activated, write only non-zero values
6469.AND. IF ((H3D_LIGHT > 0)(IS_LIGHTER)) THEN
6470 DO I = 1, NEL
6471 IF (VALUE(I) /= ZERO) THEN
6472 IS_WRITTEN_VALUE(I) = 1
6473 ELSE
6474 IS_WRITTEN_VALUE(I) = 0
6475 ENDIF
6476 ENDDO
6477 ENDIF
6478 CALL H3D_WRITE_SCALAR_STACK(IOK_PART,IS_WRITTEN_SHELL,SHELL_STACK,NEL,OFFSET,NFT,VALUE,
6479 * IS_WRITTEN_VALUE,SHELL_STACKSIZE)
6480 ENDIF
6481 ENDIF ! ITY
6482c
6483C-----------------------------------------------
6484 ENDIF ! MLW /= 13
6485C-----------------------------------------------
6486 RETURN
6487 END
alpha
#define alpha
Definition eval.h:35
h3d_shell_scalar_1
subroutine h3d_shell_scalar_1(called_from_python, elbuf_tab, shell_scalar, iparg, geo, ixc, ixtg, pm, bufmat, ehour, ipm, igeo, thke, err_thk_sh4, err_thk_sh3, x, v, w, ale_connect, stack, id_elem, ity_elem, is_written_shell, ipartc, iparttg, layer_input, ipt_input, ply_input, iuvar_input, h3d_part, keyword, d, ng, multi_fvm, idmds, imdsvar, mds_matid, id, mode, matparam, h3d_light, shell_stack, max_shell_stacksize, shell_stacksize)
Definition h3d_shell_scalar_1.F:57
area
subroutine area(d1, x, x2, y, y2, eint, stif0)
Definition hm_read_prop32.F:567
max
#define max(a, b)
Definition macros.h:21
ale_connectivity_mod
Definition ale_connectivity_mod.F:223
alefvm_mod
Definition alefvm_mod.F:88
alefvm_mod::alefvm_param
type(alefvm_param_), target alefvm_param
Definition alefvm_mod.F:121
initbuf_mod
Definition initbuf.F:160
initbuf_mod::initbuf
subroutine initbuf(iparg, ng, mtn, llt, nft, iad, ity, npt, jale, ismstr, jeul, jtur, jthe, jlag, jmult, jhbe, jivf, mid, jpor, jcvt, jclose, jpla, irep, iint, igtyp, israt, isrot, icsen, isorth, isorthg, ifailure, jsms)
Definition initbuf.F:261
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
schlieren_mod
Definition schlieren_mod.F:46
stack_mod
Definition stack_mod.F:72
stack_mod::ply_info
integer, dimension(:,:), allocatable ply_info
Definition stack_mod.F:133