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