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