OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
h3d_solid_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_solid_scalar_1 ../engine/source/output/h3d/h3d_results/h3d_solid_scalar_1.F
25!||--- called by ------------------------------------------------------
26!|| funct_python_update_elements ../engine/source/tools/curve/funct_python_update_elements.F90
27!|| h3d_solid_scalar ../engine/source/output/h3d/h3d_results/h3d_solid_scalar.F
28!||--- calls -----------------------------------------------------
29!|| h3d_write_scalar ../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!|| srotorth ../engine/source/elements/solid/srotorth.F
34!|| ths_marea ../engine/source/output/h3d/h3d_results/h3d_solid_scalar_1.F
35!|| ths_vol ../engine/source/output/h3d/h3d_results/h3d_solid_scalar_1.F
36!||--- uses -----------------------------------------------------
37!|| ale_connectivity_mod ../common_source/modules/ale/ale_connectivity_mod.F
38!|| aleanim_mod ../engine/share/modules/aleanim_mod.F
39!|| alefvm_mod ../common_source/modules/ale/alefvm_mod.F
40!|| elbufdef_mod ../common_source/modules/mat_elem/elbufdef_mod.F90
41!|| h3d_mod ../engine/share/modules/h3d_mod.F
42!|| initbuf_mod ../engine/share/resol/initbuf.F
43!|| mat_elem_mod ../common_source/modules/mat_elem/mat_elem_mod.F90
44!|| matparam_def_mod ../common_source/modules/mat_elem/matparam_def_mod.F90
45!|| multi_fvm_mod ../common_source/modules/ale/multi_fvm_mod.F90
46!|| multimat_param_mod ../common_source/modules/multimat_param_mod.F90
47!|| names_and_titles_mod ../common_source/modules/names_and_titles_mod.F
48!|| schlieren_mod ../engine/share/modules/schlieren_mod.F
49!||====================================================================
50 SUBROUTINE h3d_solid_scalar_1(CALLED_FROM_PYTHON,
51 . ELBUF_TAB ,SOLID_SCALAR ,IPARG ,
52 . IXS ,PM ,BUFMAT ,
53 . EHOUR ,
54 . IPM ,
55 . X ,V ,W ,ALE_CONNECT ,
56 . ID_ELEM ,ITY_ELEM ,IPARTS ,LAYER_INPUT ,
57 . IR_INPUT ,IS_INPUT ,IT_INPUT ,IUVAR_INPUT , H3D_PART ,
58 . IS_WRITTEN_SOLID,INFO1 ,KEYWORD ,FANI_CELL ,
59 . MULTI_FVM ,NG ,IDMDS ,IMDSVAR ,
60 . ID ,MAT_PARAM ,MODE )
61C-----------------------------------------------
62C M o d u l e s
63C-----------------------------------------------
64 USE initbuf_mod
65 USE mat_elem_mod
66 USE elbufdef_mod
67 USE schlieren_mod
68 USE h3d_mod
69 USE multi_fvm_mod
70 USE ale_connectivity_mod
71 USE alefvm_mod , only:alefvm_param
72 USE aleanim_mod , ONLY : fani_cell_
73 USE names_and_titles_mod, ONLY: ncharline100
74 USE multimat_param_mod , ONLY : m51_n0phas, m51_nvphas
75 USE matparam_def_mod , ONLY : matparam_struct_
76C-----------------------------------------------
77C I m p l i c i t T y p e s
78C-----------------------------------------------
79#include "implicit_f.inc"
80C-----------------------------------------------
81C C o m m o n B l o c k s
82C-----------------------------------------------
83C argument for initbuf
84#include "vect01_c.inc"
85#include "mvsiz_p.inc"
86!NGROUP NFILSOL N2D
87#include "com01_c.inc"
88!NUMELS NUMNOD
89#include "com04_c.inc"
90!NPROPM, NPROPMI NPARG
91#include "param_c.inc"
92!ISPMD
93#include "task_c.inc"
94C-----------------------------------------------
95C D u m m y A r g u m e n t s
96C-----------------------------------------------
97 LOGICAL, INTENT(IN) :: CALLED_FROM_PYTHON
98 my_real
99 . SOLID_SCALAR(*),X(3,*),V(3,*),W(3,*),EHOUR(*),
100 . PM(NPROPM,*)
101 my_real, INTENT(IN),TARGET :: BUFMAT(*)
102 INTEGER IPARG(NPARG,*),IXS(NIXS,*),
103 . IPM(NPROPMI,*),
104 . ID_ELEM(*),ITY_ELEM(*),IPARTS(*),ID,
105 . H3D_PART(*),IS_WRITTEN_SOLID(*),INFO1,LAYER_INPUT,IR_INPUT,IS_INPUT,IT_INPUT,
106 . IUVAR_INPUT,NG,IDMDS,IMDSVAR
107 TYPE (ELBUF_STRUCT_), DIMENSION(NGROUP), TARGET :: ELBUF_TAB
108 CHARACTER(NCHARLINE100):: KEYWORD
109 TYPE(FANI_CELL_), INTENT(IN) :: FANI_CELL
110 TYPE(MULTI_FVM_STRUCT), INTENT(IN) :: MULTI_FVM
111 TYPE(t_ale_connectivity), INTENT(IN) :: ALE_CONNECT
112 TYPE (MATPARAM_STRUCT_) ,DIMENSION(NUMMAT) ,INTENT(IN) :: MAT_PARAM
113 INTEGER ,INTENT(IN) :: MODE
114C-----------------------------------------------
115C L o c a l V a r i a b l e s
116C-----------------------------------------------
117 my_real
118 . evar(mvsiz),
119 . value(mvsiz),mass(mvsiz),pres(mvsiz),mass0,vol
120 my_real
121 . off, p,vonm2,s1,s2,s3,dmgmx,fac,
122 . s11,s22,s33,s4,s5,s6,vonm,gama(6),
123 . t11,t21,t31,t12,t22,t32,t13,t23,t33,
124 . phi,theta,psi,dammax,vel(0:3),vfrac(mvsiz,1:21),
125 . cumul(3),vx,vy,vz,nx,ny,nz,surf,tmp_2(mvsiz,3),
126 . volfrac,bfrac
127 my_real
128 . g1(mvsiz,3),g2(mvsiz,3),g3(mvsiz,3),voln(mvsiz),aream(mvsiz),
129 . rho0,det(mvsiz),ezz(mvsiz),maxdamini,e33
130 INTEGER I,II,J,NEL,NPTR,NPTS,NPTT,NLAY,L,IFAIL,ILAY,
131 . IR,IS,IT,IL,MLW, NUVAR,IUS,NFAIL,
132 . N,K,JTURB,MT,IALEL,
133 . NLAY_FAIL,
134 . OFFSET, IPT,
135 . IUVAR,IPOS,ITRIMAT,
136 . IALEFVM_FLG, IMAT,IADBUF,NUPARAM,ICSIG,NC(8),IEOS,NMOD,MAT_ID,FAIL_ID
137 integer
138 . isolnod,ivisc,nptg,tshell,tsh_ort,
139 . iok_part(mvsiz),jj(6),irupt,iok,npg_plane,iir,
140 . is_written_value(mvsiz),nfrac,iu(4),iv,nb_face,kface,is_euler,is_ale,iad2,
141 . submatlaw
142 LOGICAL DETECTED
143 CHARACTER*5 BUFF
144 TYPE(G_BUFEL_) ,POINTER :: GBUF
145 TYPE(L_BUFEL_) ,POINTER :: LBUF, LBUF1,LBUF2
146 TYPE(BUF_MAT_) ,POINTER :: MBUF
147 TYPE(buf_fail_) ,POINTER :: FBUF
148 TYPE(BUF_EOS_) ,POINTER :: EBUF
149 my_real, DIMENSION(:), POINTER :: UVARF,DAMF,DFMAX,TDELE
150 my_real, DIMENSION(:) ,POINTER :: UPARAM
151 INTEGER :: ISUBMAT,NVAREOS,NTILLOTSON,IMAT_TILLOTSON
152 INTEGER :: MID,IERR
153 my_real :: vi(21) !< submaterial volumes at reference densities (max submat : 21)
154 my_real :: v0i(21) !< submaterial volumes at reference densities (max submat : 21)
155 my_real :: v0g !< global volume at reference density (mixture)
156 my_real :: rho0i(21) !< submaterial initial mass densities (max submat : 21)
157 my_real :: rhoi(21) !< submaterial mass densities (max submat : 21)
158 my_real :: rho0g !< global initial mass density (mixture)
159C-----------------------------------------------
160
161 CALL initbuf( iparg ,ng ,
162 2 mlw ,nel ,nft ,iad ,ity ,
163 3 npt ,jale ,ismstr ,jeul ,jtur ,
164 4 jthe ,jlag ,jmult ,jhbe ,jivf ,
165 5 nvaux ,jpor ,jcvt ,jclose ,jplasol ,
166 6 irep ,iint ,igtyp ,israt ,isrot ,
167 7 icsen ,isorth ,isorthg ,ifailure,jsms )
168
169 IF (mlw /= 13) THEN
170 nft = iparg(3,ng)
171 isolnod = iparg(28,ng)
172 ivisc = iparg(61,ng)
173 iok_part(1:nel) = 0
174 lft=1
175 llt=nel
176 is_euler=iparg(11,ng)
177 is_ale=iparg(7,ng)
178c
179 DO i=1,6
180 jj(i) = nel*(i-1)
181 ENDDO
182c
183 DO i=1,nel
184 value(i) = zero
185 is_written_value(i) = 0
186 ENDDO
187C-----------------------------------------------
188 IF (ity == 1) THEN
189c SOLID ELEMENTS
190 IF (jcvt==1.AND.isorth/=0) jcvt=2
191C-----------------------------------------------
192 gbuf => elbuf_tab(ng)%GBUF
193 mbuf => elbuf_tab(ng)%BUFLY(1)%MAT(1,1,1)
194 lbuf => elbuf_tab(ng)%BUFLY(1)%LBUF(1,1,1)
195 ebuf => elbuf_tab(ng)%BUFLY(1)%EOS(1,1,1)
196 nlay = elbuf_tab(ng)%NLAY
197 nptr = elbuf_tab(ng)%NPTR
198 npts = elbuf_tab(ng)%NPTS
199 nptt = elbuf_tab(ng)%NPTT
200 nptg = nptt*npts*nptr*nlay
201 nvareos = elbuf_tab(ng)%BUFLY(1)%NVAR_EOS
202 tshell = 0
203 tsh_ort = 0
204 IF (igtyp==20 .OR. igtyp==21 .OR. igtyp==22) tshell = 1
205 IF (igtyp==21 .OR. igtyp==22) tsh_ort = 1
206
207 IF (ity == 1) offset = 0
208c
209 IF(.NOT. called_from_python) THEN
210 DO i=1,nel
211 IF (ity == 1) THEN
212 id_elem(offset+nft+i) = ixs(nixs,nft+i)
213 ity_elem(offset+nft+i) = 1
214 IF( h3d_part(iparts(nft+i)) == 1) iok_part(i) = 1
215 ENDIF
216 ENDDO
217 ENDIF
218c
219 ilay = layer_input
220 iuvar = iuvar_input
221 IF (keyword == 'MDS') iuvar = imdsvar
222 ir = ir_input
223 is = is_input
224 it = it_input
225 IF (ilay == -2) ilay = 1
226 IF (ilay == -3) ilay = nlay
227 IF (tshell == 1.AND.(ir_input/=-1.AND.is_input/=-1.AND.it_input/=-1)) THEN
228 IF (jhbe==15 ) THEN
229 ilay = is_input
230 ir = 1
231 is = 1
232 it = 1
233 ELSEIF (jhbe==14 ) THEN
234 icsig = iparg(17,ng)
235 IF (icsig==100) THEN
236 ir = is_input
237 is = it_input
238 ilay = ir_input
239 ELSEIF (icsig==10) THEN
240 ilay = is_input
241 ir = it_input
242 is = ir_input
243 ELSEIF (icsig==1) THEN
244 ilay = it_input
245 END IF
246 it = 1
247 ELSE
248 ilay = is_input
249 is = 1
250 END IF
251 END IF
252C-----------------------------------------------
253C Mass computation
254C-----------------------------------------------
255 IF (keyword == 'MASS') THEN
256 gbuf => elbuf_tab(ng)%GBUF
257 ialel=iparg(7,ng)+iparg(11,ng)
258 DO i=1,nel
259 n = i + nft
260 IF (mlw == 0 .or. mlw == 13 .or. igtyp == 0) THEN
261 mass(i) = zero
262 ELSEIF(ialel == 0)THEN
263 mt=ixs(1,n)
264 mass(i)=pm(89,mt)*gbuf%VOL(i)
265 ELSE
266 off = min(gbuf%OFF(i),one)
267 mass(i)=gbuf%RHO(i)*gbuf%VOL(i)*off
268 ENDIF
269 IF( nfilsol /= 0 .AND. gbuf%G_FILL /= 0 )
270 . mass(i) = mass(i) * gbuf%FILL(i)
271 ENDDO
272 ENDIF
273C-----------
274 IF (mlw /= 0 .and. mlw /= 13 .and. igtyp /= 0) THEN
275 jturb=iparg(12,ng)*(iparg(7,ng)+iparg(11,ng))
276C--------------------------------------------------
277 IF (keyword == 'MASS') THEN ! MASS
278C--------------------------------------------------
279 DO i=1,nel
280 value(i) = mass(i)
281 is_written_value(i) = 1
282 ENDDO
283C--------------------------------------------------
284 ELSEIF(keyword == 'DT')THEN
285C--------------------------------------------------
286 IF(gbuf%G_DT>0)THEN
287 DO i=1,nel
288 VALUE(i) = gbuf%DT(i)
289 is_written_value(i) = 1
290 ENDDO
291 ENDIF
292C--------------------------------------------------
293 ELSEIF(keyword == 'EPSP' .AND. (mlw /= 12 .AND. mlw /=14 .AND. mlw /= 25))THEN
294C--------------------------------------------------
295 IF (ilay == -1) THEN
296 DO i=1,nel
297 IF (mlw == 10 .OR. mlw == 21) THEN
298 value(i) = lbuf%EPSQ(i)
299 is_written_value(i) = 1
300 ELSEIF (gbuf%G_PLA > 0) THEN
301 value(i) = gbuf%PLA(i)
302 is_written_value(i) = 1
303 ENDIF
304 ENDDO
305 ELSE
306 DO i=1,nel
307 IF(elbuf_tab(ng)%BUFLY(ilay)%L_PLA > 0) THEN
308 value(i) = elbuf_tab(ng)%BUFLY(ilay)%LBUF(1,1,1)%PLA(i)
309 is_written_value(i) = 1
310 ENDIF
311 ENDDO
312 ENDIF
313
314C--------------------------------------------------
315 ELSEIF(keyword == 'WPLA' .AND. (mlw == 12 .OR. mlw == 14 .OR. mlw == 25))THEN
316C--------------------------------------------------
317 DO i=lft,llt
318 value(i) = zero
319 ENDDO
320 IF (isolnod == 16 .OR. isolnod == 20.OR.
321 . (isolnod == 8 .AND.jhbe == 14).OR.
322 . ((isolnod == 6 .OR.i solnod == 8).AND.jhbe == 15))THEN
323 DO il=1,nlay
324 IF (elbuf_tab(ng)%BUFLY(il)%L_PLA > 0) THEN
325 DO is=1,npts
326 DO it=1,nptt
327 DO ir=1,nptr
328 lbuf=>elbuf_tab(ng)%BUFLY(il)%LBUF(ir,is,it)
329 DO i=lft,llt
330 value(i) = value(i) + lbuf%PLA(i)/nptg
331 is_written_value(i) = 1
332 ENDDO
333 ENDDO
334 ENDDO
335 ENDDO
336 ENDIF
337 ENDDO
338 ELSE
339 DO i=lft,llt
340 IF (gbuf%G_PLA > 0)THEN
341 value(i) = gbuf%PLA(i)
342 is_written_value(i) = 1
343 ENDIF
344 ENDDO
345 ENDIF ! Isolid ...
346C--------------------------------------------------
347 ELSEIF (keyword == 'TSAIWU' .AND. gbuf%G_TSAIWU > 0) THEN
348C--------------------------------------------------
349 DO i=lft,llt
350 value(i) = zero
351 ENDDO
352 DO il=1,nlay
353 IF (elbuf_tab(ng)%BUFLY(il)%L_TSAIWU > 0) THEN
354 DO is=1,npts
355 DO it=1,nptt
356 DO ir=1,nptr
357 lbuf=>elbuf_tab(ng)%BUFLY(il)%LBUF(ir,is,it)
358 DO i=lft,llt
359 value(i) = value(i) + lbuf%TSAIWU(i)/nptg
360 is_written_value(i) = 1
361 ENDDO
362 ENDDO
363 ENDDO
364 ENDDO
365 ENDIF
366 ENDDO
367C--------------------------------------------------
368 ELSEIF(keyword == 'DENS')THEN
369C--------------------------------------------------
370 IF (mlw == 151) THEN
371 DO i = 1, nel
372 value(i) = multi_fvm%RHO(i + nft)
373 is_written_value(i) = 1
374 ENDDO
375 ELSE
376 DO i=1,nel
377 value(i) = gbuf%RHO(i)
378 is_written_value(i) = 1
379 ENDDO
380 ENDIF
381C--------------------------------------------------
382 ELSEIF(keyword == 'TEMP')THEN
383C--------------------------------------------------
384 IF (jthe /= 0) THEN
385 value(1:nel) = elbuf_tab(ng)%GBUF%TEMP(1:nel)
386 is_written_value(1:nel) = 1
387 ELSE
388 value(1:nel) = zero
389 DO il=1,nlay
390 IF (elbuf_tab(ng)%BUFLY(il)%L_TEMP > 0) THEN
391 is_written_value(1:nel) = 1
392 DO it=1,elbuf_tab(ng)%BUFLY(il)%NPTT
393 DO is=1,npts
394 DO ir=1,nptr
395 lbuf => elbuf_tab(ng)%BUFLY(il)%LBUF(ir,is,it)
396 value(1:nel) = value(1:nel) + lbuf%TEMP(1:nel)/nptg
397 ENDDO
398 ENDDO
399 ENDDO
400 ENDIF
401 ENDDO
402 ENDIF
403C--------------------------------------------------
404 ELSEIF(keyword == 'P')THEN
405C--------------------------------------------------
406 IF (mlw == 151) THEN
407 DO i = 1, nel
408 value(i) = multi_fvm%PRES(i + nft)
409 is_written_value(i) = 1
410 ENDDO
411 ELSE
412 DO i=1,nel
413 ii = (i-1)*6
414 n = i + nft
415 s11 = gbuf%SIG(jj(1) + i)
416 s22 = gbuf%SIG(jj(2) + i)
417 s33 = gbuf%SIG(jj(3) + i)
418 s4 = gbuf%SIG(jj(4) + i)
419 s5 = gbuf%SIG(jj(5) + i)
420 s6 = gbuf%SIG(jj(6) + i)
421 IF(ivisc > 0 ) THEN
422 s11 = s11 + lbuf%VISC(jj(1) + i)
423 s22 = s22 + lbuf%VISC(jj(2) + i)
424 s33 = s33 + lbuf%VISC(jj(3) + i)
425 s4 = s4 + lbuf%VISC(jj(4) + i)
426 s5 = s5 + lbuf%VISC(jj(5) + i)
427 s6 = s6 + lbuf%VISC(jj(6) + i)
428 ENDIF
429 p = - (s11 + s22 + s33 ) * third
430 value(i) = p
431 is_written_value(i) = 1
432 ENDDO
433 ENDIF
434C--------------------------------------------------
435 ELSEIF(keyword == 'VONM')THEN
436C--------------------------------------------------
437 DO i=1,nel
438 n = i + nft
439 s11 = gbuf%SIG(jj(1) + i)
440 s22 = gbuf%SIG(jj(2) + i)
441 s33 = gbuf%SIG(jj(3) + i)
442 s4 = gbuf%SIG(jj(4) + i)
443 s5 = gbuf%SIG(jj(5) + i)
444 s6 = gbuf%SIG(jj(6) + i)
445 IF(ivisc > 0 ) THEN
446 s11 = s11 + lbuf%VISC(jj(1) + i)
447 s22 = s22 + lbuf%VISC(jj(2) + i)
448 s33 = s33 + lbuf%VISC(jj(3) + i)
449 s4 = s4 + lbuf%VISC(jj(4) + i)
450 s5 = s5 + lbuf%VISC(jj(5) + i)
451 s6 = s6 + lbuf%VISC(jj(6) + i)
452 ENDIF
453 p = - (s11 + s22 + s33 ) * third
454 s1= s11 + p
455 s2= s22 + p
456 s3= s33 + p
457 vonm2= three*(s4*s4 + s5*s5 + s6*s6 +
458 . half*(s1*s1 + s2*s2 + s3*s3) )
459 vonm= sqrt(vonm2)
460 value(i) = vonm
461 IF( nfilsol /= 0 .AND. gbuf%G_FILL /= 0 )
462 . value(i) = value(i) * gbuf%FILL(i)
463 is_written_value(i) = 1
464 ENDDO
465C--------------------------------------------------
466 ELSEIF(keyword == 'K' .and. jturb /= 0)THEN
467C--------------------------------------------------
468C ENERGIE TURBULENTE
469 DO i=1,nel
470 value(i) = gbuf%RK(i)
471 is_written_value(i) = 1
472 ENDDO
473C--------------------------------------------------
474 ELSEIF(keyword == 'TVIS')THEN
475C--------------------------------------------------
476C VISCOSITE TURBULENTE
477 DO i=1,nel
478 n = i + nft
479 IF((mlw == 6 .OR. mlw == 17).AND.jturb/=0)THEN
480 mt=ixs(1,n)
481 value(i) = pm(81,mt) * gbuf%RK(i)**2
482 . / max(em15,gbuf%RE(i))
483 is_written_value(i) = 1
484 ELSEIF(mlw == 46 .OR. mlw == 47)THEN
485 value(i) = mbuf%VAR(i)
486 is_written_value(i) = 1
487 ENDIF
488 ENDDO
489C--------------------------------------------------
490 ELSEIF(keyword == 'VORTX')THEN
491C--------------------------------------------------
492C VORTICITY-X
493 IF(mlw /= 151)THEN
494 DO i=1,nel
495 value(i) = fani_cell%VORT_X(i+nft)
496 is_written_value(i) = 1
497 ENDDO
498 ELSEIF(mlw == 151)THEN
499 !ITY = IPARG(5, NG)
500 nb_face = 6
501 DO i=1,nel
502 ii = i + nft
503 iad2 = ale_connect%ee_connect%iad_connect(ii)
504 nb_face = ale_connect%ee_connect%iad_connect(ii+1)-iad2
505 cumul(1:3)=zero
506 DO kface = 1, nb_face
507 iv = ale_connect%ee_connect%connected(iad2 + kface - 1)
508 nx = zero !MULTI_FVM%FACE_DATA%NORMAL(1, KFACE, II)
509 ny = multi_fvm%FACE_DATA%NORMAL(2, kface, ii)
510 nz = multi_fvm%FACE_DATA%NORMAL(3, kface, ii)
511 surf = multi_fvm%FACE_DATA%SURF(kface, ii)
512 vx = zero !MULTI_FVM%VEL(1, II)
513 vy = multi_fvm%VEL(2, ii)
514 vz = multi_fvm%VEL(3, ii)
515 IF(iv /=0)THEN
516 vx = zero ! HALF(VX + MULTI_FVM%VEL(1, IV))
517 vy = half*(vy + multi_fvm%VEL(2, iv))
518 vz = half*(vz + multi_fvm%VEL(3, iv))
519 ENDIF
520 cumul(1)=cumul(1)+surf*(ny*vz-nz*vy)
521 !CUMUL(2)=CUMUL(2)+NZ*VX-NX*VZ
522 !CUMUL(3)=CUMUL(3)+NX*VY-NY*VX
523 ENDDO
524 cumul(1)=cumul(1)/gbuf%VOL(i)
525 value(i) = cumul(1)
526 is_written_value(i) = 1
527 ENDDO
528 ENDIF
529C--------------------------------------------------
530 ELSEIF(keyword == 'VORTY')THEN
531C--------------------------------------------------
532C VORTICITY-Y
533 IF(mlw /= 151)THEN
534 DO i=1,nel
535 value(i) = fani_cell%VORT_Y(i+nft)
536 is_written_value(i) = 1
537 ENDDO
538 ELSEIF(mlw == 151)THEN
539 !ITY = IPARG(5, NG)
540 nb_face = 6
541
542 DO i=1,nel
543 ii = i + nft
544 iad2 = ale_connect%ee_connect%iad_connect(ii)
545 nb_face = ale_connect%ee_connect%iad_connect(ii+1)-iad2
546 cumul(1:3)=zero
547 DO kface = 1, nb_face
548 iv = ale_connect%ee_connect%connected(iad2 + kface - 1)
549 nx = multi_fvm%FACE_DATA%NORMAL(1, kface, ii)
550 ny = zero !MULTI_FVM%FACE_DATA%NORMAL(2, KFACE, II)
551 nz = multi_fvm%FACE_DATA%NORMAL(3, kface, ii)
552 surf = multi_fvm%FACE_DATA%SURF(kface, ii)
553 vx = multi_fvm%VEL(1, ii)
554 vy = zero !MULTI_FVM%VEL(2, II)
555 vz = multi_fvm%VEL(3, ii)
556 IF(iv /=0)THEN
557 vx = half*(vx + multi_fvm%VEL(1, iv))
558 vy = zero !HALF(VY + MULTI_FVM%VEL(2, IV))
559 vz = half*(vz + multi_fvm%VEL(3, iv))
560 ENDIF
561 !CUMUL(1)=CUMUL(1)+NY*VZ-NZ*VY
562 cumul(2)=cumul(2)+surf*(nz*vx-nx*vz)
563 !CUMUL(3)=CUMUL(3)+NX*VY-NY*VX
564 ENDDO
565 cumul(2)=cumul(2)/gbuf%VOL(i)
566 value(i) = cumul(2)
567 is_written_value(i) = 1
568 ENDDO
569 ENDIF
570C--------------------------------------------------
571 ELSEIF(keyword == 'VORTZ')THEN
572C--------------------------------------------------
573C VORTICITY-Z
574 IF(mlw /= 151)THEN
575 DO i=1,nel
576 value(i) = fani_cell%VORT_Z(i+nft)
577 is_written_value(i) = 1
578 ENDDO
579 ELSEIF(mlw == 151)THEN
580 !ITY = IPARG(5, NG)
581 nb_face = 6
582 DO i=1,nel
583 ii = i + nft
584 iad2 = ale_connect%ee_connect%iad_connect(ii)
585 nb_face = ale_connect%ee_connect%iad_connect(ii+1)-iad2
586 cumul(1:3)=zero
587 DO kface = 1, nb_face
588 iv = ale_connect%ee_connect%connected(iad2 + kface - 1)
589 nx = multi_fvm%FACE_DATA%NORMAL(1, kface, ii)
590 ny = multi_fvm%FACE_DATA%NORMAL(2, kface, ii)
591 nz = zero !MULTI_FVM%FACE_DATA%NORMAL(3, KFACE, II)
592 surf = multi_fvm%FACE_DATA%SURF(kface, ii)
593 vx = multi_fvm%VEL(1, ii)
594 vy = multi_fvm%VEL(2, ii)
595 vz = zero !MULTI_FVM%VEL(3, II)
596 IF(iv /=0)THEN
597 vx = half*(vx + multi_fvm%VEL(1, iv))
598 vy = half*(vy + multi_fvm%VEL(2, iv))
599 vz = zero !HALF(VZ + MULTI_FVM%VEL(3, IV))
600 ENDIF
601 !CUMUL(1)=CUMUL(1)+NY*VZ-NZ*VY
602 !CUMUL(2)=CUMUL(2)+NZ*VX-NX*VZ
603 cumul(3)=cumul(3)+surf*(nx*vy-ny*vx)
604 ENDDO
605 cumul(3)=cumul(3)/gbuf%VOL(i)
606 value(i) = cumul(3)
607 is_written_value(i) = 1
608 ENDDO
609 ENDIF
610C--------------------------------------------------
611 ELSEIF(keyword == 'VORT')THEN
612C--------------------------------------------------
613C VORTICITE
614 DO i=1,nel
615 IF(mlw == 6 .OR. mlw == 17)THEN
616 value(i) = lbuf%VK(i)
617 is_written_value(i) = 1
618 ELSEIF(mlw == 46 .OR. mlw == 47)THEN
619 value(i) = mbuf%VAR(nel+i) ! UVAR(I,2)
620 is_written_value(i) = 1
621 ENDIF
622 ENDDO
623C--------------------------------------------------
624 ELSEIF(keyword == 'DAM1' .AND.mlw == 24)THEN
625C--------------------------------------------------
626C dam 1
627 DO i=1,nel
628 value(i) = lbuf%DAM(jj(1) + i)
629 is_written_value(i) = 1
630 ENDDO
631C--------------------------------------------------
632 ELSEIF(keyword == 'DAM2' .AND.mlw == 24)THEN
633C--------------------------------------------------
634C dam 2
635 DO i=1,nel
636 value(i) = lbuf%DAM(jj(2) + i)
637 is_written_value(i) = 1
638 ENDDO
639C--------------------------------------------------
640 ELSEIF(keyword == 'DAM3' .AND.mlw == 24)THEN
641C--------------------------------------------------
642C dam 3
643 DO i=1,nel
644 value(i) = lbuf%DAM(jj(3) + i)
645 is_written_value(i) = 1
646 ENDDO
647C--------------------------------------------------
648 ELSEIF(keyword == 'SIGX')THEN
649C--------------------------------------------------
650 DO i=1,nel
651 value(i) = gbuf%SIG(jj(1) + i)
652 is_written_value(i) = 1
653 IF( nfilsol /= 0 .AND. gbuf%G_FILL /= 0 )
654 . value(i) = value(i) * gbuf%FILL(i)
655 IF(ivisc > 0) THEN
656 value(i) = value(i) + lbuf%VISC(jj(1)+i)
657 ENDIF
658 ENDDO
659C--------------------------------------------------
660 ELSEIF(keyword == 'SIGY')THEN
661C--------------------------------------------------
662 DO i=1,nel
663 value(i) = gbuf%SIG(jj(2) + i)
664 is_written_value(i) = 1
665 IF( nfilsol /= 0 .AND. gbuf%G_FILL /= 0 )
666 . value(i) = value(i) * gbuf%FILL(i)
667 IF(ivisc > 0) THEN
668 value(i) = value(i) + lbuf%VISC(jj(2)+i)
669 ENDIF
670 ENDDO
671C--------------------------------------------------
672 ELSEIF(keyword == 'SIGZ')THEN
673C--------------------------------------------------
674 DO i=1,nel
675 value(i) = gbuf%SIG(jj(3) + i)
676 is_written_value(i) = 1
677 IF( nfilsol /= 0 .AND. gbuf%G_FILL /= 0 )
678 . VALUE(i) = value(i) * gbuf%FILL(i)
679 IF(ivisc > 0) THEN
680 value(i) = value(i) + lbuf%VISC(jj(3)+i)
681 ENDIF
682 ENDDO
683C--------------------------------------------------
684 ELSEIF(keyword == 'SIGXY')THEN
685C--------------------------------------------------
686 DO i=1,nel
687 value(i) = gbuf%SIG(jj(4) + i)
688 is_written_value(i) = 1
689 IF( nfilsol /= 0 .AND. gbuf%G_FILL /= 0 )
690 . value(i) = value(i) * gbuf%FILL(i)
691 IF(ivisc > 0) THEN
692 value(i) = value(i) + lbuf%VISC(jj(4)+i)
693 ENDIF
694 ENDDO
695C--------------------------------------------------
696 ELSEIF(keyword == 'SIGYZ')THEN
697C--------------------------------------------------
698 DO i=1,nel
699 value(i) = gbuf%SIG(jj(5) + i)
700 is_written_value(i) = 1
701 IF( nfilsol /= 0 .AND. gbuf%G_FILL /= 0 )
702 . value(i) = value(i) * gbuf%FILL(i)
703 IF(ivisc > 0) THEN
704 value(i) = value(i) + lbuf%VISC(jj(5)+i)
705 ENDIF
706 ENDDO
707C--------------------------------------------------
708 ELSEIF(keyword == 'SIZX')THEN
709C--------------------------------------------------
710 DO i=1,nel
711 value(i) = gbuf%SIG(jj(6) + i)
712 is_written_value(i) = 1
713 IF( nfilsol /= 0 .AND. gbuf%G_FILL /= 0 )
714 . value(i) = value(i) * gbuf%FILL(i)
715 IF(ivisc > 0) THEN
716 value(i) = value(i) + lbuf%VISC(jj(6)+i)
717 ENDIF
718 ENDDO
719C--------------------------------------------------
720 ELSEIF((keyword == 'USER' .AND. mlw>=28 .AND. mlw/=51) .OR. keyword == 'MDS') THEN
721C--------------------------------------------------
722c UVAR=IUVAR
723 imat = ixs(1,nft+1)
724 IF( (keyword == 'MDS' .AND. imat == idmds) .OR. keyword == 'USER' )THEN
725 IF ( iuvar > 0) THEN
726 IF (isolnod == 8 .AND. mlw == 59) THEN
727c output = global damage variables of /fail/connect
728 mt = ixs(1,nft+1)
729 irupt = mat_param(mt)%FAIL(1)%IRUPT
730 nfail = elbuf_tab(ng)%BUFLY(1)%NFAIL
731 IF (irupt == 20) THEN
732 nptg = 4
733 DO ir=1,nfail
734 DO ipt = 1,nptg
735 uvarf =>
736 . elbuf_tab(ng)%BUFLY(1)%FAIL(ipt,1,1)%FLOC(ir)%VAR
737 DO i=1,nel
738 value(i) = max(value(i),uvarf((iuvar-1)*nel + i))
739 is_written_value(i) = 1
740 ENDDO
741 ENDDO
742 ENDDO
743 ENDIF
744 ELSE
745 DO il=1,nlay
746 DO is=1,npts
747 DO it=1,nptt
748 DO ir=1,nptr
749 mbuf => elbuf_tab(ng)%BUFLY(il)%MAT(ir,is,it)
750 DO i=1,nel
751 n = i + nft
752 mt=ixs(1,n)
753 nuvar = ipm(8,mt)
754 IF (iuvar <= nuvar) THEN
755 value(i) = value(i)
756 . + mbuf%VAR(i+(iuvar-1)*nel)/nptg
757 is_written_value(i) = 1
758 ENDIF
759 ENDDO
760 ENDDO
761 ENDDO
762 ENDDO
763 ENDDO
764 ENDIF
765 ENDIF
766 ENDIF
767C--------------------------------------------------
768 ELSEIF(keyword == 'HOURGLASS')THEN
769C--------------------------------------------------
770 DO i=1,nel
771 value(i) = ehour(nft+i)
772 is_written_value(i) = 1
773 ENDDO
774C--------------------------------------------------
775 ELSEIF(keyword == 'EPSD') THEN
776C--------------------------------------------------
777 value(1:nel) = gbuf%EPSD(1:nel)
778 is_written_value(1:nel) = 1
779C--------------------------------------------------
780 ELSEIF(keyword == 'WPLA' .AND. mlw == 25) THEN
781C--------------------------------------------------
782C WPLA par couche pour loi 25
783 iok = 0
784 DO i=1,nel
785 evar(i) = zero
786 ENDDO
787 ius = info1
788 IF (isolnod == 16.OR.isolnod == 20.OR.
789 . (isolnod == 8.AND.jhbe == 14).OR.
790 . ((isolnod == 6.OR.isolnod == 8).AND.jhbe == 15))THEN
791
792 IF (ius <= nptg) THEN
793 DO il=1,nlay
794 IF (elbuf_tab(ng)%BUFLY(il)%L_PLA > 0) THEN
795 iok = 1
796 DO is=1,npts
797 DO it=1,nptt
798 DO ir=1,nptr
799 lbuf=>elbuf_tab(ng)%BUFLY(il)%LBUF(ir,is,it)
800 DO i=1,nel
801 value(i) = value(i) + lbuf%PLA(i)
802 is_written_value(i) = 1
803 ENDDO
804 ENDDO
805 ENDDO
806 ENDDO
807 ENDIF
808 ENDDO
809 ENDIF
810 ENDIF
811C--------------------------------------------------
812 ELSEIF (keyword == 'FLAY' .AND. mlw == 25) THEN
813C--------------------------------------------------
814C--- FAILED LAYERS par elem pour loi 25
815 DO i=1,nel
816 evar(i) = zero
817 ENDDO
818 IF( isolnod == 16.OR.isolnod == 20.OR.
819 . (isolnod == 8.AND.jhbe == 14).OR.
820 . ((isolnod == 6 .OR. isolnod == 8).AND.jhbe == 15))THEN
821c
822 npg_plane = nptr * npts * nptt
823 DO i=1,nel
824 DO il=1,nlay
825 value(i) = zero
826 DO j=1,nptr
827 DO k=1,npts
828 DO l=1,nptt
829 lbuf=>elbuf_tab(ng)%BUFLY(il)%LBUF(j,k,l)
830 IF (lbuf%OFF(i) == 0) value(i) = value(i) + one
831 IF(int(value(i))>=npg_plane) evar(i)=evar(i)+one
832 is_written_value(i) = 1
833 ENDDO
834 ENDDO
835 ENDDO
836 ENDDO
837 ENDDO
838 ENDIF
839C--------------------------------------------------
840 ELSEIF(keyword == 'VFRAC1') THEN
841C--------------------------------------------------
842 IF(mlw==37)THEN
843 ius=3 !law37 user4 and user5
844 ELSEIF(mlw==51)THEN
845 imat = ixs(1,nft+1)
846 iadbuf = ipm(7,imat)
847 nuparam= ipm(9,imat)
848 uparam => bufmat(iadbuf:iadbuf+nuparam)
849 isubmat=uparam(276+1)
850 ius=m51_n0phas+(isubmat-1)*m51_nvphas
851 ENDIF
852 IF (mlw==51 .OR. mlw==37)THEN
853 DO il=1,nlay
854 DO is=1,npts
855 DO it=1,nptt
856 DO ir=1,nptr
857 mbuf => elbuf_tab(ng)%BUFLY(il)%MAT(ir,is,it)
858 DO i=1,nel
859 value(i) = value(i) + mbuf%VAR(i+(ius)*nel)/nptg
860 is_written_value(i) = 1
861 ENDDO
862 ENDDO
863 ENDDO
864 ENDDO
865 ENDDO
866 ENDIF
867C--------------------------------------------------
868 ELSEIF(keyword == 'VFRAC2') THEN
869C--------------------------------------------------
870 IF(mlw==37)THEN
871 ius=4 !law37 user4 and user5
872 ELSEIF(mlw==51)THEN
873 imat = ixs(1,nft+1)
874 iadbuf = ipm(7,imat)
875 nuparam= ipm(9,imat)
876 uparam => bufmat(iadbuf:iadbuf+nuparam)
877 isubmat=uparam(276+2)
878 ius=m51_n0phas+(isubmat-1)*m51_nvphas
879 ENDIF
880 IF (mlw==51 .OR. mlw==37)THEN
881 DO il=1,nlay
882 DO is=1,npts
883 DO it=1,nptt
884 DO ir=1,nptr
885 mbuf => elbuf_tab(ng)%BUFLY(il)%MAT(ir,is,it)
886 DO i=1,nel
887 value(i) = value(i) + mbuf%VAR(i+(ius)*nel)/nptg
888 is_written_value(i) = 1
889 ENDDO
890 ENDDO
891 ENDDO
892 ENDDO
893 ENDDO
894 ENDIF
895C--------------------------------------------------
896 ELSEIF(keyword == 'VFRAC3') THEN
897C--------------------------------------------------
898 IF(mlw==37)THEN
899 ius=5 !law37 user4 and user5
900 ELSEIF(mlw==51)THEN
901 imat = ixs(1,nft+1)
902 iadbuf = ipm(7,imat)
903 nuparam= ipm(9,imat)
904 uparam => bufmat(iadbuf:iadbuf+nuparam)
905 isubmat=uparam(276+3)
906 ius=m51_n0phas+(isubmat-1)*m51_nvphas
907 ENDIF
908 IF (mlw==51)THEN
909 DO il=1,nlay
910 DO is=1,npts
911 DO it=1,nptt
912 DO ir=1,nptr
913 mbuf => elbuf_tab(ng)%BUFLY(il)%MAT(ir,is,it)
914 DO i=1,nel
915 value(i) = value(i) + mbuf%VAR(i+(ius)*nel)/nptg
916 is_written_value(i) = 1
917 ENDDO
918 ENDDO
919 ENDDO
920 ENDDO
921 ENDDO
922 ENDIF
923C--------------------------------------------------
924 ELSEIF(keyword == 'VFRAC4') THEN
925C--------------------------------------------------
926 IF(mlw==37)THEN
927 ius=6 !law37 user4 and user5
928 ELSEIF(mlw==51)THEN
929 imat = ixs(1,nft+1)
930 iadbuf = ipm(7,imat)
931 nuparam= ipm(9,imat)
932 uparam => bufmat(iadbuf:iadbuf+nuparam)
933 isubmat=uparam(276+4)
934 ius=m51_n0phas+(isubmat-1)*m51_nvphas
935 ENDIF
936 IF (mlw==51)THEN
937 DO il=1,nlay
938 DO is=1,npts
939 DO it=1,nptt
940 DO ir=1,nptr
941 mbuf => elbuf_tab(ng)%BUFLY(il)%MAT(ir,is,it)
942 DO i=1,nel
943 value(i) = value(i) + mbuf%VAR(i+(ius)*nel)/nptg
944 is_written_value(i) = 1
945 ENDDO
946 ENDDO
947 ENDDO
948 ENDDO
949 ENDDO
950 ENDIF
951C--------------------------------------------------
952 ELSEIF(keyword(1:9) == 'M151VFRAC') THEN
953C--------------------------------------------------
954 IF (mlw == 151 .AND. multi_fvm%NBMAT > 1) THEN
955 READ(keyword, '(A9,I10)') buff, imat
956 IF (imat > 0 .AND. imat <= nlay) THEN
957 DO i=1,nel
958 value(i) = multi_fvm%PHASE_ALPHA(imat, i + nft)
959 is_written_value(i) = 1
960 ENDDO
961 ENDIF
962 ENDIF
963C--------------------------------------------------
964 ELSEIF(keyword(1:8) == 'M151ENER') THEN
965C--------------------------------------------------
966 IF (mlw == 151 .AND. multi_fvm%NBMAT > 1) THEN
967 READ(keyword, '(a8,i10)') BUFF, IMAT
968.AND. IF (IMAT > 0 IMAT <= NLAY) THEN
969 DO I=1,NEL
970 IF (MULTI_FVM%PHASE_RHO(IMAT, I + NFT) > 0) THEN
971 VALUE(I) = MULTI_FVM%PHASE_EINT(IMAT, I + NFT) /
972 . MULTI_FVM%PHASE_RHO(IMAT, I + NFT)
973 ELSE
974 VALUE(I) = ZERO
975 ENDIF
976 IS_WRITTEN_VALUE(I) = 1
977 ENDDO
978 ENDIF
979 ENDIF
980C--------------------------------------------------
981 ELSEIF(KEYWORD(1:8) == 'm151pres') THEN
982C--------------------------------------------------
983.AND. IF (MLW == 151 MULTI_FVM%NBMAT > 1) THEN
984 READ(KEYWORD, '(a8,i10)') BUFF, IMAT
985.AND. IF (IMAT > 0 IMAT <= NLAY) THEN
986 DO I=1,NEL
987 VALUE(I) = MULTI_FVM%PHASE_PRES(IMAT, I + NFT)
988 IS_WRITTEN_VALUE(I) = 1
989 ENDDO
990 ENDIF
991 ENDIF
992C--------------------------------------------------
993 ELSEIF(KEYWORD(1:8) == 'm151dens') THEN
994C--------------------------------------------------
995.AND. IF (MLW == 151 MULTI_FVM%NBMAT > 1) THEN
996 READ(KEYWORD, '(a8,i10)') BUFF, IMAT
997.AND. IF (IMAT > 0 IMAT <= NLAY) THEN
998 DO I=1,NEL
999 VALUE(I) = MULTI_FVM%PHASE_RHO(IMAT, I + NFT)
1000 IS_WRITTEN_VALUE(I) = 1
1001 ENDDO
1002 ENDIF
1003 ENDIF
1004C--------------------------------------------------
1005 ELSEIF (KEYWORD == 'orthd/psi')THEN
1006C--------------------------------------------------
1007C EULER ANGLE : rotation of ORTHOTROPIC SYSTEM wrt GLOBAL SYSTEM
1008c ILAYER=NULL NPT=NULL
1009.AND..AND. IF ( (ILAY <= NLAY ILAY > 0)
1010.AND..AND..AND..AND..AND. . IR <= NPTR IR > 0 IS <= NPTS IS > 0 IT <= NPTT IT > 0) THEN
1011.OR..OR. IF ( IGTYP == 6 IGTYP == 21 IGTYP == 22 ) THEN
1012 LBUF => ELBUF_TAB(NG)%BUFLY(MAX(1,ILAY))%LBUF(1,1,1)
1013 DO I=1,NEL
1014 N = I + NFT
1015 IF(ISORTH ==1) THEN
1016C pour JHBE=14, valeurs moyennes est dans rep. corota.
1017.OR. IF(IGTYP == 21 IGTYP == 22) THEN
1018 GAMA(1)= LBUF%GAMA(JJ(1)+I)
1019 GAMA(2)= LBUF%GAMA(JJ(2)+I)
1020 GAMA(3)= ZERO
1021 GAMA(4)= ZERO
1022 GAMA(5)= ZERO
1023 GAMA(6)= ZERO
1024 ELSE
1025 GAMA(1) = GBUF%GAMA(JJ(1)+I)
1026 GAMA(2) = GBUF%GAMA(JJ(2)+I)
1027 GAMA(3) = GBUF%GAMA(JJ(3)+I)
1028 GAMA(4) = GBUF%GAMA(JJ(4)+I)
1029 GAMA(5) = GBUF%GAMA(JJ(5)+I)
1030 GAMA(6) = GBUF%GAMA(JJ(6)+I)
1031 ENDIF
1032 CALL SROTORTH(X,IXS(1,N),
1033 . GAMA,JHBE,IGTYP,IPARG(17,NG) )
1034C--------
1035 T11=GAMA(1)
1036 T21=GAMA(2)
1037 T31=GAMA(3)
1038 T12=GAMA(4)
1039 T22=GAMA(5)
1040 T32=GAMA(6)
1041 T13=T21*T32-T31*T22
1042 T23=T31*T12-T11*T32
1043 T33=T11*T22-T21*T12
1044 IF (ABS(T31) - ONE < EM20)THEN
1045 THETA = -ASIN(T31)
1046 PSI = ATAN2(T32/COS(THETA),T33/COS(THETA))
1047 ELSE
1048 IF(T31 == -ONE)THEN
1049 PSI = ATAN2(T12,T13)
1050 ELSE
1051 PSI = ATAN2(-T12,-T13)
1052 ENDIF
1053 ENDIF
1054 VALUE(I) = PSI*HUNDRED80/PI
1055 IS_WRITTEN_VALUE(I) = 1
1056 ENDIF
1057 ENDDO
1058 ENDIF
1059 ENDIF
1060C--------------------------------------------------
1061 ELSEIF (KEYWORD == 'orthd/theta')THEN
1062C--------------------------------------------------
1063C EULER ANGLE : rotation of ORTHOTROPIC SYSTEM wrt GLOBAL SYSTEM
1064c ILAYER=NULL NPT=NULL
1065.AND..AND. IF ( (ILAY <= NLAY ILAY > 0)
1066.AND..AND..AND..AND..AND. . IR <= NPTR IR > 0 IS <= NPTS IS > 0 IT <= NPTT IT > 0) THEN
1067.OR..OR. IF ( IGTYP == 6 IGTYP == 21 IGTYP == 22 ) THEN
1068 LBUF => ELBUF_TAB(NG)%BUFLY(MAX(1,ILAY))%LBUF(1,1,1)
1069 DO I=1,NEL
1070 N = I + NFT
1071 IF(ISORTH ==1) THEN
1072C pour JHBE=14, valeurs moyennes est dans rep. corota.
1073.OR. IF(IGTYP == 21 IGTYP == 22) THEN
1074 GAMA(1)= LBUF%GAMA(JJ(1)+I)
1075 GAMA(2)= LBUF%GAMA(JJ(2)+I)
1076 GAMA(3)= ZERO
1077 GAMA(4)= ZERO
1078 GAMA(5)= ZERO
1079 GAMA(6)= ZERO
1080 ELSE
1081 GAMA(1) = GBUF%GAMA(JJ(1)+I)
1082 GAMA(2) = GBUF%GAMA(JJ(2)+I)
1083 GAMA(3) = GBUF%GAMA(JJ(3)+I)
1084 GAMA(4) = GBUF%GAMA(JJ(4)+I)
1085 GAMA(5) = GBUF%GAMA(JJ(5)+I)
1086 GAMA(6) = GBUF%GAMA(JJ(6)+I)
1087 ENDIF
1088 CALL SROTORTH(X,IXS(1,N),
1089 . GAMA,JHBE,IGTYP,IPARG(17,NG) )
1090C--------
1091 T11=GAMA(1)
1092 T21=GAMA(2)
1093 T31=GAMA(3)
1094 T12=GAMA(4)
1095 T22=GAMA(5)
1096 T32=GAMA(6)
1097 T13=T21*T32-T31*T22
1098 T23=T31*T12-T11*T32
1099 T33=T11*T22-T21*T12
1100 IF (ABS(T31) - ONE < EM20)THEN
1101 THETA = -ASIN(T31)
1102 ELSE
1103 IF(T31 == -ONE)THEN
1104 THETA = PI / TWO
1105 ELSE
1106 THETA = - PI / TWO
1107 ENDIF
1108 ENDIF
1109 VALUE(I) = THETA*HUNDRED80/PI
1110 IS_WRITTEN_VALUE(I) = 1
1111 ENDIF
1112 ENDDO
1113 ENDIF
1114 ENDIF
1115C--------------------------------------------------
1116 ELSEIF (KEYWORD == 'orthd/phi')THEN
1117C--------------------------------------------------
1118C EULER ANGLE : rotation of ORTHOTROPIC SYSTEM wrt GLOBAL SYSTEM
1119c ILAYER=NULL NPT=NULL
1120.AND..AND. IF ( (ILAY <= NLAY ILAY > 0)
1121.AND..AND..AND..AND..AND. . IR <= NPTR IR > 0 IS <= NPTS IS > 0 IT <= NPTT IT > 0) THEN
1122.OR..OR. IF ( IGTYP == 6 IGTYP == 21 IGTYP == 22 ) THEN
1123 LBUF => ELBUF_TAB(NG)%BUFLY(MAX(1,ILAY))%LBUF(1,1,1)
1124 DO I=1,NEL
1125 N = I + NFT
1126 IF(ISORTH ==1) THEN
1127C pour JHBE=14, valeurs moyennes est dans rep. corota.
1128.OR. IF(IGTYP == 21 IGTYP == 22) THEN
1129 GAMA(1)= LBUF%GAMA(JJ(1)+I)
1130 GAMA(2)= LBUF%GAMA(JJ(2)+I)
1131 GAMA(3)= ZERO
1132 GAMA(4)= ZERO
1133 GAMA(5)= ZERO
1134 GAMA(6)= ZERO
1135 ELSE
1136 GAMA(1) = GBUF%GAMA(JJ(1)+I)
1137 GAMA(2) = GBUF%GAMA(JJ(2)+I)
1138 GAMA(3) = GBUF%GAMA(JJ(3)+I)
1139 GAMA(4) = GBUF%GAMA(JJ(4)+I)
1140 GAMA(5) = GBUF%GAMA(JJ(5)+I)
1141 GAMA(6) = GBUF%GAMA(JJ(6)+I)
1142 ENDIF
1143 CALL SROTORTH(X,IXS(1,N),
1144 . GAMA,JHBE,IGTYP,IPARG(17,NG) )
1145C--------
1146 T11=GAMA(1)
1147 T21=GAMA(2)
1148 T31=GAMA(3)
1149 T12=GAMA(4)
1150 T22=GAMA(5)
1151 T32=GAMA(6)
1152 T13=T21*T32-T31*T22
1153 T23=T31*T12-T11*T32
1154 T33=T11*T22-T21*T12
1155 IF (ABS(T31) - ONE < EM20)THEN
1156 THETA = -ASIN(T31)
1157 PHI = ATAN2(T21/COS(THETA),T11/COS(THETA))
1158 ELSE
1159 PHI = ZERO
1160 ENDIF
1161 VALUE(I) = PHI*HUNDRED80/PI
1162 IS_WRITTEN_VALUE(I) = 1
1163 ENDIF
1164 ENDDO
1165 ENDIF
1166 ENDIF
1167C--------------------------------------------------
1168 ELSEIF (KEYWORD == 'bfrac')THEN
1169C--------------------------------------------------
1170 !BURN FRACTION explosive EOS
1171 IF(GBUF%G_BFRAC > 0) THEN
1172 IF (MLW==151)THEN
1173 DO I=1,NEL
1174 VALUE(I)=-EP30
1175 ENDDO
1176 DO ILAY=1,NLAY
1177 DO I=1,NEL
1178 VALUE(I) = MAX(VALUE(I),MULTI_FVM%BFRAC(ILAY,I+NFT))
1179 IS_WRITTEN_VALUE(I) = 1
1180 ENDDO
1181 ENDDO
1182 ELSE
1183 VALUE(1:NEL) = GBUF%BFRAC(1:NEL)
1184 IS_WRITTEN_VALUE(1:NEL) = 1
1185 ENDIF
1186 ENDIF
1187C--------------------------------------------------
1188 ELSEIF (KEYWORD == 'vdam1')THEN
1189C--------------------------------------------------
1190c ILAYER=NULL IR=NULL IS=NULL IT=NULL
1191.AND..AND..AND. IF ( ILAY == -1 IR == -1 IS == -1 IT == -1) THEN
1192.AND. IF (ISOLNOD == 8 MLW == 83) THEN
1193c output = damage variables of /fail/snconnect
1194 MT = IXS(1,NFT+1)
1195 IRUPT = mat_param(MT)%FAIL(1)%IRUPT
1196 NFAIL = ELBUF_TAB(NG)%BUFLY(1)%NFAIL! ng= ngroup
1197 IF (IRUPT == 26) THEN
1198 NPTG = 4
1199 DO IR=1,NFAIL
1200 DO IPT = 1,NPTG
1201 DAMF =>
1202 . ELBUF_TAB(NG)%BUFLY(1)%FAIL(IPT,1,1)%FLOC(IR)%DAM
1203 DO I=1,NEL
1204 EVAR(I) = MAX(EVAR(I) ,DAMF(I))
1205 ENDDO
1206 ENDDO
1207 ENDDO
1208 DO I=1,NEL
1209 VALUE(I) = EVAR(I)
1210 IS_WRITTEN_VALUE(I) = 1
1211 ENDDO
1212 ENDIF
1213 ENDIF
1214c ILAYER=NULL IR= IS= IT=
1215.AND..AND..AND. ELSEIF ( ILAY == -1 IR >= 0 IR <= NPTR
1216.AND..AND..AND. . IS >= 0 IS <= NPTS IT >= 0 IT <= NPTT) THEN
1217.AND. IF (ISOLNOD == 8 MLW == 83) THEN
1218c output = damage variables of /fail/snconnect
1219 MT = IXS(1,NFT+1)
1220 IRUPT = mat_param(MT)%FAIL(1)%IRUPT
1221 NFAIL = ELBUF_TAB(NG)%BUFLY(1)%NFAIL! ng= ngroup
1222 IF (IRUPT == 26) THEN
1223 DO IIR=1,NFAIL
1224 DAMF =>
1225 . ELBUF_TAB(NG)%BUFLY(1)%FAIL(IR,1,1)%FLOC(IIR)%DAM
1226 DO I=1,NEL
1227 EVAR(I) = DAMF(I)
1228 ENDDO
1229 ENDDO
1230 DO I=1,NEL
1231 VALUE(I) = EVAR(I)
1232 IS_WRITTEN_VALUE(I) = 1
1233 ENDDO
1234 ENDIF
1235 ENDIF
1236 ENDIF
1237C--------------------------------------------------
1238 ELSEIF (KEYWORD == 'vdam2')THEN
1239C--------------------------------------------------
1240c ILAYER=NULL IR=NULL IS=NULL IT=NULL
1241.AND..AND..AND. IF ( ILAY == -1 IR == -1 IS == -1 IT == -1) THEN
1242.AND. IF (ISOLNOD == 8 MLW == 83) THEN
1243c output = damage variables of /fail/snconnect
1244 MT = IXS(1,NFT+1)
1245 IRUPT = mat_param(MT)%FAIL(1)%IRUPT
1246 NFAIL = ELBUF_TAB(NG)%BUFLY(1)%NFAIL! ng= ngroup
1247 IF (IRUPT == 26) THEN
1248 NPTG = 4
1249 DO IR=1,NFAIL
1250 DO IPT = 1,NPTG
1251 DAMF =>
1252 . ELBUF_TAB(NG)%BUFLY(1)%FAIL(IPT,1,1)%FLOC(IR)%DAM
1253 DO I=1,NEL
1254 EVAR(I) = MAX(EVAR(I) ,DAMF(NEL + I))
1255 ENDDO
1256 ENDDO
1257 ENDDO
1258 DO I=1,NEL
1259 VALUE(I) = EVAR(I)
1260 IS_WRITTEN_VALUE(I) = 1
1261 ENDDO
1262 ENDIF
1263 ENDIF
1264c ILAYER=NULL IR= IS= IT=
1265.AND..AND..AND. ELSEIF ( ILAY == -1 IR >= 0 IR <= NPTR
1266.AND..AND..AND. . IS >= 0 IS <= NPTS IT >= 0 IT <= NPTT) THEN
1267.AND. IF (ISOLNOD == 8 MLW == 83) THEN
1268c output = damage variables of /fail/snconnect
1269 MT = IXS(1,NFT+1)
1270 IRUPT = mat_param(MT)%FAIL(1)%IRUPT
1271 NFAIL = ELBUF_TAB(NG)%BUFLY(1)%NFAIL! ng= ngroup
1272 IF (IRUPT == 26) THEN
1273 DO IIR=1,NFAIL
1274 DAMF =>
1275 . ELBUF_TAB(NG)%BUFLY(1)%FAIL(IR,1,1)%FLOC(IIR)%DAM
1276 DO I=1,NEL
1277 EVAR(I) = DAMF(NEL+I)
1278 ENDDO
1279 ENDDO
1280 DO I=1,NEL
1281 VALUE(I) = EVAR(I)
1282 IS_WRITTEN_VALUE(I) = 1
1283 ENDDO
1284 ENDIF
1285 ENDIF
1286 ENDIF
1287C--------------------------------------------------
1288 ELSEIF (KEYWORD == 'vdam3')THEN
1289C--------------------------------------------------
1290c ILAYER=NULL IR=NULL IS=NULL IT=NULL
1291.AND..AND..AND. IF ( ILAY == -1 IR == -1 IS == -1 IT == -1) THEN
1292.AND. IF (ISOLNOD == 8 MLW == 83) THEN
1293c output = damage variables of /fail/snconnect
1294 MT = IXS(1,NFT+1)
1295 IRUPT = mat_param(MT)%FAIL(1)%IRUPT
1296 NFAIL = ELBUF_TAB(NG)%BUFLY(1)%NFAIL! ng= ngroup
1297 IF (IRUPT == 26) THEN
1298 NPTG = 4
1299 DO IR=1,NFAIL
1300 DO IPT = 1,NPTG
1301 DAMF =>
1302 . ELBUF_TAB(NG)%BUFLY(1)%FAIL(IPT,1,1)%FLOC(IR)%DAM
1303 DO I=1,NEL
1304 EVAR(I) = MAX(EVAR(I) ,DAMF(2*NEL + I))
1305 ENDDO
1306 ENDDO
1307 ENDDO
1308 DO I=1,NEL
1309 VALUE(I) = EVAR(I)
1310 IS_WRITTEN_VALUE(I) = 1
1311 ENDDO
1312 ENDIF
1313 ENDIF
1314c ILAYER=NULL IR= IS= IT=
1315.AND..AND..AND. ELSEIF ( ILAY == -1 IR >= 0 IR <= NPTR
1316.AND..AND..AND. . IS >= 0 IS <= NPTS IT >= 0 IT <= NPTT) THEN
1317.AND. IF (ISOLNOD == 8 MLW == 83) THEN
1318c output = damage variables of /fail/snconnect
1319 MT = IXS(1,NFT+1)
1320 IRUPT = mat_param(MT)%FAIL(1)%IRUPT
1321 NFAIL = ELBUF_TAB(NG)%BUFLY(1)%NFAIL! ng= ngroup
1322 IF (IRUPT == 26) THEN
1323 DO IIR=1,NFAIL
1324 DAMF =>
1325 . ELBUF_TAB(NG)%BUFLY(1)%FAIL(IR,1,1)%FLOC(IIR)%DAM
1326 DO I=1,NEL
1327 EVAR(I) = DAMF(2*NEL+I)
1328 ENDDO
1329 ENDDO
1330 DO I=1,NEL
1331 VALUE(I) = EVAR(I)
1332 IS_WRITTEN_VALUE(I) = 1
1333 ENDDO
1334 ENDIF
1335 ENDIF
1336 ENDIF
1337C--------------------------------------------------
1338 ELSEIF(KEYWORD == 'dama') THEN
1339C--------------------------------------------------
1340c ILAYER=NULL IR=NULL IS=NULL IT=NULL
1341.AND..AND..AND. IF ( ILAY == -1 IR == -1 IS == -1 IT == -1) THEN
1342 DO I=1,NEL
1343 EVAR(I) = ZERO
1344 ENDDO
1345 IF (MLW == 120) THEN
1346 DO IL=1,NLAY
1347 DO IS=1,NPTS
1348 DO IT=1,NPTT
1349 DO IIR=1,NPTR
1350 DFMAX=>
1351 . ELBUF_TAB(NG)%BUFLY(IL)%LBUF(IIR,IS,IT)%DMG
1352 DO I=1,NEL
1353 VALUE(I) = MAX(VALUE(I),DFMAX(I))
1354 IS_WRITTEN_VALUE(I) = 1
1355 ENDDO
1356 ENDDO
1357 ENDDO
1358 ENDDO
1359 ENDDO
1360 ELSE
1361 DO IL=1,NLAY
1362 NFAIL = ELBUF_TAB(NG)%BUFLY(IL)%NFAIL
1363 DO IS=1,NPTS
1364 DO IT=1,NPTT
1365 DO IIR=1,NPTR
1366 DO IR=1,NFAIL
1367 DFMAX=>
1368 . ELBUF_TAB(NG)%BUFLY(IL)%FAIL(IIR,IS,IT)%FLOC(IR)%DAMMX
1369 DO I=1,NEL
1370 VALUE(I) = MAX(VALUE(I),DFMAX(I))
1371 IS_WRITTEN_VALUE(I) = 1
1372 ENDDO
1373 ENDDO
1374 ENDDO
1375 ENDDO
1376 ENDDO
1377 ENDDO
1378 ENDIF
1379c ILAYER=NULL IR= IS= IT=
1380.AND..AND..AND. ELSEIF ( ILAY == -1 IR >= 0 IR <= NPTR
1381.AND..AND..AND. . IS >= 0 IS <= NPTS IT >= 0 IT <= NPTT) THEN
1382 IF (MLW == 120) THEN
1383 IIR = IR
1384 IUS = NLAY*IIR*IS*IT
1385 DAMMAX = ZERO
1386.AND..AND. IF (IIR <= NPTRIS <= NPTSIT <= NPTT) THEN
1387 DO IL=1,NLAY
1388 DFMAX=>ELBUF_TAB(NG)%BUFLY(IL)%LBUF(IIR,IS,IT)%DMG
1389 DO I=1,NEL
1390 VALUE(I) = MAX(VALUE(I),DFMAX(I))
1391 IS_WRITTEN_VALUE(I) = 1
1392 ENDDO
1393 ENDDO
1394 ENDIF
1395 ELSE
1396 IIR = IR
1397 IUS = NLAY*IIR*IS*IT
1398 DAMMAX = ZERO
1399.AND..AND. IF (IIR <= NPTRIS <= NPTSIT <= NPTT) THEN
1400 DO IL=1,NLAY
1401 NFAIL = ELBUF_TAB(NG)%BUFLY(IL)%NFAIL
1402 DO IR=1,NFAIL
1403 DFMAX=>
1404 . ELBUF_TAB(NG)%BUFLY(IL)%FAIL(IIR,IS,IT)%FLOC(IR)%DAMMX
1405 DO I=1,NEL
1406 VALUE(I) = MAX(VALUE(I),DFMAX(I))
1407 IS_WRITTEN_VALUE(I) = 1
1408 ENDDO
1409 ENDDO
1410 ENDDO
1411 ENDIF
1412 ENDIF
1413.AND..AND..AND..AND. ELSEIF ( ILAY > 0 ILAY <= NLAY IR >= 0 IR <= NPTR
1414.AND. . IS >= 0 IS <= NPTS) THEN
1415 IF(MLW == 120)THEN
1416 DFMAX=>ELBUF_TAB(NG)%BUFLY(ILAY)%LBUF(IR,IS,IT)%DMG
1417 DO I=1,NEL
1418 VALUE(I) = MAX(VALUE(I),DFMAX(I))
1419 IS_WRITTEN_VALUE(I) = 1
1420 ENDDO
1421 ELSE
1422 NFAIL = ELBUF_TAB(NG)%BUFLY(ILAY)%NFAIL
1423 DO IIR=1,NFAIL
1424 DFMAX=>
1425 . ELBUF_TAB(NG)%BUFLY(ILAY)%FAIL(IR,IS,IT)%FLOC(IIR)%DAMMX
1426 DO I=1,NEL
1427 VALUE(I) = MAX(VALUE(I),DFMAX(I))
1428 IS_WRITTEN_VALUE(I) = 1
1429 ENDDO
1430 ENDDO
1431 ENDIF
1432 ENDIF
1433C--------------------------------------------------
1434 ELSEIF(KEYWORD == 'failure') THEN
1435C--------------------------------------------------
1436 IF (mode == -1) THEN
1437c ILAYER=NULL IR=NULL IS=NULL IT=NULL
1438 IF ( ilay == -1 .AND. ir == -1 .AND. is == -1 .AND. it == -1) THEN
1439 DO i = 1,nel
1440 nlay_fail = 0
1441 DO il=1,nlay
1442 imat = elbuf_tab(ng)%BUFLY(il)%IMAT
1443 nfail = mat_param(imat)%NFAIL
1444 DO ifail = 1,nfail
1445 fail_id = mat_param(imat)%FAIL(ifail)%FAIL_ID
1446 IF (fail_id == id) THEN
1447 DO is=1,npts
1448 DO it=1,nptt
1449 DO iir=1,nptr
1450 fbuf => elbuf_tab(ng)%BUFLY(il)%FAIL(iir,is,it)
1451 dmgmx = fbuf%FLOC(ifail)%DAMMX(i)
1452 value(i) = value(i) + dmgmx/(nptr*npts*nptt)
1453 is_written_value(i) = 1
1454 nlay_fail = nlay_fail + 1
1455 ENDDO
1456 ENDDO
1457 ENDDO
1458 ENDIF
1459 ENDDO
1460 ENDDO
1461 IF (nlay_fail > 0) value(i) = value(i)/nlay_fail
1462 ENDDO
1463c ILAYER=NULL IR= IS= IT=
1464 ELSEIF ( ilay == -1 .AND. ir >= 0 .AND. ir <= nptr .AND.
1465 . is >= 0 .AND. is <= npts .AND. it >= 0 .AND. it <= nptt) THEN
1466 iir = ir
1467 IF (iir <= nptr.AND.is <= npts.AND.it <= nptt) THEN
1468 DO i = 1,nel
1469 nlay_fail = 0
1470 DO il=1,nlay
1471 imat = elbuf_tab(ng)%BUFLY(il)%IMAT
1472 nfail = mat_param(imat)%NFAIL
1473 DO ifail = 1,nfail
1474 fail_id = mat_param(imat)%FAIL(ifail)%FAIL_ID
1475 IF (fail_id == id) THEN
1476 fbuf => elbuf_tab(ng)%BUFLY(il)%FAIL(iir,is,it)
1477 value(i) = value(i) + fbuf%FLOC(ifail)%DAMMX(i)
1478 is_written_value(i) = 1
1479 nlay_fail = nlay_fail + 1
1480 ENDIF
1481 ENDDO
1482 ENDDO
1483 IF (nlay_fail > 0) value(i) = value(i)/nlay_fail
1484 ENDDO
1485 ENDIF
1486 ELSEIF ( ilay > 0 .AND. ilay <= nlay .AND. ir >= 0 .AND. ir <= nptr .AND.
1487 . is >= 0 .AND. is <= npts) THEN
1488 imat = elbuf_tab(ng)%BUFLY(ilay)%IMAT
1489 nfail = mat_param(imat)%NFAIL
1490 DO ifail = 1,nfail
1491 fail_id = mat_param(imat)%FAIL(ifail)%FAIL_ID
1492 IF (fail_id == id) THEN
1493 fbuf => elbuf_tab(ng)%BUFLY(ilay)%FAIL(ir,is,it)
1494 DO i = 1,nel
1495 value(i) = fbuf%FLOC(ifail)%DAMMX(i)
1496 is_written_value(i) = 1
1497 ENDDO
1498 ENDIF
1499 ENDDO
1500 ENDIF
1501 ELSE
1502c ILAYER=NULL IR=NULL IS=NULL IT=NULL
1503 IF ( ilay == -1 .AND. ir == -1 .AND. is == -1 .AND. it == -1) THEN
1504 DO i = 1,nel
1505 nlay_fail = 0
1506 DO il=1,nlay
1507 imat = elbuf_tab(ng)%BUFLY(il)%IMAT
1508 nfail = mat_param(imat)%NFAIL
1509 DO ifail = 1,nfail
1510 fail_id = mat_param(imat)%FAIL(ifail)%FAIL_ID
1511 nmod = mat_param(imat)%FAIL(ifail)%NMOD
1512 IF ((fail_id == id).AND.(mode <= nmod)) THEN
1513 DO is=1,npts
1514 DO it=1,nptt
1515 DO iir=1,nptr
1516 fbuf => elbuf_tab(ng)%BUFLY(il)%FAIL(iir,is,it)
1517 dmgmx = fbuf%FLOC(ifail)%DAMMX(mode*nel + i)
1518 value(i) = value(i) + dmgmx/(nptr*npts*nptt)
1519 is_written_value(i) = 1
1520 nlay_fail = nlay_fail + 1
1521 ENDDO
1522 ENDDO
1523 ENDDO
1524 ENDIF
1525 ENDDO
1526 ENDDO
1527 IF (nlay_fail > 0) value(i) = value(i)/nlay_fail
1528 ENDDO
1529c ILAYER=NULL IR= IS= IT=
1530 ELSEIF ( ilay == -1 .AND. ir >= 0 .AND. ir <= nptr .AND.
1531 . is >= 0 .AND. is <= npts .AND. it >= 0 .AND. it <= nptt) THEN
1532 iir = ir
1533 IF (iir <= nptr.AND.is <= npts.AND.it <= nptt) THEN
1534 DO i = 1,nel
1535 nlay_fail = 0
1536 DO il=1,nlay
1537 imat = elbuf_tab(ng)%BUFLY(il)%IMAT
1538 nfail = mat_param(imat)%NFAIL
1539 DO ifail = 1,nfail
1540 fail_id = mat_param(imat)%FAIL(ifail)%FAIL_ID
1541 nmod = mat_param(imat)%FAIL(ifail)%NMOD
1542 IF ((fail_id == id).AND.(mode <= nmod)) THEN
1543 fbuf => elbuf_tab(ng)%BUFLY(il)%FAIL(iir,is,it)
1544 value(i) = value(i) + fbuf%FLOC(ifail)%DAMMX(mode*nel + i)
1545 is_written_value(i) = 1
1546 nlay_fail = nlay_fail + 1
1547 ENDIF
1548 ENDDO
1549 ENDDO
1550 IF (nlay_fail > 0) value(i) = value(i)/nlay_fail
1551 ENDDO
1552 ENDIF
1553 ELSEIF ( ilay > 0 .AND. ilay <= nlay .AND. ir >= 0 .AND. ir <= nptr .AND.
1554 . is >= 0 .AND. is <= npts) THEN
1555 imat = elbuf_tab(ng)%BUFLY(ilay)%IMAT
1556 nfail = mat_param(imat)%NFAIL
1557 DO ifail = 1,nfail
1558 fail_id = mat_param(imat)%FAIL(ifail)%FAIL_ID
1559 nmod = mat_param(imat)%FAIL(ifail)%NMOD
1560 IF ((fail_id == id).AND.(mode <= nmod)) THEN
1561 fbuf => elbuf_tab(ng)%BUFLY(ilay)%FAIL(ir,is,it)
1562 DO i = 1,nel
1563 value(i) = fbuf%FLOC(ifail)%DAMMX(mode*nel + i)
1564 is_written_value(i) = 1
1565 ENDDO
1566 ENDIF
1567 ENDDO
1568 ENDIF
1569 ENDIF
1570C--------------------------------------------------
1571 ELSEIF (keyword == 'DAMG') THEN
1572C--------------------------------------------------
1573c
1574 IF (gbuf%G_DMG > 0) THEN
1575c
1576 ! Resetting values
1577 DO i=1,nel
1578 value(i) = zero
1579 ENDDO
1580c
1581 ! If no MODE is requested
1582 IF (mode == -1) THEN
1583 ! If nothing is specified by the user, computing a mean value
1584 IF (ir == -1 .AND. is == -1 .AND. it == -1 .AND. ilay == -1) THEN
1585c
1586 ! Filling the value table
1587 DO il=1,nlay
1588 imat = elbuf_tab(ng)%BUFLY(il)%IMAT
1589 mat_id = mat_param(imat)%MAT_ID
1590 IF ((id == -1) .OR. ((id > 0).AND.(mat_id == id))) THEN
1591 DO is=1,npts
1592 DO it=1,nptt
1593 DO ir=1,nptr
1594 lbuf=>elbuf_tab(ng)%BUFLY(il)%LBUF(ir,is,it)
1595 DO i=lft,llt
1596 value(i) = value(i) + lbuf%DMG(i)/nptg
1597 is_written_value(i) = 1
1598 ENDDO
1599 ENDDO
1600 ENDDO
1601 ENDDO
1602 ENDIF
1603 ENDDO
1604c
1605 ! If integratiion point is specified by the user
1606 ELSEIF ( ir >= 0 .AND. ir <= nptr .AND.
1607 . is >= 0 .AND. is <= npts .AND.
1608 . it >= 0 .AND. it <= nptt) THEN
1609c
1610 ! Filling the value table
1611 DO il=1,nlay
1612 imat = elbuf_tab(ng)%BUFLY(il)%IMAT
1613 mat_id = mat_param(imat)%MAT_ID
1614 IF ((id == -1) .OR. ((id > 0).AND.(mat_id == id))) THEN
1615 lbuf => elbuf_tab(ng)%BUFLY(il)%LBUF(ir,is,it)
1616 DO i=1,nel
1617 value(i) = value(i) + lbuf%DMG(i)/nlay
1618 is_written_value(i) = 1
1619 ENDDO
1620 ENDIF
1621 ENDDO
1622c
1623 ! If the layer is specified by the user
1624 ELSEIF (ilay > 0 .AND. ilay <= nlay) THEN
1625 imat = elbuf_tab(ng)%BUFLY(ilay)%IMAT
1626 mat_id = mat_param(imat)%MAT_ID
1627 IF ((id == -1) .OR. ((id > 0).AND.(mat_id == id))) THEN
1628 DO is=1,npts
1629 DO it=1,nptt
1630 DO ir=1,nptr
1631 lbuf=>elbuf_tab(ng)%BUFLY(ilay)%LBUF(ir,is,it)
1632 DO i=lft,llt
1633 value(i) = value(i) + lbuf%DMG(i)/(nptr*npts*nptt)
1634 is_written_value(i) = 1
1635 ENDDO
1636 ENDDO
1637 ENDDO
1638 ENDDO
1639 ENDIF
1640 ENDIF
1641c
1642 ! If MODE is requested (MODE > 0) with a specific ID (ID > 0)
1643 ELSE
1644 ! If nothing is specified by the user, computing a mean value
1645 IF (ir == -1 .AND. is == -1 .AND. it == -1 .AND. ilay == -1) THEN
1646c
1647 ! Filling the value table
1648 DO il=1,nlay
1649 imat = elbuf_tab(ng)%BUFLY(il)%IMAT
1650 nmod = mat_param(imat)%NMOD
1651 mat_id = mat_param(imat)%MAT_ID
1652 IF ((nmod > 0 .AND. mode <= nmod) .AND. (mat_id == id)) THEN
1653 DO is=1,npts
1654 DO it=1,nptt
1655 DO ir=1,nptr
1656 lbuf=>elbuf_tab(ng)%BUFLY(il)%LBUF(ir,is,it)
1657 DO i=lft,llt
1658 value(i) = value(i) + lbuf%DMG(nel*mode+i)/nptg
1659 is_written_value(i) = 1
1660 ENDDO
1661 ENDDO
1662 ENDDO
1663 ENDDO
1664 ENDIF
1665 ENDDO
1666c
1667 ! If integratiion point is specified by the user
1668 ELSEIF ( ir >= 0 .AND. ir <= nptr .AND.
1669 . is >= 0 .AND. is <= npts .AND.
1670 . it >= 0 .AND. it <= nptt) THEN
1671c
1672 ! Filling the value table
1673 DO il=1,nlay
1674 imat = elbuf_tab(ng)%BUFLY(il)%IMAT
1675 nmod = mat_param(imat)%NMOD
1676 mat_id = mat_param(imat)%MAT_ID
1677 IF ((nmod > 0 .AND. mode <= nmod) .AND. (mat_id == id)) THEN
1678 lbuf => elbuf_tab(ng)%BUFLY(il)%LBUF(ir,is,it)
1679 DO i=1,nel
1680 value(i) = VALUE(i) + lbuf%DMG(nel*mode+i)/nlay
1681 is_written_value(i) = 1
1682 ENDDO
1683 ENDIF
1684 ENDDO
1685c
1686 ! If the layer is specified by the user
1687 ELSEIF (ilay > 0 .AND. ilay <= nlay) THEN
1688 imat = elbuf_tab(ng)%BUFLY(ilay)%IMAT
1689 nmod = mat_param(imat)%NMOD
1690 mat_id = mat_param(imat)%MAT_ID
1691 IF ((nmod > 0 .AND. mode <= nmod) .AND. (mat_id == id)) THEN
1692 DO is=1,npts
1693 DO it=1,nptt
1694 DO ir=1,nptr
1695 lbuf=>elbuf_tab(ng)%BUFLY(ilay)%LBUF(ir,is,it)
1696 DO i=lft,llt
1697 value(i) = value(i) + lbuf%DMG(nel*mode+i)/(nptr*npts*nptt)
1698 is_written_value(i) = 1
1699 ENDDO
1700 ENDDO
1701 ENDDO
1702 ENDDO
1703 ENDIF
1704 ENDIF
1705 ENDIF
1706c
1707 ENDIF
1708C--------------------------------------------------
1709 ELSEIF (keyword == 'DAMINI') THEN
1710C--------------------------------------------------
1711 ! Resetting values
1712 DO i=1,nel
1713 value(i) = zero
1714 ENDDO
1715c ILAYER=NULL IR=NULL IS=NULL IT=NULL
1716 IF ( ilay == -1 .AND. ir == -1 .AND. is == -1 .AND. it == -1) THEN
1717 DO il=1,nlay
1718 nfail = elbuf_tab(ng)%BUFLY(il)%NFAIL
1719 DO is=1,npts
1720 DO it=1,nptt
1721 DO iir=1,nptr
1722 fbuf => elbuf_tab(ng)%BUFLY(il)%FAIL(iir,is,it)
1723 DO i=1,nel
1724 maxdamini = zero
1725 DO ir=1,nfail
1726 IF (fbuf%FLOC(ir)%LF_DAMINI > 0) THEN
1727 maxdamini = max(maxdamini,fbuf%FLOC(ir)%DAMINI(i))
1728 ENDIF
1729 ENDDO
1730 value(i) = value(i) + maxdamini/(npts*nptr*nptt*nlay)
1731 is_written_value(i) = 1
1732 ENDDO
1733 ENDDO
1734 ENDDO
1735 ENDDO
1736 ENDDO
1737c ILAYER=NULL IR= IS= IT=
1738 ELSEIF ( ilay == -1 .AND. ir >= 0 .AND. ir <= nptr .AND.
1739 . is >= 0 .AND. is <= npts .AND. it >= 0 .AND. it <= nptt) THEN
1740 iir = ir
1741 IF (iir <= nptr .AND. is <= npts .AND. it <= nptt) THEN
1742 DO il=1,nlay
1743 nfail = elbuf_tab(ng)%BUFLY(il)%NFAIL
1744 fbuf => elbuf_tab(ng)%BUFLY(il)%FAIL(iir,is,it)
1745 DO i=1,nel
1746 maxdamini = zero
1747 DO ir=1,nfail
1748 IF (fbuf%FLOC(ir)%LF_DAMINI > 0) THEN
1749 maxdamini = max(maxdamini,fbuf%FLOC(ir)%DAMINI(i))
1750 ENDIF
1751 ENDDO
1752 value(i) = value(i) + maxdamini/nlay
1753 is_written_value(i) = 1
1754 ENDDO
1755 ENDDO
1756 ENDIF
1757c ILAYER= IR= IS= IT=
1758 ELSEIF ( ilay > 0 .AND. ilay <= nlay .AND. ir >= 0 .AND. ir <= nptr .AND.
1759 . is >= 0 .AND. is <= npts) THEN
1760 nfail = elbuf_tab(ng)%BUFLY(ilay)%NFAIL
1761 fbuf => elbuf_tab(ng)%BUFLY(ilay)%FAIL(ir,is,it)
1762 DO i=1,nel
1763 maxdamini = zero
1764 DO iir=1,nfail
1765 IF (fbuf%FLOC(iir)%LF_DAMINI > 0) THEN
1766 maxdamini = max(maxdamini,fbuf%FLOC(iir)%DAMINI(i))
1767 ENDIF
1768 ENDDO
1769 value(i) = maxdamini
1770 is_written_value(i) = 1
1771 ENDDO
1772 ENDIF
1773C--------------------------------------------------
1774 ELSEIF(keyword == 'TDEL') THEN
1775C--------------------------------------------------
1776 DO il=1,nlay
1777 nfail = elbuf_tab(ng)%BUFLY(il)%NFAIL
1778 DO is=1,npts
1779 DO it=1,nptt
1780 DO iir=1,nptr
1781 DO ir=1,nfail
1782 tdele=>
1783 . elbuf_tab(ng)%BUFLY(il)%FAIL(iir,is,it)%FLOC(ir)%TDEL
1784 DO i=1,nel
1785 value(i) = max(value(i),tdele(i))
1786 is_written_value(i) = 1
1787 ENDDO
1788 ENDDO
1789 ENDDO
1790 ENDDO
1791 ENDDO
1792 ENDDO
1793C--------------------------------------------------
1794 ELSEIF(keyword == 'SSP') THEN
1795C--------------------------------------------------
1796 IF (mlw == 151) THEN
1797 DO i=1,nel
1798 value(i) = multi_fvm%SOUND_SPEED(i + nft)
1799 is_written_value(i) = 1
1800 ENDDO
1801 ELSE
1802 l = elbuf_tab(ng)%BUFLY(1)%L_SSP
1803 IF(l /= 0)THEN
1804 DO i=1,nel
1805 value(i) = lbuf%SSP(i)
1806 is_written_value(i) = 1
1807 ENDDO
1808 ENDIF
1809 ENDIF
1810C--------------------------------------------------
1811 ELSEIF(keyword == 'VOLU') THEN
1812C--------------------------------------------------
1813 IF (gbuf%G_VOL > 0) THEN
1814 ialel=iparg(7,ng)+iparg(11,ng)
1815 IF(ialel==0)THEN
1816 mt = ixs(1,nft+1)
1817 DO i=1,nel
1818 value(i) = pm(1,mt)*gbuf%VOL(i)
1819 IF(gbuf%RHO(i)>zero)value(i) = VALUE(i)/gbuf%RHO(i)
1820 is_written_value(i) = 1
1821 ENDDO
1822 ELSE
1823 DO i=1,nel
1824 value(i) = gbuf%VOL(i)
1825 is_written_value(i) = 1
1826 ENDDO
1827 ENDIF
1828 ENDIF
1829C--------------------------------------------------
1830 ELSEIF(keyword == 'SCHLIEREN') THEN
1831C--------------------------------------------------
1832 ialel=iparg(7,ng)+iparg(11,ng)
1833 IF(ialel /= 0)THEN
1834 CALL output_schlieren(
1835 1 evar ,ixs ,x ,
1836 2 iparg ,wa_l ,elbuf_tab ,ale_connect ,gbuf%VOL,
1837 3 ng ,nixs ,ity)
1838 DO i=1,nel
1839 value(i) = evar(i)
1840 is_written_value(i) = 1
1841 ENDDO
1842 ENDIF
1843C--------------------------------------------------
1844 ELSEIF(keyword == 'DOMAIN') THEN
1845C--------------------------------------------------
1846 DO i=1,nel
1847 value(i) = ispmd
1848 is_written_value(i) = 1
1849 ENDDO
1850C--------------------------------------------------
1851 ELSEIF(keyword == 'FILL') THEN
1852C--------------------------------------------------
1853 DO i=1,nel
1854 value(i) = gbuf%FILL(i)
1855 is_written_value(i) = 1
1856 ENDDO
1857C--------------------------------------------------
1858 ELSEIF (keyword == 'SIGEQ') THEN ! /ANIM/ELEM/SIGEQ
1859C--------------------------------------------------
1860 ! equivalent stress - other then VON MISES
1861 IF (gbuf%G_SEQ > 0) THEN ! non VON MISES
1862
1863 nptg = nlay*nptr*npts*nptt
1864 DO il=1,nlay
1865 DO it=1,nptt
1866 DO ir=1,nptr
1867 DO is=1,npts
1868 lbuf => elbuf_tab(ng)%BUFLY(il)%LBUF(ir,is,it)
1869 IF (elbuf_tab(ng)%BUFLY(il)%L_SEQ > 0) THEN
1870 DO i=1,nel
1871 value(i) = value(i) + lbuf%SEQ(i)/nptg
1872 is_written_value(i) = 1
1873 ENDDO
1874 ELSE
1875 DO i=1,nel
1876 s11 = lbuf%SIG(jj(1) + i)
1877 s22 = lbuf%SIG(jj(2) + i)
1878 s33 = lbuf%SIG(jj(3) + i)
1879 s4 = lbuf%SIG(jj(4) + i)
1880 s5 = lbuf%SIG(jj(5) + i)
1881 s6 = lbuf%SIG(jj(6) + i)
1882 IF (ivisc > 0) THEN
1883 s11 = s11 + lbuf%VISC(jj(1) + i)
1884 s22 = s22 + lbuf%VISC(jj(2) + i)
1885 s33 = s33 + lbuf%VISC(jj(3) + i)
1886 s4 = s4 + lbuf%VISC(jj(4) + i)
1887 s5 = s5 + lbuf%VISC(jj(5) + i)
1888 s6 = s6 + lbuf%VISC(jj(6) + i)
1889 ENDIF
1890 p = - (s11 + s22 + s33) * third
1891 s1 = s11 + p
1892 s2 = s22 + p
1893 s3 = s33 + p
1894 vonm2 = three*(s4*s4 + s5*s5 + s6*s6 +
1895 . half*(s1*s1 + s2*s2 + s3*s3))
1896 vonm = sqrt(vonm2)
1897 value(i) = value(i) + vonm/nptg
1898 is_written_value(i) = 1
1899 ENDDO
1900 ENDIF ! IF (ELBUF_TAB(NG)%BUFLY(IL)%L_SEQ > 0)
1901 ENDDO ! DO IS=1,NPTS
1902 ENDDO ! DO IR=1,NPTR
1903 ENDDO ! DO IT=1,NPTT
1904 ENDDO ! DO IL=1,NLAY
1905 ELSE ! VON MISES
1906 DO i=1,nel
1907 s11 = gbuf%SIG(jj(1) + i)
1908 s22 = gbuf%SIG(jj(2) + i)
1909 s33 = gbuf%SIG(jj(3) + i)
1910 s4 = gbuf%SIG(jj(4) + i)
1911 s5 = gbuf%SIG(jj(5) + i)
1912 s6 = gbuf%SIG(jj(6) + i)
1913 IF (ivisc > 0) THEN
1914 s11 = s11 + lbuf%VISC(jj(1) + i)
1915 s22 = s22 + lbuf%VISC(jj(2) + i)
1916 s33 = s33 + lbuf%VISC(jj(3) + i)
1917 s4 = s4 + lbuf%VISC(jj(4) + i)
1918 s5 = s5 + lbuf%VISC(jj(5) + i)
1919 s6 = s6 + lbuf%VISC(jj(6) + i)
1920 ENDIF
1921 p = - (s11 + s22 + s33) * third
1922 s1 = s11 + p
1923 s2 = s22 + p
1924 s3 = s33 + p
1925 vonm2 = three*(s4*s4 + s5*s5 + s6*s6 +
1926 . half*(s1*s1 + s2*s2 + s3*s3))
1927 vonm = sqrt(vonm2)
1928 value(i) = vonm
1929 is_written_value(i) = 1
1930 ENDDO ! DO I=1,NEL
1931 ENDIF ! IF (GBUF%G_SEQ > 0)
1932C--------------------------------------------------
1933 ELSEIF (keyword == 'NL_EPSP') THEN
1934C--------------------------------------------------
1935 IF (gbuf%G_PLANL > 0) THEN
1936 DO i=lft,llt
1937 value(i) = zero
1938 ENDDO
1939 IF (ilay == -1) THEN
1940 DO il=1,nlay
1941 IF (elbuf_tab(ng)%BUFLY(il)%L_PLANL > 0) THEN
1942 DO is=1,npts
1943 DO it=1,nptt
1944 DO ir=1,nptr
1945 lbuf=>elbuf_tab(ng)%BUFLY(il)%LBUF(ir,is,it)
1946 DO i=lft,llt
1947 value(i) = value(i) + lbuf%PLANL(i)/nptg
1948 is_written_value(i) = 1
1949 ENDDO
1950 ENDDO
1951 ENDDO
1952 ENDDO
1953 ENDIF
1954 ENDDO
1955 ELSE
1956 IF (elbuf_tab(ng)%BUFLY(ilay)%L_PLANL > 0) THEN
1957 DO is=1,npts
1958 DO it=1,nptt
1959 DO ir=1,nptr
1960 lbuf=>elbuf_tab(ng)%BUFLY(ilay)%LBUF(ir,is,it)
1961 DO i=lft,llt
1962 value(i) = value(i) + lbuf%PLANL(i)/(nptr*npts*nptt)
1963 is_written_value(i) = 1
1964 ENDDO
1965 ENDDO
1966 ENDDO
1967 ENDDO
1968 ENDIF
1969 ENDIF
1970 ENDIF
1971C--------------------------------------------------
1972 ELSEIF (keyword == 'NL_EPSD') THEN
1973C--------------------------------------------------
1974 IF (gbuf%G_EPSDNL > 0) THEN
1975 DO i=lft,llt
1976 value(i) = zero
1977 ENDDO
1978 DO il=1,nlay
1979 IF (elbuf_tab(ng)%BUFLY(il)%L_EPSDNL > 0) THEN
1980 DO is=1,npts
1981 DO it=1,nptt
1982 DO ir=1,nptr
1983 lbuf=>elbuf_tab(ng)%BUFLY(il)%LBUF(ir,is,it)
1984 DO i=lft,llt
1985 value(i) = value(i) + lbuf%EPSDNL(i)/nptg
1986 is_written_value(i) = 1
1987 ENDDO
1988 ENDDO
1989 ENDDO
1990 ENDDO
1991 ENDIF
1992 ENDDO
1993 ENDIF
1994C--------------------------------------------------
1995 ELSEIF (keyword == 'BULK') THEN ! /ANIM/ELEM/QVIS
1996C--------------------------------------------------
1997 IF (gbuf%G_QVIS > 0) THEN
1998 DO i=1,nel
1999 value(i) = gbuf%QVIS(i)
2000 is_written_value(i) = 1
2001 ENDDO
2002 ENDIF
2003C--------------------------------------------------
2004 ELSEIF (keyword == 'TDET') THEN ! /ANIM/ELEM/TDET
2005C--------------------------------------------------
2006 IF (gbuf%G_TB > 0) THEN
2007 DO i=1,nel
2008 value(i) = -gbuf%TB(i)
2009 is_written_value(i) = 1
2010 ENDDO
2011 ENDIF
2012C--------------------------------------------------
2013 ELSEIF (keyword == 'MOMX') THEN
2014C--------------------------------------------------
2015 mt = ixs(1,nft+1)
2016 ialefvm_flg = ipm(251,mt)
2017 IF(ialefvm_flg >= 2)THEN
2018 IF (isolnod == 8)THEN
2019 DO i=1,nel
2020 value(i) = gbuf%MOM(jj(1) + i)
2021 is_written_value(i) = 1
2022 ENDDO
2023 ENDIF
2024 ENDIF
2025C--------------------------------------------------
2026 ELSEIF (keyword == 'MOMY') THEN
2027C--------------------------------------------------
2028 mt = ixs(1,nft+1)
2029 ialefvm_flg = ipm(251,mt)
2030 IF(ialefvm_flg >= 2)THEN
2031 IF (isolnod == 8)THEN
2032 DO i=1,nel
2033 value(i) = gbuf%MOM(jj(2) + i)
2034 is_written_value(i) = 1
2035 ENDDO
2036 ENDIF
2037 ENDIF
2038C--------------------------------------------------
2039 ELSEIF (keyword == 'MOMZ') THEN
2040C--------------------------------------------------
2041 mt = ixs(1,nft+1)
2042 ialefvm_flg = ipm(251,mt)
2043 IF(ialefvm_flg >= 2)THEN
2044 IF (isolnod == 8)THEN
2045 DO i=1,nel
2046 value(i) = gbuf%MOM(jj(3) + i)
2047 is_written_value(i) = 1
2048 ENDDO
2049 ENDIF
2050 ENDIF
2051C--------------------------------------------------
2052 ELSEIF (keyword == 'MOMXY') THEN
2053C--------------------------------------------------
2054 mt = ixs(1,nft+1)
2055 ialefvm_flg = ipm(251,mt)
2056 IF(ialefvm_flg >= 2)THEN
2057 IF (isolnod == 8)THEN
2058 DO i=1,nel
2059 value(i) = sqrt( gbuf%MOM(jj(1)+i)*gbuf%MOM(jj(1)+i)+
2060 . gbuf%MOM(jj(2)+i)*gbuf%MOM(jj(2)+i) )
2061 is_written_value(i) = 1
2062 ENDDO
2063 ENDIF
2064 ENDIF
2065C--------------------------------------------------
2066 ELSEIF (keyword == 'MOMYZ') THEN
2067C--------------------------------------------------
2068 mt = ixs(1,nft+1)
2069 ialefvm_flg = ipm(251,mt)
2070 IF(ialefvm_flg >= 2)THEN
2071 IF (isolnod == 8)THEN
2072 DO i=1,nel
2073 value(i) = sqrt( gbuf%MOM(jj(1)+i)*gbuf%MOM(jj(1)+i)+
2074 . gbuf%MOM(jj(3)+i)*gbuf%MOM(jj(3)+i) )
2075 is_written_value(i) = 1
2076 ENDDO
2077 ENDIF
2078 ENDIF
2079C--------------------------------------------------
2080 ELSEIF (keyword == 'MOMXZ') THEN
2081C--------------------------------------------------
2082 mt = ixs(1,nft+1)
2083 ialefvm_flg = ipm(251,mt)
2084 IF(ialefvm_flg >= 2)THEN
2085 IF (isolnod == 8)THEN
2086 DO i=1,nel
2087 value(i) = sqrt( gbuf%MOM(jj(1)+i)*gbuf%MOM(jj(1)+i)+
2088 . gbuf%MOM(jj(3)+i)*gbuf%MOM(jj(3)+i) )
2089 is_written_value(i) = 1
2090 ENDDO
2091 ENDIF
2092 ENDIF
2093C--------------------------------------------------
2094 ELSEIF (keyword == '|MOM|') THEN
2095C--------------------------------------------------
2096 mt = ixs(1,nft+1)
2097 ialefvm_flg = ipm(251,mt)
2098 IF(ialefvm_flg >= 2)THEN
2099 IF (isolnod == 8)THEN
2100 DO i=1,nel
2101 value(i) = sqrt( gbuf%MOM(jj(1)+i)*gbuf%MOM(jj(1)+i)+
2102 . gbuf%MOM(jj(2)+i)*gbuf%MOM(jj(2)+i)+
2103 . gbuf%MOM(jj(3)+i)*gbuf%MOM(jj(3)+i) )
2104 is_written_value(i) = 1
2105 ENDDO
2106 ENDIF
2107 ENDIF
2108C--------------------------------------------------
2109 ELSEIF (keyword == 'VELX') THEN
2110C--------------------------------------------------
2111 mt = ixs(1,nft+1)
2112 ialefvm_flg = ipm(251,mt)
2113 IF (mlw == 151) THEN
2114 DO i = 1, nel
2115 value(i) = multi_fvm%VEL(1, i + nft)
2116 is_written_value(i) = 1
2117 ENDDO
2118 ELSEIF(ialefvm_flg >= 2)THEN
2119 IF (isolnod == 8)THEN
2120 DO i=1,nel
2121 value(i) = gbuf%MOM(jj(1) + i) / gbuf%RHO(i)
2122 is_written_value(i) = 1
2123 ENDDO
2124 ENDIF
2125 ENDIF
2126C--------------------------------------------------
2127 ELSEIF (keyword == 'VELY') THEN
2128C--------------------------------------------------
2129 mt = ixs(1,nft+1)
2130 ialefvm_flg = ipm(251,mt)
2131 IF (mlw == 151) THEN
2132 DO i = 1, nel
2133 value(i) = multi_fvm%VEL(2, i + nft)
2134 is_written_value(i) = 1
2135 ENDDO
2136 ELSEIF(ialefvm_flg >= 2)THEN
2137 IF (isolnod == 8)THEN
2138 DO i=1,nel
2139 value(i) = gbuf%MOM(jj(2) + i) / gbuf%RHO(i)
2140 is_written_value(i) = 1
2141 ENDDO
2142 ENDIF
2143 ENDIF
2144C--------------------------------------------------
2145 ELSEIF (keyword == 'VELZ') THEN
2146C--------------------------------------------------
2147 mt = ixs(1,nft+1)
2148 ialefvm_flg = ipm(251,mt)
2149 IF (mlw == 151) THEN
2150 DO i = 1, nel
2151 value(i) = multi_fvm%VEL(3, i + nft)
2152 is_written_value(i) = 1
2153 ENDDO
2154 ELSEIF(ialefvm_flg >= 2)THEN
2155 IF (isolnod == 8)THEN
2156 DO i=1,nel
2157 value(i) = gbuf%MOM(jj(3) + i) / gbuf%RHO(i)
2158 is_written_value(i) = 1
2159 ENDDO
2160 ENDIF
2161 ENDIF
2162C--------------------------------------------------
2163 ELSEIF (keyword == 'VELXY') THEN
2164C--------------------------------------------------
2165 mt = ixs(1,nft+1)
2166 ialefvm_flg = ipm(251,mt)
2167 IF(ialefvm_flg >= 2)THEN
2168 IF (isolnod == 8)THEN
2169 DO i=1,nel
2170 value(i) = sqrt( gbuf%MOM(jj(1)+i)*gbuf%MOM(jj(1)+i)+
2171 . gbuf%MOM(jj(2)+i)*gbuf%MOM(jj(2)+i) ) / gbuf%RHO(i)
2172 is_written_value(i) = 1
2173 ENDDO
2174 ENDIF
2175 ENDIF
2176C--------------------------------------------------
2177 ELSEIF (keyword == 'VELYZ') THEN
2178C--------------------------------------------------
2179 mt = ixs(1,nft+1)
2180 ialefvm_flg = ipm(251,mt)
2181 IF(ialefvm_flg >= 2)THEN
2182 IF (isolnod == 8)THEN
2183 DO i=1,nel
2184 value(i) = sqrt( gbuf%MOM(jj(1)+i)*gbuf%MOM(jj(1)+i)+
2185 . gbuf%MOM(jj(3)+i)*gbuf%MOM(jj(3)+i) ) / gbuf%RHO(i)
2186 is_written_value(i) = 1
2187 ENDDO
2188 ENDIF
2189 ENDIF
2190C--------------------------------------------------
2191 ELSEIF (keyword == 'VELXZ') THEN
2192C--------------------------------------------------
2193 mt = ixs(1,nft+1)
2194 ialefvm_flg = ipm(251,mt)
2195 IF(ialefvm_flg >= 2)THEN
2196 IF (isolnod == 8)THEN
2197 DO i=1,nel
2198 value(i) = sqrt( gbuf%MOM(jj(1)+i)*gbuf%MOM(jj(1)+i)+
2199 . gbuf%MOM(jj(3)+i)*gbuf%MOM(jj(3)+i) ) / gbuf%RHO(i)
2200 is_written_value(i) = 1
2201 ENDDO
2202 ENDIF
2203 ENDIF
2204C--------------------------------------------------
2205 ELSEIF (keyword == '|VEL|') THEN
2206C--------------------------------------------------
2207 mt = ixs(1,nft+1)
2208 ialefvm_flg = ipm(251,mt)
2209 IF(ialefvm_flg >= 2)THEN
2210 IF (isolnod == 8)THEN
2211 DO i=1,nel
2212 value(i) = sqrt( gbuf%MOM(jj(1)+i)*gbuf%MOM(jj(1)+i)+
2213 . gbuf%MOM(jj(2)+i)*gbuf%MOM(jj(2)+i)+
2214 . gbuf%MOM(jj(3)+i)*gbuf%MOM(jj(3)+i) ) / gbuf%RHO(i)
2215 is_written_value(i) = 1
2216 ENDDO
2217 ENDIF
2218 ENDIF
2219C--------------------------------------------------
2220 ELSEIF (keyword == 'AMS')THEN
2221C--------------------------------------------------
2222 IF(gbuf%G_ISMS > 0) THEN
2223 DO i=1,nel
2224 value(i) = gbuf%ISMS(i)
2225 is_written_value(i) = 1
2226 ENDDO
2227 ENDIF
2228C--------------------------------------------------
2229 ELSEIF (keyword == 'EINTM' .OR. keyword == 'ENER')THEN
2230C--------------------------------------------------
2231 !LAG: GBUF%VOL = V0, GBUF%EINT=rho0.e
2232 IF (mlw == 151) THEN
2233 DO i = 1, nel
2234 value(i) = multi_fvm%EINT(i + nft) / multi_fvm%RHO(i + nft) !
2235 is_written_value(i) = 1
2236 ENDDO
2237 ELSE
2238 ialel=iparg(7,ng)+iparg(11,ng)
2239 IF(ialel == 0)THEN
2240 DO i=1,nel
2241 n = i + nft
2242 mt=ixs(1,n)
2243 value(i) = gbuf%EINT(i)/max(em20,pm(89,mt)) !
2244 is_written_value(i) = 1
2245 ENDDO
2246 ELSE
2247 DO i=1,nel
2248 value(i) = gbuf%EINT(i)/max(em20,gbuf%RHO(i)) !
2249 is_written_value(i) = 1
2250 ENDDO
2251 ENDIF
2252 ENDIF
2253C--------------------------------------------------
2254 ELSEIF (keyword == 'EINTV')THEN
2255C--------------------------------------------------
2256 IF (mlw == 151) THEN
2257 DO i = 1, nel
2258 value(i) = multi_fvm%EINT(i + nft)
2259 is_written_value(i) = 1
2260 ENDDO
2261 ELSE
2262 ialel=iparg(7,ng)+iparg(11,ng)
2263 IF(ialel == 0)THEN
2264 DO i=1,nel
2265 n = i + nft
2266 mt=ixs(1,n)
2267 value(i) = gbuf%EINT(i)/max(em20,pm(89,mt))*gbuf%RHO(i)
2268 is_written_value(i) = 1
2269 ENDDO
2270 ELSE
2271 DO i=1,nel
2272 value(i) = gbuf%EINT(i)
2273 is_written_value(i) = 1
2274 ENDDO
2275 ENDIF
2276 ENDIF
2277C--------------------------------------------------
2278 ELSEIF (keyword == 'EINT')THEN
2279C--------------------------------------------------
2280 IF (mlw == 151) THEN
2281 DO i = 1, nel
2282 value(i) = multi_fvm%EINT(i + nft) * gbuf%VOL(i)
2283 is_written_value(i) = 1
2284 ENDDO
2285 ELSE
2286 ialel=iparg(7,ng)+iparg(11,ng)
2287 IF(ialel == 0)THEN
2288 DO i=1,nel
2289 n = i + nft
2290 mt=ixs(1,n)
2291 vol=gbuf%VOL(i)*pm(89,mt)/gbuf%RHO(i)
2292 value(i) = gbuf%EINT(i)/pm(89,mt)*gbuf%RHO(i)*vol
2293 is_written_value(i) = 1
2294 ENDDO
2295 ELSE
2296 DO i=1,nel
2297 value(i) = gbuf%EINT(i)*gbuf%VOL(i)
2298 is_written_value(i) = 1
2299 ENDDO
2300 ENDIF
2301 ENDIF
2302C--------------------------------------------------
2303 ELSEIF (keyword(1:4) == 'ENTH')THEN
2304C--------------------------------------------------
2305 IF (mlw == 151) THEN
2306 DO i = 1, nel
2307 pres(i) = multi_fvm%PRES(i + nft)
2308 ENDDO
2309 ELSE
2310 DO i=1,nel
2311 pres(i) = - (gbuf%SIG(jj(1) + i)+ gbuf%SIG(jj(2) + i) + gbuf%SIG(jj(3) + i))*third
2312 ENDDO
2313 ENDIF
2314 !GBUF%EINT is rho.e
2315C--------------------------------------------------
2316 IF(keyword == 'ENTH')THEN
2317 IF (mlw == 151) THEN
2318 DO i = 1, nel
2319 value(i) = multi_fvm%EINT(i + nft) / multi_fvm%RHO(i + nft) + pres(i)*gbuf%VOL(i) !
2320 is_written_value(i) = 1
2321 ENDDO
2322 ELSE
2323 ialel=iparg(7,ng)+iparg(11,ng)
2324 IF(ialel == 0)THEN
2325 DO i=1,nel
2326 n = i + nft
2327 mt=ixs(1,n)
2328 mass0=gbuf%VOL(i)*pm(89,mt)
2329 vol=mass0/max(em20,gbuf%RHO(i))
2330 value(i) = gbuf%EINT(i)/max(em20,pm(89,mt)) + pres(i)*vol
2331 is_written_value(i) = 1
2332 ENDDO
2333 ELSE
2334 DO i=1,nel
2335 value(i) = gbuf%EINT(i)/gbuf%RHO(i) + pres(i)*gbuf%VOL(i)
2336 is_written_value(i) = 1
2337 ENDDO
2338 ENDIF
2339 ENDIF
2340C--------------------------------------------------
2341 ELSEIF(keyword == 'ENTHV')THEN
2342 IF (mlw == 151) THEN
2343 DO i = 1, nel
2344 value(i) = multi_fvm%EINT(i + nft) / multi_fvm%RHO(i + nft)/gbuf%VOL(i) + pres(i) !
2345 is_written_value(i) = 1
2346 ENDDO
2347 ELSE
2348 ialel=iparg(7,ng)+iparg(11,ng)
2349 IF(ialel == 0)THEN
2350 DO i=1,nel
2351 n = i + nft
2352 mt=ixs(1,n)
2353 mass0=gbuf%VOL(i)*pm(89,mt)
2354 vol=mass0/max(em20,gbuf%RHO(i))
2355 value(i) = gbuf%EINT(i)/max(em20,pm(89,mt))/vol + pres(i)
2356 is_written_value(i) = 1
2357 ENDDO
2358 ELSE
2359 DO i=1,nel
2360 value(i) = gbuf%EINT(i)/gbuf%VOL(i)/gbuf%RHO(i) + pres(i)
2361 is_written_value(i) = 1
2362 ENDDO
2363 ENDIF
2364 ENDIF
2365C--------------------------------------------------
2366 ELSEIF(keyword == 'ENTHM')THEN
2367 IF (mlw == 151) THEN
2368 DO i = 1, nel
2369 mass(i) = multi_fvm%RHO(i + nft)*gbuf%VOL(i)
2370 value(i) = (multi_fvm%EINT(i + nft) / multi_fvm%RHO(i + nft) + pres(i)*gbuf%VOL(i))/mass(i) !
2371 is_written_value(i) = 1
2372 ENDDO
2373 ELSE
2374 ialel=iparg(7,ng)+iparg(11,ng)
2375 IF(ialel == 0)THEN
2376 DO i=1,nel
2377 n = i + nft
2378 mt=ixs(1,n)
2379 mass0=gbuf%VOL(i)*pm(89,mt)
2380 vol=mass0/max(em20,gbuf%RHO(i))
2381 mass(i)=mass0
2382 value(i) = (gbuf%EINT(i)/max(em20,pm(89,mt)) + pres(i)*vol)/mass(i)
2383 is_written_value(i) = 1
2384 ENDDO
2385 ELSE
2386 DO i=1,nel
2387 mass(i)=gbuf%RHO(i)*gbuf%VOL(i)
2388 VALUE(i) = (gbuf%EINT(i)/gbuf%RHO(i) + pres(i)*gbuf%VOL(i))/mass(i)
2389 is_written_value(i) = 1
2390 ENDDO
2391 endif!IALEL
2392 endif!MLW
2393 endif!keyword subcase
2394C--------------------------------------------------
2395 ELSEIF(keyword == 'OFF')THEN
2396C--------------------------------------------------
2397 DO i=1,nel
2398 IF (gbuf%G_OFF > 0) THEN
2399 IF(gbuf%OFF(i) > one) THEN
2400 value(i) = gbuf%OFF(i) - one
2401 ELSEIF((gbuf%OFF(i) >= zero .AND. gbuf%OFF(i) <= one)) THEN
2402 value(i) = gbuf%OFF(i)
2403 ELSE
2404 value(i) = -one
2405 ENDIF
2406 ENDIF
2407 is_written_value(i) = 1
2408 ENDDO
2409C--------------------------------------------------
2410 ELSEIF(keyword == 'MACH') THEN
2411C--------------------------------------------------
2412 IF (mlw == 151) THEN
2413 DO i = 1, nel
2414 vel(1) = multi_fvm%VEL(1, i + nft)
2415 vel(2) = multi_fvm%VEL(2, i + nft)
2416 vel(3) = multi_fvm%VEL(3, i + nft)
2417 vel(0) = sqrt(vel(1)*vel(1)+vel(2)*vel(2)+vel(3)*vel(3))
2418 value(i) = vel(0)/multi_fvm%SOUND_SPEED(i + nft)
2419 is_written_value(i) = 1
2420 ENDDO
2421 ELSEIF(alefvm_param%ISOLVER>1)THEN
2422 l = elbuf_tab(ng)%BUFLY(1)%L_SSP
2423 IF(elbuf_tab(ng)%BUFLY(1)%L_SSP /= 0)THEN
2424 lbuf => elbuf_tab(ng)%BUFLY(1)%LBUF(1,1,1)
2425 DO i=1,nel
2426 vel(1) = gbuf%MOM(jj(1) + i) / gbuf%RHO(i)
2427 vel(2) = gbuf%MOM(jj(2) + i) / gbuf%RHO(i)
2428 vel(3) = gbuf%MOM(jj(3) + i) / gbuf%RHO(i)
2429 vel(0) = sqrt(vel(1)*vel(1)+vel(2)*vel(2)+vel(3)*vel(3))
2430 value(i) = vel(0)/lbuf%SSP(i)
2431 is_written_value(i) = 1
2432 ENDDO
2433 ENDIF
2434 ELSE
2435 l = elbuf_tab(ng)%BUFLY(1)%L_SSP
2436 IF(elbuf_tab(ng)%BUFLY(1)%L_SSP /= 0)THEN
2437 lbuf => elbuf_tab(ng)%BUFLY(1)%LBUF(1,1,1)
2438 IF(is_ale /= 0)THEN
2439 !ale
2440 tmp_2(1:nel,1:3) = zero
2441 DO j=1,8
2442 DO i=1,nel
2443 tmp_2(i,1)=tmp_2(i,1) + v(1,ixs(j+1,i+nft))-w(1,ixs(j+1,i+nft))
2444 tmp_2(i,2)=tmp_2(i,2) + v(2,ixs(j+1,i+nft))-w(2,ixs(j+1,i+nft))
2445 tmp_2(i,3)=tmp_2(i,3) + v(3,ixs(j+1,i+nft))-w(3,ixs(j+1,i+nft))
2446 ENDDO
2447 ENDDO
2448 DO i=1,nel
2449 vel(1) = tmp_2(i,1)*one_over_8
2450 vel(2) = tmp_2(i,2)*one_over_8
2451 vel(3) = tmp_2(i,3)*one_over_8
2452 value(i) = sqrt(vel(1)*vel(1)+vel(2)*vel(2)+vel(3)*vel(3))/lbuf%SSP(i)
2453 is_written_value(i) = 1
2454 ENDDO
2455 ELSE
2456 !euler and lagrange
2457 tmp_2(1:nel,1:3) = zero
2458 DO j=1,8
2459 DO i=1,nel
2460 tmp_2(i,1)=tmp_2(i,1)+v(1,ixs(j+1,i+nft))
2461 tmp_2(i,2)=tmp_2(i,2)+v(2,ixs(j+1,i+nft))
2462 tmp_2(i,3)=tmp_2(i,3)+v(3,ixs(j+1,i+nft))
2463 ENDDO
2464 ENDDO
2465 DO i=1,nel
2466 vel(1) = tmp_2(i,1)*one_over_8
2467 vel(2) = tmp_2(i,2)*one_over_8
2468 vel(3) = tmp_2(i,3)*one_over_8
2469 value(i) = sqrt(vel(1)*vel(1)+vel(2)*vel(2)+vel(3)*vel(3))/lbuf%SSP(i)
2470 is_written_value(i) = 1
2471 ENDDO
2472 ENDIF
2473 ENDIF
2474 ENDIF
2475C--------------------------------------------------
2476 ELSEIF(keyword == 'GROUP')THEN
2477C--------------------------------------------------
2478 DO i=1,nel
2479 value(i) = ng
2480 is_written_value(i) = 1
2481 ENDDO
2482C--------------------------------------------------
2483 ELSEIF(keyword == 'INTERNAL.ID')THEN
2484C--------------------------------------------------
2485 DO i=1,nel
2486 value(i) = i+nft
2487 is_written_value(i) = 1
2488 ENDDO
2489C--------------------------------------------------
2490 ELSEIF(keyword == 'LOCAL.ID')THEN
2491C--------------------------------------------------
2492 DO i=1,nel
2493 value(i) = i
2494 is_written_value(i) = 1
2495 ENDDO
2496C--------------------------------------------------
2497 ELSEIF(keyword == 'THICK' )THEN
2498C--------vol=mass/rho=vol0*rho0/rho make sure GBUF%RHO is well computed in elem
2499C--------thick = vol/A_m : new routine to compute A_m
2500 mt = ixs(1,nft+1)
2501 rho0 = pm(1,mt)
2502 IF (isolnod == 6 )THEN
2503C-- 2g1=2-1+5-4; 2g2 = 3-1+6-4
2504 DO i=1,nel
2505 n = i + nft
2506 nc(1:3) = ixs(2:4,n)
2507 nc(4:6) = ixs(6:8,n)
2508 g1(i,1:3) = x(1:3,nc(2))-x(1:3,nc(1))+x(1:3,nc(5))-x(1:3,nc(4))
2509 g2(i,1:3) = x(1:3,nc(3))-x(1:3,nc(1))+x(1:3,nc(6))-x(1:3,nc(4))
2510 ENDDO
2511 CALL ths_marea(g1(1,1),g1(1,2),g1(1,3),g2(1,1),g2(1,2),g2(1,3),det,nel)
2512 DO i=1,nel
2513 voln(i)=gbuf%VOL(i)*rho0/gbuf%RHO(i)
2514 aream(i) =one_over_8*det(i)
2515 value(i) = voln(i)/aream(i)
2516 is_written_value(i) = 1
2517 ENDDO
2518 ELSEIF (isolnod == 8 )THEN
2519C-- 4g1=2+3+6+7-1-4-5-8; 4g2 = 3+4+7+8-1-2-5-6; 4g3 = 5+6+7+8-1-2-3-4;
2520 IF (jhbe==14 ) THEN
2521 DO i=1,nel
2522 n = i + nft
2523 nc(1:8) = ixs(2:9,n)
2524 g1(i,1:3) = x(1:3,nc(2))+x(1:3,nc(3))+x(1:3,nc(6))+x(1:3,nc(7))
2525 . -x(1:3,nc(1))-x(1:3,nc(4))-x(1:3,nc(5))-x(1:3,nc(8))
2526 g2(i,1:3) = x(1:3,nc(3))+x(1:3,nc(4))+x(1:3,nc(7))+x(1:3,nc(8))
2527 . -x(1:3,nc(1))-x(1:3,nc(2))-x(1:3,nc(5))-x(1:3,nc(6))
2528 g3(i,1:3) = x(1:3,nc(5))+x(1:3,nc(6))+x(1:3,nc(7))+x(1:3,nc(8))
2529 . -x(1:3,nc(1))-x(1:3,nc(2))-x(1:3,nc(3))-x(1:3,nc(4))
2530 ENDDO
2531C------RHO0 isn't right w/ composite
2532 IF (igtyp==22) THEN
2533 CALL ths_vol(g1(1,1),g1(1,2),g1(1,3),g2(1,1),g2(1,2),g2(1,3),
2534 . g3(1,1),g3(1,2),g3(1,3),det,nel)
2535 voln(1:nel)=zep015625*det(1:nel)
2536 ELSE
2537 voln(1:nel)=gbuf%VOL(1:nel)*rho0/gbuf%RHO(1:nel)
2538 END IF
2539 icsig = iparg(17,ng)
2540 SELECT CASE (icsig)
2541 CASE (1) ! g2,g3
2542 CALL ths_marea(g2(1,1),g2(1,2),g2(1,3),g3(1,1),g3(1,2),g3(1,3),det,nel)
2543 CASE (10) ! g1,g2
2544 CALL ths_marea(g1(1,1),g1(1,2),g1(1,3),g2(1,1),g2(1,2),g2(1,3),det,nel)
2545 CASE (100) ! g3,g1
2546 CALL ths_marea(g3(1,1),g3(1,2),g3(1,3),g1(1,1),g1(1,2),g1(1,3),det,nel)
2547 END SELECT
2548 DO i=1,nel
2549 aream(i) =one_over_16*det(i)
2550 value(i) = voln(i)/aream(i)
2551 is_written_value(i) = 1
2552 ENDDO
2553 ELSE
2554 DO i=1,nel
2555 n = i + nft
2556 nc(1:8) = ixs(2:9,n)
2557 g1(i,1:3) = x(1:3,nc(2))+x(1:3,nc(3))+x(1:3,nc(6))+x(1:3,nc(7))
2558 . -x(1:3,nc(1))-x(1:3,nc(4))-x(1:3,nc(5))-x(1:3,nc(8))
2559 g2(i,1:3) = x(1:3,nc(3))+x(1:3,nc(4))+x(1:3,nc(7))+x(1:3,nc(8))
2560 . -x(1:3,nc(1))-x(1:3,nc(2))-x(1:3,nc(5))-x(1:3,nc(6))
2561 ENDDO
2562 CALL ths_marea(g1(1,1),g1(1,2),g1(1,3),g2(1,1),g2(1,2),g2(1,3),det,nel)
2563 DO i=1,nel
2564 voln(i)=gbuf%VOL(i)*rho0/gbuf%RHO(i)
2565 aream(i) =one_over_16*det(i)
2566 value(i) = voln(i)/aream(i)
2567 is_written_value(i) = 1
2568 ENDDO
2569 END IF
2570 ELSEIF (isolnod == 16 .OR. isolnod == 20) THEN
2571C---- approximated by S8
2572 DO i=1,nel
2573 n = i + nft
2574 nc(1:8) = ixs(2:9,n)
2575 g1(i,1:3) = x(1:3,nc(2))+x(1:3,nc(3))+x(1:3,nc(6))+x(1:3,nc(7))
2576 . -x(1:3,nc(1))-x(1:3,nc(4))-x(1:3,nc(5))-x(1:3,nc(8))
2577 g2(i,1:3) = x(1:3,nc(3))+x(1:3,nc(4))+x(1:3,nc(7))+x(1:3,nc(8))
2578 . -x(1:3,nc(1))-x(1:3,nc(2))-x(1:3,nc(5))-x(1:3,nc(6))
2579 ENDDO
2580 CALL ths_marea(g1(1,1),g1(1,2),g1(1,3),g2(1,1),g2(1,2),g2(1,3),det,nel)
2581 DO i=1,nel
2582 voln(i)=gbuf%VOL(i)*rho0/gbuf%RHO(i)
2583 aream(i) =one_over_16*det(i)
2584 value(i) = voln(i)/aream(i)
2585 is_written_value(i) = 1
2586 ENDDO
2587 ELSEIF (isolnod == 4 .OR. isolnod == 10) THEN
2588C---- doesn't make sense
2589 END IF
2590 ELSEIF(keyword == 'THIN')THEN
2591 IF(tshell == 1)THEN
2592 fac = one/nlay
2593 ezz(1:nel) = zero
2594 IF (jhbe==15 ) THEN
2595 fac = one/nlay
2596 DO ilay=1,nlay
2597 lbuf => elbuf_tab(ng)%BUFLY(ilay)%LBUF(1,1,1)
2598 DO i=1,nel
2599 ezz(i) = ezz(i)+fac*lbuf%STRA(jj(3)+i)
2600 ENDDO
2601 END DO
2602 value(1:nel) = -hundred*(exp(ezz(1:nel))-one)
2603 is_written_value(1:nel) = 1
2604 ELSEIF (jhbe==14 ) THEN
2605 fac = one/(nlay*nptr*npts)
2606 DO ir=1,nptr
2607 DO is=1,npts
2608 DO ilay=1,nlay
2609 lbuf => elbuf_tab(ng)%BUFLY(ilay)%LBUF(ir,is,1)
2610 DO i=1,nel
2611 ezz(i) = ezz(i)+fac*lbuf%STRA(jj(3)+i)
2612 ENDDO
2613 ENDDO ! IL=1,NLAY
2614 ENDDO ! IS=1,NPTS
2615 ENDDO ! IR=1,NPTR
2616 value(1:nel) = -hundred*(exp(ezz(1:nel))-one)
2617 is_written_value(1:nel) = 1
2618 ELSEIF (jhbe==16 ) THEN
2619 DO i=1,nel
2620 n = i + nft
2621 nc(1:8) = ixs(2:9,n)
2622 g3(i,1:3) = x(1:3,nc(5))+x(1:3,nc(6))+x(1:3,nc(7))+x(1:3,nc(8))
2623 . -x(1:3,nc(1))-x(1:3,nc(2))-x(1:3,nc(3))-x(1:3,nc(4))
2624 ENDDO
2625 fac = one/(nlay*nptr*nptt)
2626 DO it=1,nptt
2627 DO ir=1,nptr
2628 DO ilay=1,nlay
2629 lbuf => elbuf_tab(ng)%BUFLY(ilay)%LBUF(ir,1,it)
2630C-------strain is calculated in basic system of S16 will be done later
2631 DO i=1,nel
2632 e33 = g3(i,1)*g3(i,1)*lbuf%STRA(jj(1)+i)
2633 . +g3(i,2)*g3(i,2)*lbuf%STRA(jj(2)+i)
2634 . +g3(i,3)*g3(i,3)*lbuf%STRA(jj(3)+i)
2635 . +g3(i,1)*g3(i,2)*lbuf%STRA(jj(4)+i)
2636 . +g3(i,2)*g3(i,3)*lbuf%STRA(jj(5)+i)
2637 . +g3(i,3)*g3(i,1)*lbuf%STRA(jj(6)+i)
2638 ezz(i) = ezz(i)+fac*e33
2639 ENDDO
2640 enddo!IL=1,NLAY
2641 enddo!IR=1,NPTR
2642 enddo!IT=1,NPTT
2643 value(1:nel) = hundred*ezz(1:nel)
2644 is_written_value(1:nel) = 1
2645 END IF
2646 ELSEIF (isolnod == 8 .OR. isolnod == 20) THEN
2647 IF (jcvt==0 ) THEN
2648 DO i=1,nel
2649 n = i + nft
2650 nc(1:8) = ixs(2:9,n)
2651 g3(i,1:3) = x(1:3,nc(5))+x(1:3,nc(6))+x(1:3,nc(7))+x(1:3,nc(8))
2652 . -x(1:3,nc(1))-x(1:3,nc(2))-x(1:3,nc(3))-x(1:3,nc(4))
2653 ENDDO
2654 fac = one/(nptr*npts*nptt)
2655 DO it=1,nptt
2656 DO ir=1,nptr
2657 DO is=1,npts
2658 lbuf => elbuf_tab(ng)%BUFLY(1)%LBUF(ir,is,it)
2659 DO i=1,nel
2660 e33 = g3(i,1)*g3(i,1)*lbuf%STRA(jj(1)+i)
2661 . +g3(i,2)*g3(i,2)*lbuf%STRA(jj(2)+i)
2662 . +g3(i,3)*g3(i,3)*lbuf%STRA(jj(3)+i)
2663 . +g3(i,1)*g3(i,2)*lbuf%STRA(jj(4)+i)
2664 . +g3(i,2)*g3(i,3)*lbuf%STRA(jj(5)+i)
2665 . +g3(i,3)*g3(i,1)*lbuf%STRA(jj(6)+i)
2666 ezz(i) = ezz(i)+fac*e33
2667 ENDDO
2668 enddo!IL=1,NLAY
2669 enddo!IR=1,NPTR
2670 enddo!IT=1,NPTT
2671 value(1:nel) = hundred*ezz(1:nel)
2672 is_written_value(1:nel) = 1
2673 ELSE
2674 fac = one/(nptr*npts*nptt)
2675 SELECT CASE (jhbe)
2676 CASE (1,17)
2677 DO it=1,nptt
2678 DO ir=1,nptr
2679 DO is=1,npts
2680 lbuf => elbuf_tab(ng)%BUFLY(1)%LBUF(ir,is,it)
2681 DO i=1,nel
2682 ezz(i) = ezz(i)+fac*lbuf%STRA(jj(2)+i)
2683 ENDDO
2684 enddo!IL=1,NLAY
2685 enddo!IR=1,NPTR
2686 enddo!IT=1,NPTT
2687 value(1:nel) = hundred*ezz(1:nel)
2688 is_written_value(1:nel) = 1
2689 CASE (24,14)
2690 DO it=1,nptt
2691 DO ir=1,nptr
2692 DO is=1,npts
2693 lbuf => elbuf_tab(ng)%BUFLY(1)%LBUF(ir,is,it)
2694 DO i=1,nel
2695 ezz(i) = ezz(i)+fac*lbuf%STRA(jj(3)+i)
2696 ENDDO
2697 ENDDO
2698 enddo!IR=1,NPTR
2699 enddo!IT=1,NPTT
2700 value(1:nel) = hundred*ezz(1:nel)
2701 is_written_value(1:nel) = 1
2702 END SELECT
2703 END IF
2704 END IF !(TSHELL == 1)THEN
2705C--------------------------------------------------
2706 ELSEIF(keyword == 'COLOR') THEN
2707C--------------------------------------------------
2708 gbuf => elbuf_tab(ng)%GBUF
2709 IF (mlw == 151) THEN
2710 nfrac=multi_fvm%NBMAT
2711 DO imat=1,nfrac
2712 lbuf => elbuf_tab(ng)%BUFLY(imat)%LBUF(1,1,1)
2713 DO i=1,nel
2714 vfrac(i,imat) = lbuf%VOL(i) / gbuf%VOL(i)
2715 ENDDO
2716 ENDDO
2717 ELSEIF(mlw == 20)THEN
2718 nfrac=2
2719 DO i=1,nel
2720 vfrac(i,1) = elbuf_tab(ng)%BUFLY(1)%LBUF(1,1,1)%VOL(i) / gbuf%VOL(i)
2721 vfrac(i,2) = elbuf_tab(ng)%BUFLY(2)%LBUF(1,1,1)%VOL(i) / gbuf%VOL(i)
2722 ENDDO
2723 ELSEIF(mlw == 37)THEN
2724 mbuf => elbuf_tab(ng)%BUFLY(1)%MAT(1,1,1)
2725 nfrac=2
2726 DO i=1,nel
2727 vfrac(i,1) = mbuf%VAR(i+3*nel)
2728 vfrac(i,2) = mbuf%VAR(i+4*nel)
2729 ENDDO
2730 ELSEIF(mlw == 51)THEN
2731 !get UPARAM
2732 imat = ixs(1,nft+1)
2733 iadbuf = ipm(7,imat)
2734 nuparam= ipm(9,imat)
2735 uparam => bufmat(iadbuf:iadbuf+nuparam)
2736 !bijective order !indexes
2737 isubmat=uparam(276+1); iu(1)=m51_n0phas+(isubmat-1)*m51_nvphas
2738 isubmat=uparam(276+2); iu(2)=m51_n0phas+(isubmat-1)*m51_nvphas
2739 isubmat=uparam(276+3); iu(3)=m51_n0phas+(isubmat-1)*m51_nvphas
2740 isubmat=uparam(276+4); iu(4)=m51_n0phas+(isubmat-1)*m51_nvphas
2741 mbuf => elbuf_tab(ng)%BUFLY(1)%MAT(1,1,1)
2742 nfrac=4
2743 DO i=1,nel
2744 vfrac(i,1) = mbuf%VAR(i+iu(1)*nel)
2745 vfrac(i,2) = mbuf%VAR(i+iu(2)*nel)
2746 vfrac(i,3) = mbuf%VAR(i+iu(3)*nel)
2747 vfrac(i,4) = mbuf%VAR(i+iu(4)*nel)
2748 ENDDO
2749 ELSE
2750 nfrac=0
2751 !VFRAC(1:NEL,1:21)=ZERO
2752 ENDIF
2753 IF(nfrac>0)THEN
2754 DO i=1,nel
2755 value(i)=zero
2756 DO imat=1,nfrac
2757 value(i) = value(i) + vfrac(i,imat)*imat
2758 ENDDO
2759 is_written_value(i) = 1
2760 ENDDO
2761 ENDIF
2762C--------------------------------------------------
2763
2764C--------------------------------------------------
2765 ELSEIF(keyword == 'VONM/TMAX') THEN
2766C--------------------------------------------------
2767 DO i=1,nel
2768 value(i) = gbuf%TM_YIELD(i)
2769 is_written_value(i) = 1
2770 ENDDO
2771C--------------------------------------------------
2772 ELSEIF(keyword == 'SIGEQ/TMAX') THEN
2773C--------------------------------------------------
2774 DO i=1,nel
2775 value(i) = gbuf%TM_SEQ(i)
2776 is_written_value(i) = 1
2777 ENDDO
2778C--------------------------------------------------
2779 ELSEIF(keyword == 'ENER/TMAX') THEN
2780C--------------------------------------------------
2781 DO i=1,nel
2782 value(i) = gbuf%TM_EINT(i)
2783 is_written_value(i) = 1
2784 ENDDO
2785C--------------------------------------------------
2786 ELSEIF(keyword == 'DAMA/TMAX') THEN
2787C--------------------------------------------------
2788 DO i=1,nel
2789 value(i) = gbuf%TM_DMG(i)
2790 is_written_value(i) = 1
2791 ENDDO
2792C--------------------------------------------------
2793 ELSEIF(keyword == 'TILLOTSON') THEN
2794C--------------------------------------------------
2795 mt = ixs(1,nft+1)
2796 IF (mlw == 151) THEN
2797 !count number of submaterial based on /EOS/TILLOTSON (IEOS=3)
2798 ntillotson = 0
2799 DO imat=1,nlay
2800 ieos = ipm(4, mat_param(mt)%MULTIMAT%MID(imat) )
2801 IF(ieos == 3)THEN
2802 ntillotson = ntillotson + 1
2803 imat_tillotson = imat
2804 ENDIF
2805 ENDDO
2806 !several Tillotson EoS Value= sum ( Region_i*10**(i-1), i=1,imat)
2807 IF(ntillotson > 1)THEN
2808 fac=one
2809 DO imat=1,nlay
2810 ieos = ipm(4, mat_param(mt)%MULTIMAT%MID(imat) )
2811 IF(ieos == 3)THEN
2812 ebuf => elbuf_tab(ng)%BUFLY(imat)%EOS(1,1,1)
2813 nvareos = elbuf_tab(ng)%BUFLY(imat)%NVAR_EOS
2814 DO i=1,nel
2815 value(i) = value(i) + ebuf%VAR(i) * fac
2816 is_written_value(i) = 1
2817 ENDDO
2818 ENDIF
2819 fac=fac*ten
2820 ENDDO
2821 !single Tillotson EoS Value= Region_i
2822 ELSEIF(ntillotson == 1)THEN
2823 ebuf => elbuf_tab(ng)%BUFLY(imat_tillotson)%EOS(1,1,1)
2824 nvareos = elbuf_tab(ng)%BUFLY(imat_tillotson)%NVAR_EOS
2825 DO i=1,nel
2826 value(i) = ebuf%VAR(i)
2827 is_written_value(i) = 1
2828 ENDDO
2829 ENDIF
2830 ELSE
2831 !monomaterial law
2832 ieos = ipm(4,mt)
2833 IF(ieos == 3)THEN
2834 ebuf => elbuf_tab(ng)%BUFLY(1)%EOS(1,1,1)
2835 nvareos = elbuf_tab(ng)%BUFLY(1)%NVAR_EOS
2836 DO i=1,nel
2837 value(i) = ebuf%VAR(i)
2838 is_written_value(i) = 1
2839 ENDDO
2840 ENDIF
2841 ENDIF
2842C--------------------------------------------------
2843 ELSEIF(keyword == 'DIV(U)') THEN
2844C--------------------------------------------------
2845 ialel=iparg(7,ng)+iparg(11,ng)
2846 IF(ialel /= 0)THEN
2847 CALL output_div_u(
2848 1 evar ,ixs ,x ,v , iparg ,elbuf_tab ,ng ,nixs ,1,
2849 2 numels ,nel ,numnod ,nparg , ngroup ,n2d , nft)
2850 DO i=1,nel
2851 value(i) = evar(i)
2852 is_written_value(i) = 1
2853 ENDDO
2854 ENDIF
2855C--------------------------------------------------
2856 ELSEIF (keyword == 'ECONTROL')THEN
2857C--------------------------------------------------
2858 IF (gbuf%G_EINT_DISTOR>0) THEN
2859 DO i=1,nel
2860 value(i) = gbuf%EINT_DISTOR(i)
2861 is_written_value(i) = 1
2862 ENDDO
2863 ENDIF
2864!--------------------------------------------------
2865 elseif(keyword == 'VSTRAIN') then
2866!--------------------------------------------------
2867 do i=1,nel
2868 mt = ixs(1,i+nft)
2869 if(mlw == 151)then
2870 !multimaterial 151 (collocated scheme)
2871 do ilay=1,nlay
2872 mid = mat_param(mt)%multimat%mid(ilay)
2873 rho0i(ilay) = pm(89,mid)
2874 vi(ilay) = multi_fvm%phase_alpha(ilay,i+nft) * gbuf%vol(i)
2875 v0i(ilay) = multi_fvm%phase_rho(ilay,i+nft) * vi(ilay) / rho0i(ilay) !rho0.V0 = rho.V
2876 enddo
2877 v0g = sum(v0i)
2878 rho0g = zero
2879 do ilay=1,nlay
2880 rho0g = rho0g + rho0i(ilay)*v0i(ilay)
2881 end do
2882 rho0g = rho0g / v0g
2883 value(i) = multi_fvm%rho(i+nft) / rho0g - one
2884 is_written_value(i) = 1
2885
2886 elseif(mlw == 51)then
2887 !multimaterial 51 (staggered scheme)
2888 imat = ixs(1,nft+1)
2889 iadbuf = ipm(7,imat)
2890 nuparam= ipm(9,imat)
2891 uparam => bufmat(iadbuf:iadbuf+nuparam)
2892 mbuf => elbuf_tab(ng)%bufly(1)%mat(1,1,1)
2893 ipos = 1
2894 !bijective order !indexes
2895 isubmat = nint(uparam(276+1)); iu(1)=m51_n0phas +(isubmat-1)*m51_nvphas + ipos-1
2896 isubmat = nint(uparam(276+2)); iu(2)=m51_n0phas +(isubmat-1)*m51_nvphas + ipos-1
2897 isubmat = nint(uparam(276+3)); iu(3)=m51_n0phas +(isubmat-1)*m51_nvphas + ipos-1
2898 isubmat = nint(uparam(276+4)); iu(4)=m51_n0phas +(isubmat-1)*m51_nvphas + ipos-1
2899 vfrac(i,1) = mbuf%var(i+iu(1)*nel)
2900 vfrac(i,2) = mbuf%var(i+iu(2)*nel)
2901 vfrac(i,3) = mbuf%var(i+iu(3)*nel)
2902 vfrac(i,4) = mbuf%var(i+iu(4)*nel)
2903 ipos = 12
2904 !bijective order !indexes
2905 isubmat = nint(uparam(276+1)); iu(1)=m51_n0phas +(isubmat-1)*m51_nvphas + ipos-1
2906 isubmat = nint(uparam(276+2)); iu(2)=m51_n0phas +(isubmat-1)*m51_nvphas + ipos-1
2907 isubmat = nint(uparam(276+3)); iu(3)=m51_n0phas +(isubmat-1)*m51_nvphas + ipos-1
2908 isubmat = nint(uparam(276+4)); iu(4)=m51_n0phas +(isubmat-1)*m51_nvphas + ipos-1
2909 rhoi(1) = mbuf%var(i+iu(1)*nel)
2910 rhoi(2) = mbuf%var(i+iu(2)*nel)
2911 rhoi(3) = mbuf%var(i+iu(3)*nel)
2912 rhoi(4) = mbuf%var(i+iu(4)*nel)
2913 do ilay=1,4
2914 mid = mat_param(mt)%multimat%mid(ilay)
2915 rho0i(ilay) = pm(89,mid)
2916 vi(ilay) = vfrac(i,ilay) * gbuf%vol(i)
2917 ipos = 12
2918 v0i(ilay) = rhoi(ilay) * vi(ilay) / rho0i(ilay) !rho0.V0 = rho.V
2919 enddo
2920 v0g = sum(v0i)
2921 rho0g = zero
2922 do ilay=1,4
2923 rho0g = rho0g + rho0i(ilay)*v0i(ilay)
2924 end do
2925 rho0g = rho0g / v0g
2926 value(i) = gbuf%rho(i) / rho0g - one
2927 is_written_value(i) = 1
2928
2929 elseif(mlw == 37)then
2930 !multimaterial 37 (staggered scheme)
2931 imat = ixs(1,nft+1)
2932 iadbuf = ipm(7,imat)
2933 nuparam= ipm(9,imat)
2934 uparam => bufmat(iadbuf:iadbuf+nuparam)
2935 mbuf => elbuf_tab(ng)%bufly(1)%mat(1,1,1)
2936 rho0i(1) = uparam(11)
2937 rho0i(2) = uparam(12)
2938 vi(1) = mbuf%var(i+3*nel) * gbuf%vol(i) !UVAR(I,4) = VFRAC1
2939 vi(2) = mbuf%var(i+4*nel) * gbuf%vol(i) !UVAR(I,5) = VFRAC2
2940 rhoi(1) = mbuf%var(i+2*nel) !UVAR(I,3) = RHO1
2941 rhoi(2) = mbuf%var(i+1*nel) !UVAR(I,2) = RHO2
2942 v0i(1) = rhoi(1) * vi(1) / rho0i(1) !rho0.V0 = rho.V
2943 v0i(2) = rhoi(2) * vi(2) / rho0i(2) !rho0.V0 = rho.V
2944 v0g = sum(v0i)
2945 rho0g = zero
2946 do ilay=1,nlay
2947 rho0g = rho0g + rho0i(ilay)*v0i(ilay)
2948 end do
2949 rho0g = rho0g / v0g
2950 value(i) = gbuf%rho(i) / rho0g - one
2951 is_written_value(i) = 1
2952
2953 elseif(mlw == 20)then
2954 !multimaterial 20 (staggered scheme)
2955 lbuf1 => elbuf_tab(ng)%bufly(1)%lbuf(1,1,1)
2956 lbuf2 => elbuf_tab(ng)%bufly(2)%lbuf(1,1,1)
2957 mid = mat_param(mt)%multimat%mid(1)
2958 rho0i(1) = pm(89,mid)
2959 mid = mat_param(mt)%multimat%mid(2)
2960 rho0i(2) = pm(89,mid)
2961 vi(1) = lbuf1%vol(i)
2962 vi(2) = lbuf2%vol(i)
2963 rhoi(1) = lbuf1%rho(i)
2964 rhoi(2) = lbuf2%rho(i)
2965 v0i(1) = rhoi(1) * vi(1) / rho0i(1) !rho0.V0 = rho.V
2966 v0i(2) = rhoi(2) * vi(2) / rho0i(2) !rho0.V0 = rho.V
2967 v0g = sum(v0i)
2968 rho0g = zero
2969 do ilay=1,nlay
2970 rho0g = rho0g + rho0i(ilay)*v0i(ilay)
2971 end do
2972 rho0g = rho0g / v0g
2973 value(i) = gbuf%rho(i) / rho0g - one
2974 is_written_value(i) = 1
2975
2976 else
2977 !general case (monomaterial law)
2978 if(pm(89,mt) > zero)then
2979 value(i) = gbuf%rho(i) / pm(89,mt) - one
2980 is_written_value(i) = 1
2981 end if
2982 end if
2983
2984 enddo
2985!--------------------------------------------------
2986 elseif(keyword(1:8) == 'VSTRAIN/') then
2987!--------------------------------------------------
2988 detected = .false.
2989 read(keyword(9:), '(I2)', iostat=ierr) ilay
2990 if(ierr == 0 .and. ilay > 0) then
2991 if(mlw == 151 .and. ilay <= min(10,multi_fvm%nbmat))detected = .true.
2992 if(mlw == 51 .and. ilay <= 4 )detected = .true.
2993 if(mlw == 37 .and. ilay <= 2 )detected = .true.
2994 if(mlw == 20 .and. ilay <= 2 )detected = .true.
2995 end if
2996 if(detected)then
2997 do i=1,nel
2998 mt = ixs(1,i+nft)
2999
3000 if(mlw == 151)then
3001 !multimaterial 151 (collocated scheme)
3002 mid = mat_param(mt)%multimat%mid(ilay)
3003 rho0i(ilay) = pm(89,mid)
3004 vi(ilay) = multi_fvm%phase_alpha(ilay,i+nft) * gbuf%vol(i)
3005 v0i(ilay) = multi_fvm%phase_rho(ilay,i+nft) * vi(ilay) / rho0i(ilay) !rho0.V0 = rho.V
3006 value(i) = multi_fvm%phase_rho(ilay,i+nft) / rho0i(ilay) - one
3007 is_written_value(i) = 1
3008
3009 elseif(mlw == 51)then
3010 !multimaterial 51 (staggered scheme)
3011 imat = ixs(1,nft+1)
3012 iadbuf = ipm(7,imat)
3013 nuparam= ipm(9,imat)
3014 uparam => bufmat(iadbuf:iadbuf+nuparam)
3015 mbuf => elbuf_tab(ng)%bufly(1)%mat(1,1,1)
3016 mid = mat_param(mt)%multimat%mid(ilay)
3017 rho0i(ilay) = pm(89,mid)
3018 ipos = 1
3019 !bijective order !indexes
3020 isubmat = nint(uparam(276+ilay)); iu(1)=m51_n0phas +(isubmat-1)*m51_nvphas + ipos-1
3021 vfrac(i,ilay) = mbuf%var(i+iu(ilay)*nel)
3022 vi(ilay) = vfrac(i,ilay) * gbuf%vol(i)
3023 ipos = 12
3024 !bijective order !indexes
3025 isubmat = nint(uparam(276+ilay)); iu(ilay)=m51_n0phas +(isubmat-1)*m51_nvphas + ipos-1
3026 rhoi(ilay) = mbuf%var(i+iu(ilay)*nel)
3027 v0i(ilay) = rhoi(ilay) * vi(ilay) / rho0i(ilay) !rho0.V0 = rho.V
3028 value(i) = rhoi(ilay) / rho0i(ilay) - one
3029 is_written_value(i) = 1
3030
3031 elseif(mlw == 37)then
3032 !multimaterial 37 (staggered scheme)
3033 imat = ixs(1,nft+1)
3034 iadbuf = ipm(7,imat)
3035 nuparam= ipm(9,imat)
3036 uparam => bufmat(iadbuf:iadbuf+nuparam)
3037 mbuf => elbuf_tab(ng)%bufly(1)%mat(1,1,1)
3038 rho0i(ilay) = uparam(10+ilay)
3039 vi(ilay) = mbuf%var(i+(ilay+2)*nel) * gbuf%vol(i)
3040 rhoi(ilay) = mbuf%var(i+(3-ilay)*nel) !UVAR(I,3) = RHO1
3041 v0i(ilay) = rhoi(ilay) * vi(ilay) / rho0i(ilay)
3042 value(i) = rhoi(ilay) / rho0i(ilay) - one
3043 is_written_value(i) = 1
3044
3045 elseif(mlw == 20)then
3046 !multimaterial 20 (staggered scheme)
3047 lbuf => elbuf_tab(ng)%bufly(ilay)%lbuf(1,1,1)
3048 mid = mat_param(mt)%multimat%mid(ilay)
3049 rho0i(ilay) = pm(89,mid)
3050 vi(ilay) = lbuf%vol(i)
3051 rhoi(ilay) = lbuf%rho(i)
3052 v0i(ilay) = rhoi(ilay) * vi(ilay) / rho0i(ilay) !rho0.V0 = rho.V
3053 value(i) = rhoi(ilay) / rho0i(ilay) - one
3054 is_written_value(i) = 1
3055
3056 else
3057 !general case (monomaterial law)
3058 is_written_value(i) = 0
3059 end if
3060 enddo
3061
3062 end if
3063!--------------------------------------------------
3064!--------------------------------------------------
3065 ENDIF
3066C--------------------------------------------------
3067 IF(called_from_python) THEN
3068 solid_scalar(1:nel) = value(1:nel)
3069 ELSE
3070 CALL h3d_write_scalar(iok_part,is_written_solid,solid_scalar,nel,offset,nft,
3071 . VALUE,is_written_value)
3072 ENDIF
3073 ENDIF
3074 ENDIF
3075 ENDIF
3076
3077C-----------------------------------------------
3078 RETURN
3079 END
3080!||====================================================================
3081!|| ths_marea ../engine/source/output/h3d/h3d_results/h3d_solid_scalar_1.F
3082!||--- called by ------------------------------------------------------
3083!|| h3d_solid_scalar_1 ../engine/source/output/h3d/h3d_results/h3d_solid_scalar_1.F
3084!||====================================================================
3085 SUBROUTINE ths_marea(RX, RY, RZ, SX, SY, SZ, DET,NEL)
3086C-----------------------------------------------
3087C I m p l i c i t T y p e s
3088C-----------------------------------------------
3089#include "implicit_f.inc"
3090C-----------------------------------------------
3091C G l o b a l P a r a m e t e r s
3092C-----------------------------------------------
3093#include "mvsiz_p.inc"
3094C-----------------------------------------------
3095C D u m m y A r g u m e n t s
3096C-----------------------------------------------
3097 INTEGER NEL
3098 my_real, DIMENSION(MVSIZ), INTENT(IN) :: RX,RY,RZ
3099 my_real, DIMENSION(MVSIZ), INTENT(IN) :: SX,SY,SZ
3100 my_real, DIMENSION(MVSIZ), INTENT(OUT) :: DET
3101C-----------------------------------------------
3102C L o c a l V a r i a b l e s
3103C-----------------------------------------------
3104 INTEGER I
3105 my_real
3106 . E3X(NEL), E3Y(NEL), E3Z(NEL)
3107C~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
3108 DO i=1,nel
3109C---------E3------------
3110 e3x(i) = ry(i) * sz(i) - rz(i) * sy(i)
3111 e3y(i) = rz(i) * sx(i) - rx(i) * sz(i)
3112 e3z(i) = rx(i) * sy(i) - ry(i) * sx(i)
3113 det(i) = sqrt(e3x(i)*e3x(i) + e3y(i)*e3y(i) + e3z(i)*e3z(i))
3114 ENDDO
3115c-----------
3116 RETURN
3117 END
3118!||====================================================================
3119!|| ths_vol ../engine/source/output/h3d/h3d_results/h3d_solid_scalar_1.F
3120!||--- called by ------------------------------------------------------
3121!|| h3d_solid_scalar_1 ../engine/source/output/h3d/h3d_results/h3d_solid_scalar_1.F
3122!||====================================================================
3123 SUBROUTINE ths_vol(RX, RY, RZ, SX, SY, SZ, TX, TY, TZ,DET,NEL)
3124C-----------------------------------------------
3125C I m p l i c i t T y p e s
3126C-----------------------------------------------
3127#include "implicit_f.inc"
3128C-----------------------------------------------
3129C G l o b a l P a r a m e t e r s
3130C-----------------------------------------------
3131#include "mvsiz_p.inc"
3132C-----------------------------------------------
3133C D u m m y A r g u m e n t s
3134C-----------------------------------------------
3135 INTEGER NEL
3136 my_real, DIMENSION(MVSIZ), INTENT(IN) :: RX,RY,RZ
3137 my_real, DIMENSION(MVSIZ), INTENT(IN) :: SX,SY,SZ
3138 my_real, DIMENSION(MVSIZ), INTENT(IN) :: TX,TY,TZ
3139 my_real, DIMENSION(MVSIZ), INTENT(OUT) :: DET
3140C-----------------------------------------------
3141C L o c a l V a r i a b l e s
3142C-----------------------------------------------
3143 INTEGER I
3144 my_real JAC1, JAC2, JAC3, JAC4, JAC5, JAC6, JAC7, JAC8, JAC9
3145C~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
3146 DO i=1,nel
3147 jac1 = rx(i)
3148 jac2 = ry(i)
3149 jac3 = rz(i)
3150 jac4 = sx(i)
3151 jac5 = sy(i)
3152 jac6 = sz(i)
3153 jac7 = tx(i)
3154 jac8 = ty(i)
3155 jac9 = tz(i)
3156 det(i) = jac1 * (jac5 * jac9 - jac8 * jac6) +
3157 . jac2 * (jac6 * jac7 - jac4 * jac9) +
3158 . jac3 * (jac4 * jac8 - jac7 * jac5)
3159 ENDDO
3160c-----------
3161 RETURN
3162 END
h3d_solid_scalar_1
subroutine h3d_solid_scalar_1(called_from_python, elbuf_tab, solid_scalar, iparg, ixs, pm, bufmat, ehour, ipm, x, v, w, ale_connect, id_elem, ity_elem, iparts, layer_input, ir_input, is_input, it_input, iuvar_input, h3d_part, is_written_solid, info1, keyword, fani_cell, multi_fvm, ng, idmds, imdsvar, id, mat_param, mode)
Definition h3d_solid_scalar_1.F:61
ths_marea
subroutine ths_marea(rx, ry, rz, sx, sy, sz, det, nel)
Definition h3d_solid_scalar_1.F:3086
ths_vol
subroutine ths_vol(rx, ry, rz, sx, sy, sz, tx, ty, tz, det, nel)
Definition h3d_solid_scalar_1.F:3124
h3d_write_scalar
subroutine h3d_write_scalar(iok_part, is_written, scalar, nel, offset, nft, value, is_written_value)
Definition h3d_write_scalar.F:35
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:223
aleanim_mod
Definition aleanim_mod.F:40
aleanim_mod::fani_cell
type(fani_cell_) fani_cell
Definition aleanim_mod.F:55
alefvm_mod
Definition alefvm_mod.F:88
alefvm_mod::alefvm_param
type(alefvm_param_), target alefvm_param
Definition alefvm_mod.F:121
h3d_mod
Definition h3d_mod.F:308
initbuf_mod
Definition initbuf.F:160
initbuf_mod::initbuf
subroutine initbuf(iparg, ng, mtn, llt, nft, iad, ity, npt, jale, ismstr, jeul, jtur, jthe, jlag, jmult, jhbe, jivf, mid, jpor, jcvt, jclose, jpla, irep, iint, igtyp, israt, isrot, icsen, isorth, isorthg, ifailure, jsms)
Definition initbuf.F:261
names_and_titles_mod
Definition names_and_titles_mod.F:997
names_and_titles_mod::ncharline100
integer, parameter ncharline100
Definition names_and_titles_mod.F:1002
schlieren_mod
Definition schlieren_mod.F:46
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
ale_connectivity_mod::t_ale_connectivity
Definition ale_connectivity_mod.F:254
aleanim_mod::fani_cell_
Definition aleanim_mod.F:44