OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
dfunc6.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!|| dfuncs ../engine/source/output/anim/generate/dfunc6.F
25!||--- called by ------------------------------------------------------
26!|| genani ../engine/source/output/anim/generate/genani.F
27!||--- calls -----------------------------------------------------
28!|| initbuf ../engine/share/resol/initbuf.F
29!|| output_schlieren ../engine/source/output/anim/generate/output_schlieren.F
30!|| schlieren_buffer_gathering ../engine/source/output/anim/generate/schlieren_buffer_gathering.F
31!|| spmd_r4get_partn ../engine/source/mpi/anim/spmd_r4get_partn.F
32!|| srotorth ../engine/source/elements/solid/srotorth.F
33!|| write_r_c ../common_source/tools/input_output/write_routtines.c
34!||--- uses -----------------------------------------------------
35!|| ale_connectivity_mod ../common_source/modules/ale/ale_connectivity_mod.F
36!|| aleanim_mod ../engine/share/modules/aleanim_mod.F
37!|| alefvm_mod ../common_source/modules/ale/alefvm_mod.f
38!|| elbufdef_mod ../common_source/modules/mat_elem/elbufdef_mod.F90
39!|| i22tri_mod ../common_source/modules/interfaces/cut-cell-search_mod.F
40!|| initbuf_mod ../engine/share/resol/initbuf.F
41!|| mat_elem_mod ../common_source/modules/mat_elem/mat_elem_mod.F90
42!|| matparam_def_mod ../common_source/modules/mat_elem/matparam_def_mod.F90
43!|| multi_fvm_mod ../common_source/modules/ale/multi_fvm_mod.F90
44!|| multimat_param_mod ../common_source/modules/multimat_param_mod.F90
45!|| my_alloc_mod ../common_source/tools/memory/my_alloc.F90
46!|| schlieren_mod ../engine/share/modules/schlieren_mod.F
47!||====================================================================
48 SUBROUTINE dfuncs(ELBUF_TAB ,FUNC ,IFUNC ,IPARG ,GEO ,
49 2 IXS ,MASS ,PM ,EL2FA ,NBF ,
50 3 IPM ,IGEO ,NBPART ,EHOUR ,ANIM ,
51 4 IADG ,SPBUF ,IPART ,IPARTSP ,ISPH3D ,
52 5 X ,V ,W ,ALE_CONNECTIVITY,
53 6 NERCVOIS ,NESDVOIS ,LERCVOIS ,LESDVOIS ,BUFMAT ,
54 7 FANI_CELL ,MULTI_FVM ,MAT_PARAM ,ITHERM )
55C-----------------------------------------------
56C M o d u l e s
57C-----------------------------------------------
58 USE initbuf_mod
59 USE mat_elem_mod
60 USE schlieren_mod
61 USE i22tri_mod , only:int22_fcell_anim
62 USE alefvm_mod
63 USE multi_fvm_mod
64 USE ale_connectivity_mod
65 USE aleanim_mod , ONLY : fani_cell_
66 USE elbufdef_mod
67 USE multimat_param_mod , ONLY : m51_n0phas, m51_nvphas
68 USE matparam_def_mod , ONLY : matparam_struct_
69 USE my_alloc_mod
70C-----------------------------------------------
71C I m p l i c i t T y p e s
72C-----------------------------------------------
73#include "implicit_f.inc"
74C-----------------------------------------------
75C C o m m o n B l o c k s
76C-----------------------------------------------
77#include "vect01_c.inc"
78#include "mvsiz_p.inc"
79#include "com01_c.inc"
80#include "com04_c.inc"
81#include "sphcom.inc"
82#include "scr14_c.inc"
83#include "scr17_c.inc"
84#include "scr25_c.inc"
85#include "param_c.inc"
86#include "task_c.inc"
87#include "spmd_c.inc"
88#include "inter22.inc"
89#include "tabsiz_c.inc"
90C-----------------------------------------------
91C D u m m y A r g u m e n t s
92C-----------------------------------------------
93 my_real func(*), mass(*) ,pm(npropm,nummat), geo(npropg,numgeo),
94 . ehour(*),anim(*), spbuf(*),x(3,numnod),v(3,numnod), w(3,numnod),bufmat(*)
95 TYPE(fani_cell_), INTENT(IN) :: FANI_CELL
96 INTEGER IPARG(NPARG,*),EL2FA(*),IXS(NIXS,NUMELS),IFUNC,NBF,ISPH3D,
97 . NBPART,IADG(NSPMD,*),IPM(NPROPMI,NUMMAT),
98 . IPART(LIPART1,*),IPARTSP(*),BUF,IGEO(NPROPGI,NUMGEO)
99 INTEGER, INTENT(IN) :: ITHERM
100 TYPE (ELBUF_STRUCT_), DIMENSION(NGROUP), TARGET :: ELBUF_TAB
101 TYPE(MULTI_FVM_STRUCT), INTENT(IN) :: MULTI_FVM
102 TYPE(t_ale_connectivity), INTENT(IN) :: ALE_CONNECTIVITY
103 TYPE (MATPARAM_STRUCT_) ,DIMENSION(NUMMAT) ,INTENT(IN) :: MAT_PARAM
104C-----------------------------------------------
105C L o c a l V a r i a b l e s
106C-----------------------------------------------
107 INTEGER I,J,L,N, NG, NEL, MLW,
108 . nn, k1, k2,jturb,mt, imid, ialel,irupt,
109 . nn1,nn2,nn3,nn4,
110 . offset,k,ii, ius, nuvar,tshell,tsh_ort,
111 . isolnod, iprt, liad, nptr, npts, nptt, nlay, ipt,
112 . il,is,ir,it, nptg, icsig,
113 . pid, npg_plane,nfail,numlay,ijk,iir,ioff,ialefvm_flg,
114 . nercvois(*),nesdvois(*),lercvois(*),lesdvois(*),
115 . ideb, ipos, itrimat,ivisc,jj(6),ifrac,imat,iadbuf,
116 . nuparam,idx,isubmat,iu(4),nfrac,is_ale,is_euler,
117 . imat_tillotson,ntillotson,fac,nvareos,ieos
118 my_real evar(mvsiz), user(mvsiz),
119 . off, p, vonm2, vonm, s1, s2, s3, VALUE,values(mvsiz),gama(6),
120 . t11,t21,t31,t12,t22,t32,t13,t23,t33,
121 . phi,teta,psi,dammax,s11,s22,s33,s4,s5,s6,
122 . sig1(mvsiz),sig2(mvsiz),sig3(mvsiz),sig4(mvsiz),sig5(mvsiz),
123 . sig6(mvsiz),ff0,gg0,hh0,ll0,mm0,nn0,crit,vel(0:4),vfrac(mvsiz,21),tmp(3,8)
124 REAL R4
125 REAL,DIMENSION(:),ALLOCATABLE::WAL
126 TYPE(G_BUFEL_) ,POINTER :: GBUF
127 TYPE(L_BUFEL_) ,POINTER :: LBUF,LBUF1,LBUF2
128 TYPE(BUF_MAT_) ,POINTER :: MBUF
129 TYPE(BUF_EOS_) ,POINTER :: EBUF
130
131 my_real, DIMENSION(:),POINTER :: uvarf, damf,dfmax,tdele
132 my_real, DIMENSION(:) ,POINTER :: uparam
133 TARGET :: bufmat
134 my_real :: my_value,my_one
135 INTEGER MID,ILAY
136 my_real :: vi(21) !< submaterial volumes at reference densities (max submat : 21)
137 my_real :: v0i(21) !< submaterial volumes at reference densities (max submat : 21)
138 my_real :: v0g !< global volume at reference density (mixture)
139 my_real :: rho0i(21) !< submaterial initial mass densities (max submat : 21)
140 my_real :: rhoi(21) !< submaterial mass densities (max submat : 21)
141 my_real :: rho0g !< global initial mass density (mixture)
142 LOGICAL detected
143C=======================================================================
144 CALL my_alloc(wal,nbf)
145 nn1 = 1
146 nn2 = 1
147 nn3 = nn2 + numels
148 nn4 = nn3 + isph3d*(numsph+maxpjet)
149 gama = zero
150 ioff = 0
151C-----------------------------------------------
152
153 !-------------------------------------------------------!
154 ! INITIALIZATION IF SCHLIEREN DEFINED !
155 !-------------------------------------------------------!
156 IF(ifunc==4892)THEN
157 CALL schlieren_buffer_gathering(nercvois ,nesdvois ,lercvois ,lesdvois, iparg, elbuf_tab, multi_fvm,itherm)
158 endif!(IFUNC==4892)
159
160
161C-----------------------------------------------
162 DO ng=1,ngroup
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 IF (mlw /= 13) THEN
171 DO offset = 0,nel-1,nvsiz
172 nft = iparg(3,ng) + offset
173 isolnod = iparg(28,ng)
174 ivisc = iparg(61,ng)
175 lft=1
176 llt=min(nvsiz,nel-offset)
177 is_ale=iparg(7,ng)
178 is_euler=iparg(11,ng)
179!
180 DO i=1,6
181 jj(i) = nel*(i-1)
182 ENDDO
183!
184C-----------------------------------------------
185 IF (ity == 1) THEN
186c SOLID ELEMENTS
187 IF (jcvt==1.AND.isorth/=0) jcvt=2
188C-----------------------------------------------
189 gbuf => elbuf_tab(ng)%GBUF
190 mbuf => elbuf_tab(ng)%BUFLY(1)%MAT(1,1,1)
191 lbuf => elbuf_tab(ng)%BUFLY(1)%LBUF(1,1,1)
192 nlay = elbuf_tab(ng)%NLAY
193 nptr = elbuf_tab(ng)%NPTR
194 npts = elbuf_tab(ng)%NPTS
195 nptt = elbuf_tab(ng)%NPTT
196 nptg = nptt*npts*nptr*nlay
197 tshell = 0
198 tsh_ort = 0
199 IF (igtyp==20 .OR. igtyp==21 .OR. igtyp==22) tshell = 1
200 IF (igtyp==21 .OR. igtyp==22) tsh_ort = 1
201 pid=ixs(10,1 + nft)
202c
203 DO i=lft,llt
204 evar(i) = zero
205 sig1(i) = zero
206 sig2(i) = zero
207 sig3(i) = zero
208 sig4(i) = zero
209 sig5(i) = zero
210 sig6(i) = zero
211 ENDDO
212C-----------
213 IF (mlw /= 0 .and. mlw /= 13 .and. igtyp /= 0) THEN
214 jturb=iparg(12,ng)*(iparg(7,ng)+iparg(11,ng))
215C-----------
216 IF(ifunc == 1 .AND. (mlw /= 12 .AND. mlw /=14 .AND. mlw /= 25))THEN
217 DO i=lft,llt
218 IF (gbuf%G_PLA > 0) THEN
219 evar(i) = gbuf%PLA(i)
220 ENDIF
221 ENDDO
222c-----------
223 ELSEIF(ifunc == 2)THEN
224 DO i=lft,llt
225 evar(i) = gbuf%RHO(i)
226 ENDDO
227c-----------
228 ELSEIF(ifunc == 3)THEN
229 DO i=lft,llt
230 n = i + nft
231 ialel=iparg(7,ng)+iparg(11,ng)
232 IF (ialel == 0) THEN
233 mt=ixs(1,n)
234 evar(i) = gbuf%EINT(i)/max(em30,pm(1,mt))
235 ELSE
236 evar(i) = gbuf%EINT(i)/max(em30,gbuf%RHO(i))
237 ENDIF
238 IF( nfilsol /= 0 .AND. gbuf%G_FILL /= 0 )
239 . evar(i) = evar(i) * gbuf%FILL(i)
240 ENDDO
241c-----------
242 ELSEIF (ifunc == 4) THEN ! element temperature
243 IF (jthe /= 0) THEN
244 evar(1:nel) = elbuf_tab(ng)%GBUF%TEMP(1:nel)
245 ELSE
246 evar(1:nel) = zero
247 DO il=1,nlay
248 IF (elbuf_tab(ng)%BUFLY(il)%L_TEMP > 0) THEN
249 DO it=1,elbuf_tab(ng)%BUFLY(il)%NPTT
250 DO is=1,npts
251 DO ir=1,nptr
252 lbuf => elbuf_tab(ng)%BUFLY(il)%LBUF(ir,is,it)
253 evar(1:nel) = evar(1:nel) + lbuf%TEMP(1:nel)/nptg
254 ENDDO
255 ENDDO
256 ENDDO
257 ENDIF
258 ENDDO
259 ENDIF
260c-----------
261 ELSEIF(ifunc == 6 .OR. ifunc == 7)THEN
262 DO i=lft,llt
263 n = i + nft
264 s11 = gbuf%SIG(jj(1) + i)
265 s22 = gbuf%SIG(jj(2) + i)
266 s33 = gbuf%SIG(jj(3) + i)
267 s4 = gbuf%SIG(jj(4) + i)
268 s5 = gbuf%SIG(jj(5) + i)
269 s6 = gbuf%SIG(jj(6) + i)
270 IF (ivisc > 0) THEN
271 s11 = s11 + lbuf%VISC(jj(1) + i)
272 s22 = s22 + lbuf%VISC(jj(2) + i)
273 s33 = s33 + lbuf%VISC(jj(3) + i)
274 s4 = s4 + lbuf%VISC(jj(4) + i)
275 s5 = s5 + lbuf%VISC(jj(5) + i)
276 s6 = s6 + lbuf%VISC(jj(6) + i)
277 ENDIF
278 p = - (s11 + s22 + s33 ) * third
279 VALUE = p
280 IF (ifunc == 7) THEN
281 s1= s11 + p
282 s2= s22 + p
283 s3= s33 + p
284 vonm2 = three*(s4*s4 + s5*s5 + s6*s6 +
285 . half*(s1*s1 + s2*s2 + s3*s3))
286 vonm = sqrt(vonm2)
287 VALUE = vonm
288 IF( nfilsol /= 0 .AND. gbuf%G_FILL /= 0 )
289 . VALUE = VALUE * gbuf%FILL(i)
290 ENDIF
291 evar(i) = VALUE
292 ENDDO
293C
294c-----------
295 ELSEIF(ifunc == 8 .and. jturb /= 0)THEN
296C ENERGIE TURBULENTE
297 DO i=lft,llt
298 evar(i) = gbuf%RK(i)
299 ENDDO
300c-----------
301 ELSEIF(ifunc == 9)THEN
302C VISCOSITE TURBULENTE
303 DO i=lft,llt
304 n = i + nft
305 IF((mlw == 6 .OR. mlw == 17).AND.jturb/=0)THEN
306 mt=ixs(1,n)
307 evar(i) = pm(81,mt) * gbuf%RK(i)**2
308 . / max(em15,gbuf%RE(i))
309 ELSEIF(mlw == 46 .OR. mlw == 47)THEN
310 evar(i) = mbuf%VAR(i)
311 ELSE
312
313 ENDIF
314 ENDDO
315c-----------
316 ELSEIF(ifunc == 10)THEN
317C VORTICITY-X
318 DO i=lft,llt
319 evar(i) = fani_cell%VORT_X(i+nft)
320 ENDDO
321C
322c-----------
323 ELSEIF((ifunc == 11.OR.ifunc == 12.OR.ifunc == 13) .AND.mlw == 24)THEN
324C dam 1 2 3
325 DO i=lft,llt
326 evar(i) = lbuf%DAM(jj(ifunc-10) + i)
327 ENDDO
328C
329c-----------
330 ELSEIF(ifunc>=14.AND.ifunc<=19)THEN
331 DO i=lft,llt
332 evar(i) = gbuf%SIG(jj(ifunc - 13) + i)
333 IF( nfilsol /= 0 .AND. gbuf%G_FILL /= 0 )
334 . evar(i) = evar(i) * gbuf%FILL(i)
335 ENDDO
336 IF(ivisc > 0) THEN
337 DO i=lft,llt
338 evar(i) = evar(i) + lbuf%VISC(jj(ifunc - 13)+i)
339 ENDDO
340 ENDIF
341c-----------
342 ELSEIF(ifunc>=20 .AND. ifunc<=24) THEN
343 IF(mlw >= 28)THEN
344c USER VARIABLES per Gauss point from 1 to 5
345 ius = ifunc - 20
346 DO i=lft,llt
347 user(i) = zero
348 ENDDO
349 IF (isolnod == 8 .AND. mlw == 59) THEN ! exception for connect rupture
350 !output = global damage variables of /fail/connect
351 mt = ixs(1,nft+1)
352 nfail = elbuf_tab(ng)%BUFLY(1)%NFAIL
353 IF (nfail > 0) THEN
354 irupt = mat_param(mt)%FAIL(1)%IRUPT ! one failure model only ?!!
355 IF (irupt == 20) THEN
356 nptg = 4
357 DO ir=1,nfail
358 DO ipt = 1,nptg
359 uvarf =>
360 . elbuf_tab(ng)%BUFLY(1)%FAIL(ipt,1,1)%FLOC(ir)%VAR
361 DO i=lft,llt
362 user(i) = max(user(i),uvarf(ius*nel + i))
363 ENDDO
364 ENDDO
365 ENDDO
366 ENDIF
367 ENDIF
368 ELSE
369 DO il=1,nlay
370 DO is=1,npts
371 DO it=1,nptt
372 DO ir=1,nptr
373 mbuf => elbuf_tab(ng)%BUFLY(il)%MAT(ir,is,it)
374 DO i=lft,llt
375 n = i + nft
376 mt=ixs(1,n)
377 nuvar = ipm(8,mt)
378 IF (nuvar > ius) user(i) = user(i)
379 . + mbuf%VAR(i+ius*nel)/nptg
380 ENDDO
381 ENDDO
382 ENDDO
383 ENDDO
384 ENDDO
385 ENDIF
386 DO i=lft,llt
387 n = i + nft
388 mt=ixs(1,n)
389 nuvar = ipm(8,mt)
390 IF (isolnod == 8 .AND. mlw == 59) THEN
391 evar(i) = user(i)
392 ELSEIF (nuvar > ius) THEN
393 evar(i) = user(i)
394 ELSE
395 evar(i) = zero
396 ENDIF
397 ENDDO
398 endif!IF(MLW >= 28)THEN
399c-----------
400 ELSEIF(ifunc == 25)THEN
401 DO i=lft,llt
402 n = i + nft
403 evar(i) = ehour(n)
404 ENDDO
405c-----------
406 ELSEIF(ifunc == 26) THEN
407 IF (gbuf%G_EPSD > 0) THEN
408 DO i=lft,llt
409 evar(i) = gbuf%EPSD(i)
410 ENDDO
411 ELSE
412 DO i=lft,llt
413 evar(i) = zero
414 ENDDO
415 ENDIF
416c-----------
417 ELSEIF(ifunc == 28 .AND. int22>0) THEN
418 DO i=lft,llt
419 evar(i) = int22_fcell_anim(i+nft)
420 ENDDO
421c-----------
422 ELSEIF(ifunc>=27.AND.ifunc<=81.AND.mlw>=28.AND.mlw/=51) THEN !anim user 1-60 no longer used with law51 => automatic phase outputs using usual keywords
423C USER VARIABLES from 6 to 60
424C IUS = (n-1)'th user variable in UVAR
425 ius = ifunc - 22
426 DO i=lft,llt
427 user(i) = zero
428 ENDDO
429 IF (isolnod == 8 .AND. mlw == 59) THEN
430c output = global damage variables of /fail/connect
431 mt = ixs(1,nft+1)
432 nfail = elbuf_tab(ng)%BUFLY(1)%NFAIL
433 IF (nfail > 0) THEN
434 irupt = mat_param(mt)%FAIL(1)%IRUPT
435 IF (irupt == 20) THEN
436 nptg = 4
437 DO ir=1,nfail
438 DO ipt = 1,nptg
439 uvarf =>
440 . elbuf_tab(ng)%BUFLY(1)%FAIL(ipt,1,1)%FLOC(ir)%VAR
441 DO i=lft,llt
442 user(i) = max(user(i),uvarf(ius*nel + i))
443 ENDDO
444 ENDDO
445 ENDDO
446 ENDIF
447 ENDIF
448 ELSE
449 DO il=1,nlay
450 DO is=1,npts
451 DO it=1,nptt
452 DO ir=1,nptr
453 mbuf => elbuf_tab(ng)%BUFLY(il)%MAT(ir,is,it)
454 DO i=lft,llt
455 n = i + nft
456 mt=ixs(1,n)
457 nuvar = ipm(8,mt)
458 IF (nuvar > ius) user(i) = user(i)
459 . + mbuf%VAR(i+ius*nel)/nptg
460 ENDDO
461 ENDDO
462 ENDDO
463 ENDDO
464 ENDDO
465 ENDIF
466 DO i=lft,llt
467 n = i + nft
468 mt=ixs(1,n)
469 nuvar = ipm(8,mt)
470 IF (isolnod == 8 .AND. mlw == 59) THEN
471 evar(i) = user(i)
472 ELSEIF (nuvar > ius) THEN
473 evar(i)= user(i)
474 ELSE
475 evar(i) = zero
476 ENDIF
477 ENDDO
478c-------------
479 ELSEIF(ifunc>=283.AND.ifunc<=286) THEN
480C USER VARIABLES from 6 to 60
481C IUS = (n-1)'th user variable in UVAR
482
483 user(lft:llt) = zero
484
485 IF(mlw==37)THEN
486 ius=3+(ifunc-283) !law37 user4 and user5 for vfrac
487 ELSEIF(mlw==51)THEN
488 imat = ixs(1,nft+1)
489 iadbuf = ipm(7,imat)
490 nuparam= ipm(9,imat)
491 uparam => bufmat(iadbuf:iadbuf+nuparam)
492 isubmat = (ifunc-282)
493 isubmat = uparam(276+isubmat) !bijective order
494 ius=m51_n0phas+(isubmat-1)*m51_nvphas
495! ELSEIF(MLW==20)THEN
496! IUS=1+(IFUNC-10248)
497 ENDIF
498 ifrac=ifunc-283+1
499
500c--------------
501 IF (mlw==51 .OR. (mlw==37.AND.ifrac<=2))THEN
502 DO il=1,nlay
503 DO is=1,npts
504 DO it=1,nptt
505 DO ir=1,nptr
506 mbuf => elbuf_tab(ng)%BUFLY(il)%MAT(ir,is,it)
507 DO i=lft,llt
508 user(i) = user(i) + mbuf%VAR(i+ius*nel)/nptg
509 ENDDO
510 ENDDO
511 ENDDO
512 ENDDO
513 ENDDO
514 ELSEIF (mlw == 151) THEN
515 IF(ifrac<=nlay)THEN
516 lbuf => elbuf_tab(ng)%BUFLY(ifunc-282)%LBUF(1,1,1)
517 DO i=1,nel
518 user(i) = lbuf%VOL(i) / gbuf%VOL(i)
519 ENDDO
520 ELSE
521 user(lft:llt) = zero
522 ENDIF
523! ELSEIF(MLW==20)THEN
524! USER(I) = ELBUF_TAB(NG)%BUFLY(IUS)%LBUF(1,1,1)%FRAC(I)
525 ELSE
526 user(lft:llt) = zero ! in case of law37 and law51 in same input file. Then submat 3,4 does not exist for law37 and are set to 0.
527 ENDIF
528c-------------
529 evar(lft:llt) = user(lft:llt)
530c-------------
531c-----------
532 ELSEIF(ifunc>=82.AND.ifunc<=281.AND.mlw == 25) THEN
533C WPLA par couche pour loi 25
534 DO i=lft,llt
535 evar(i) = zero
536 ENDDO
537C
538 ius = ifunc - 81
539 IF (isolnod == 16.OR.isolnod == 20.OR.
540 . (isolnod == 8.AND.jhbe == 14).OR.
541 . ((isolnod == 6.OR.isolnod == 8).AND.jhbe == 15))THEN
542 IF (ius <= nptg) THEN
543 DO il=1,nlay
544 IF (elbuf_tab(ng)%BUFLY(il)%L_PLA > 0) THEN
545 DO is=1,npts
546 DO it=1,nptt
547 DO ir=1,nptr
548 lbuf=>elbuf_tab(ng)%BUFLY(il)%LBUF(ir,is,it)
549 DO i=lft,llt
550 evar(i) = evar(i) + lbuf%PLA(i)
551 ENDDO
552 ENDDO
553 ENDDO
554 ENDDO
555 ENDIF
556 ENDDO
557 ENDIF
558 ENDIF
559c-----------
560 ELSEIF (ifunc == 282 .AND. mlw == 25) THEN
561C--- FAILED LAYERS par elem pour loi 25
562 DO i=lft,llt
563 evar(i) = zero
564 ENDDO
565 IF( isolnod == 16.OR.isolnod == 20.OR.
566 . (isolnod == 8.AND.jhbe == 14).OR.
567 . ((isolnod == 6 .OR. isolnod == 8).AND.jhbe == 15))THEN
568c
569 npg_plane = nptr * npts * nptt
570 DO i=lft,llt
571 DO il=1,nlay
572 VALUE = zero
573 DO j=1,nptr
574 DO k=1,npts
575 DO l=1,nptt
576 lbuf=>elbuf_tab(ng)%BUFLY(il)%LBUF(j,k,l)
577 IF (lbuf%OFF(i) == 0) VALUE = VALUE + one
578 IF(int(VALUE)>=npg_plane) evar(i)=evar(i)+one
579 ENDDO
580 ENDDO
581 ENDDO
582 ENDDO
583 ENDDO
584 ENDIF
585c-----------
586 ELSEIF (ifunc >= 287 .AND. ifunc < 887)THEN
587C EULER ANGLE : rotation of ORTHOTROPIC SYSTEM wrt GLOBAL SYSTEM
588 numlay = ((ifunc - 287)/3)+1
589 IF(numlay <= nlay)THEN
590 lbuf => elbuf_tab(ng)%BUFLY(numlay)%LBUF(1,1,1)
591 DO i=lft,llt
592 n = i + nft
593 IF(isorth ==1) THEN
594C pour JHBE=14, valeurs moyennes est dans rep. corota.
595 IF(igtyp == 22) THEN
596 gama(1)= lbuf%GAMA(jj(1)+i)
597 gama(2)= lbuf%GAMA(jj(2)+i)
598 gama(3)= zero
599 gama(4)= zero
600 gama(5)= zero
601 gama(6)= zero
602 ELSEIF(igtyp == 21) THEN
603 gama(1)= gbuf%GAMA(jj(1)+i)
604 gama(2)= gbuf%GAMA(jj(2)+i)
605 gama(3)= zero
606 gama(4)= zero
607 gama(5)= zero
608 gama(6)= zero
609 ELSE
610 gama(1) = gbuf%GAMA(jj(1)+i)
611 gama(2) = gbuf%GAMA(jj(2)+i)
612 gama(3) = gbuf%GAMA(jj(3)+i)
613 gama(4) = gbuf%GAMA(jj(4)+i)
614 gama(5) = gbuf%GAMA(jj(5)+i)
615 gama(6) = gbuf%GAMA(jj(6)+i)
616 ENDIF
617 CALL srotorth(x,ixs(1,n),
618 . gama,jhbe,igtyp,iparg(17,ng) )
619C--------
620 t11=gama(1)
621 t21=gama(2)
622 t31=gama(3)
623 t12=gama(4)
624 t22=gama(5)
625 t32=gama(6)
626 t13=t21*t32-t31*t22
627 t23=t31*t12-t11*t32
628 t33=t11*t22-t21*t12
629 IF (abs(t31) - one < em20)THEN
630c IF( ABS(COS(-ASIN(T31))) > EM20)THEN
631 teta = -asin(t31)
632 my_one = one
633 my_value = max(abs(cos(teta)),em20) * sign(my_one,cos(teta))
634 IF(t32==zero.AND.t33==zero) THEN
635 psi = 0
636 ELSE
637 psi = atan2( t32/my_value,t33/my_value )
638 ENDIF
639 IF(t21==zero.AND.t11==zero) THEN
640 phi = 0
641 ELSE
642 phi = atan2(t21/my_value,t11/my_value)
643 ENDIF
644 ELSE
645 phi = zero
646 IF(t31 == -one)THEN
647 teta = pi / two
648 psi = atan2(t12,t13)
649 ELSE
650 teta = - pi / two
651 psi = atan2(-t12,-t13)
652 ENDIF
653 ENDIF
654 IF (mod(ifunc - 287,3) == 0)
655 . evar(i) = psi*hundred80/pi
656 IF (mod(ifunc - 287,3) == 1)
657 . evar(i) = teta*hundred80/pi
658 IF (mod(ifunc - 287,3) == 2)
659 . evar(i) = phi*hundred80/pi
660 ELSE
661 evar(i) = zero
662 ENDIF
663 ENDDO
664 ELSE
665 DO i=lft,llt
666 evar(i) = zero
667 ENDDO
668 ENDIF
669c-----------
670 ELSEIF (ifunc == 887 )THEN
671 !BURN FRACTION JWL EOS
672 IF(gbuf%G_BFRAC > 0) THEN
673 IF (mlw==151)THEN
674 DO i=lft,llt
675 evar(i)=-ep30
676 DO ifrac=1,nlay
677 evar(i) = max(evar(i),multi_fvm%BFRAC(ifrac,i+nft))
678 ENDDO
679 ENDDO
680 ELSE
681 evar(lft:llt) = gbuf%BFRAC(lft:llt)
682 ENDIF
683 ELSEIF (mlw == 41) THEN ! LEE TARVER
684 DO i = lft, llt
685 evar(i) = mbuf%VAR(7 * nel + i)
686 ENDDO
687 ELSE
688 evar(lft:llt) = zero
689 ENDIF
690c--------------output vdam1, vdam2,vdam3, for failure prop connect
691 ELSEIF(ifunc>= 888 .AND.ifunc<= 3888 .AND. mlw>=28) THEN
692C FAILURE VARIABLES
693 DO i=lft,llt
694 evar(i) = zero
695 ENDDO
696c--------------
697 IF (isolnod == 8 .AND. mlw == 83) THEN
698c output = damage variables of /fail/snconnect
699 mt = ixs(1,nft+1)
700 nfail = elbuf_tab(ng)%BUFLY(1)%NFAIL
701 IF (nfail > 0) THEN
702 irupt = mat_param(mt)%FAIL(1)%IRUPT
703 IF (irupt == 26) THEN
704 IF(ifunc <= 890 ) THEN
705 ius = ifunc - 888
706C IUS = (n-1)'th user variable IN DAM
707 nptg = 4
708 DO ir=1,nfail
709 DO ipt = 1,nptg
710 damf =>
711 . elbuf_tab(ng)%BUFLY(1)%FAIL(ipt,1,1)%FLOC(ir)%DAM
712 DO i=lft,llt
713 evar(i) = max(evar(i) ,damf(ius*nel + i))
714 ENDDO
715 ENDDO
716 ENDDO
717 ELSEIF(ifunc <= 1890 )THEN !vdam1_ijk
718 ijk = ifunc - 890
719 iir = ijk/100
720 is = (mod(ijk,100)-mod(ijk,10))/10
721 it = mod(ijk,10)
722 DO ir=1,nfail
723 damf =>
724 . elbuf_tab(ng)%BUFLY(1)%FAIL(iir,1,1)%FLOC(ir)%DAM
725 DO i=lft,llt
726 evar(i) = damf(i)
727 ENDDO
728 ENDDO
729 ELSEIF(ifunc <= 2890 )THEN !vdam2_ijk
730 ijk = ifunc - 1890
731 iir = ijk/100
732 is = (mod(ijk,100)-mod(ijk,10))/10
733 it = mod(ijk,10)
734 DO ir=1,nfail
735 damf =>
736 . elbuf_tab(ng)%BUFLY(1)%FAIL(iir,1,1)%FLOC(ir)%DAM
737 DO i=lft,llt
738 evar(i) = damf(nel+i)
739 ENDDO
740 ENDDO
741 ELSE !vdam3_ijk
742 ijk = ifunc - 2890
743 iir = ijk/100
744 is = (mod(ijk,100)-mod(ijk,10))/10
745 it = mod(ijk,10)
746 DO ir=1,nfail
747 damf =>
748 . elbuf_tab(ng)%BUFLY(1)%FAIL(iir,1,1)%FLOC(ir)%DAM
749 DO i=lft,llt
750 evar(i) = damf(2*nel+i)
751 ENDDO
752 ENDDO
753 ENDIF !IFUNC <= 890
754 ENDIF !IRUPT
755 ENDIF
756 ENDIF ! ISOLNOD == 8 .AND. MLW == 83
757c-----------
758 ELSEIF (ifunc >= 3891.AND.ifunc <= 4889 )THEN
759 DO i=lft,llt
760 evar(i) = zero
761 ENDDO
762 ijk = ifunc - 3890
763 IF (tshell>0) THEN
764 iir = ijk/100
765 il = (mod(ijk,100)-mod(ijk,10))/10
766 is = mod(ijk,10)
767 it =1
768 ELSE
769 iir = ijk/100
770 is = (mod(ijk,100)-mod(ijk,10))/10
771 it = mod(ijk,10)
772 il =1
773 END IF
774 ius = nlay*iir*is*it
775 dammax = zero
776 IF (iir <= nptr.AND.is <= npts.AND.it <= nptt) THEN
777 nfail = elbuf_tab(ng)%BUFLY(il)%NFAIL
778 DO ir=1,nfail
779 dfmax=>
780 . elbuf_tab(ng)%BUFLY(il)%FAIL(iir,is,it)%FLOC(ir)%DAMMX
781 DO i=lft,llt
782 evar(i) = max(evar(i),dfmax(i))
783 ENDDO
784 ENDDO
785 ENDIF
786 ELSEIF (ifunc >= 5911.AND.ifunc <= 9920 .AND. tshell>0)THEN
787 DO i=lft,llt
788 evar(i) = zero
789 ENDDO
790 ijk = ifunc - 3890
791 IF ((isolnod == 6 .OR. isolnod == 8).AND.jhbe == 15) THEN
792 il = mod(abs(ijk)/10,201)
793 iir = 1
794 is = 1
795 it = 1
796 ELSEIF (isolnod == 16.OR.(isolnod == 8 .AND.jhbe == 14)) THEN
797c-----------
798 icsig = iparg(17,ng)
799 iir=abs(ijk)/2010
800 il=mod(abs(ijk)/10,201)
801 is=mod(abs(ijk),10)
802 it = 1
803 END IF
804 dammax = zero
805 IF (iir <= nptr.AND.is <= npts.AND.it <= nptt) THEN
806 nfail = elbuf_tab(ng)%BUFLY(il)%NFAIL
807 DO ir=1,nfail
808 dfmax=>
809 . elbuf_tab(ng)%BUFLY(il)%FAIL(iir,is,it)%FLOC(ir)%DAMMX
810 DO i=lft,llt
811 evar(i) = max(evar(i),dfmax(i))
812 ENDDO
813 ENDDO
814 ENDIF
815 ELSEIF(ifunc == 3890) THEN
816 DO i=lft,llt
817 evar(i) = zero
818 ENDDO
819
820 DO il=1,nlay
821 nfail = elbuf_tab(ng)%BUFLY(il)%NFAIL
822 DO is=1,npts
823 DO it=1,nptt
824 DO iir=1,nptr
825 DO ir=1,nfail
826 dfmax=>
827 . elbuf_tab(ng)%BUFLY(il)%FAIL(iir,is,it)%FLOC(ir)%DAMMX
828 DO i=lft,llt
829 evar(i) = max(evar(i),dfmax(i))
830 ENDDO
831 ENDDO
832 ENDDO
833 ENDDO
834 ENDDO
835 ENDDO
836 ELSEIF(ifunc == 4890) THEN
837 DO i=lft,llt
838 evar(i) = zero
839 ENDDO
840 DO il=1,nlay
841 nfail = elbuf_tab(ng)%BUFLY(il)%NFAIL
842 DO is=1,npts
843 DO it=1,nptt
844 DO iir=1,nptr
845 DO ir=1,nfail
846 tdele=>
847 . elbuf_tab(ng)%BUFLY(il)%FAIL(iir,is,it)%FLOC(ir)%TDEL
848 DO i=lft,llt
849 evar(i) = max(evar(i),tdele(i))
850 ENDDO
851 ENDDO
852 ENDDO
853 ENDDO
854 ENDDO
855 ENDDO
856c-----------
857 ELSEIF(ifunc == 4891) THEN
858 IF (mlw == 151) THEN
859 DO i = 1, nel
860 evar(i) = multi_fvm%SOUND_SPEED(i + nft)
861 ENDDO
862 ELSE
863 l = elbuf_tab(ng)%BUFLY(1)%L_SSP
864 IF(elbuf_tab(ng)%BUFLY(1)%L_SSP /= 0)THEN
865 lbuf => elbuf_tab(ng)%BUFLY(1)%LBUF(1,1,1)
866 DO i=1,nel
867 evar(i) = lbuf%SSP(i)
868 ENDDO
869 ENDIF
870 ENDIF
871 ELSEIF(ifunc == 4892) THEN
872 ialel=iparg(7,ng)+iparg(11,ng)
873 IF(ialel == 0)THEN
874 evar(lft:llt) = zero
875 ELSE
876 CALL output_schlieren(
877 1 evar ,ixs ,x ,
878 2 iparg ,wa_l ,elbuf_tab ,ale_connectivity ,gbuf%VOL,
879 3 ng ,nixs ,ity)
880 ENDIF
881c-----------
882 ELSEIF(ifunc == 4893) THEN
883 DO i=lft,llt
884 evar(i) = ispmd
885 ENDDO
886c-----------
887 ELSEIF(ifunc == 4894) THEN
888 DO i=lft,llt
889 evar(i) = gbuf%FILL(i)
890 ENDDO
891c-----------
892 ELSEIF (ifunc == 4895) THEN ! /ANIM/ELEM/SIGEQ
893 ! equivalent stress - other then VON MISES
894 IF (gbuf%G_SEQ > 0) THEN ! non VON MISES
895! DO I=LFT,LLT
896! EVAR_TMP = ZERO
897! NPTG = NLAY*NPTR*NPTS*NPTT
898! DO IL=1,NLAY
899! DO IT=1,NPTT
900! DO IR=1,NPTR
901! DO IS=1,NPTS
902! LBUF => ELBUF_TAB(NG)%BUFLY(IL)%LBUF(IR,IS,IT)
903! IF (ELBUF_TAB(NG)%BUFLY(IL)%L_SEQ > 0) THEN
904! EVAR_TMP = EVAR_TMP + LBUF%SEQ(I)/NPTG
905! ELSE
906! S11 = LBUF%SIG(JJ(1) + I)
907! S22 = LBUF%SIG(JJ(2) + I)
908! S33 = LBUF%SIG(JJ(3) + I)
909! S4 = LBUF%SIG(JJ(4) + I)
910! S5 = LBUF%SIG(JJ(5) + I)
911! S6 = LBUF%SIG(JJ(6) + I)
912! IF (IVISC > 0) THEN
913! S11 = S11 + LBUF%VISC(JJ(1) + I)
914! S22 = S22 + LBUF%VISC(JJ(2) + I)
915! S33 = S33 + LBUF%VISC(JJ(3) + I)
916! S4 = S4 + LBUF%VISC(JJ(4) + I)
917! S5 = S5 + LBUF%VISC(JJ(5) + I)
918! S6 = S6 + LBUF%VISC(JJ(6) + I)
919! ENDIF
920! P = - (S11 + S22 + S33) * THIRD
921! S1 = S11 + P
922! S2 = S22 + P
923! S3 = S33 + P
924! VONM2 = THREE*(S4*S4 + S5*S5 + S6*S6 +
925! . HALF*(S1*S1 + S2*S2 + S3*S3))
926! VONM = SQRT(VONM2)
927! EVAR_TMP = EVAR_TMP + VONM/NPTG
928! ENDIF ! IF (ELBUF_TAB(NG)%BUFLY(IL)%L_SEQ > 0)
929! ENDDO ! DO IS=1,NPTS
930! ENDDO ! DO IR=1,NPTR
931! ENDDO ! DO IT=1,NPTT
932! ENDDO ! DO IL=1,NLAY
933! EVAR(I) = EVAR_TMP
934! ENDDO ! DO I=LFT,LLT
935!!!!!!
936 imat = ixs(1,nft+1)
937 iadbuf = ipm(7,imat)
938 nuparam= ipm(9,imat)
939 uparam => bufmat(iadbuf:iadbuf+nuparam)
940 lbuf => elbuf_tab(ng)%BUFLY(1)%LBUF(1,1,1)
941!---
942 IF (mlw == 72) THEN
943!
944 DO i=lft,llt
945 evar(i) = gbuf%SEQ(i)
946 ENDDO ! DO I=LFT,LLT
947!
948 ELSEIF (mlw == 74) THEN
949! (ILAW = 74) -- Thermal Hill Orthotropic 3D Material
950 ff0 = uparam(7)
951 gg0 = uparam(8)
952 hh0 = uparam(9)
953 ll0 = uparam(10)
954 mm0 = uparam(11)
955 nn0 = uparam(12)
956 DO i=lft,llt
957 s11 = gbuf%SIG(jj(1) + i)
958 s22 = gbuf%SIG(jj(2) + i)
959 s33 = gbuf%SIG(jj(3) + i)
960 s4 = gbuf%SIG(jj(4) + i)
961 s5 = gbuf%SIG(jj(5) + i)
962 s6 = gbuf%SIG(jj(6) + i)
963 IF (ivisc > 0) THEN
964 s11 = s11 + lbuf%VISC(jj(1) + i)
965 s22 = s22 + lbuf%VISC(jj(2) + i)
966 s33 = s33 + lbuf%VISC(jj(3) + i)
967 s4 = s4 + lbuf%VISC(jj(4) + i)
968 s5 = s5 + lbuf%VISC(jj(5) + i)
969 s6 = s6 + lbuf%VISC(jj(6) + i)
970 ENDIF
971 p = - (s11 + s22 + s33) * third
972 s1 = s11 + p
973 s2 = s22 + p
974 s3 = s33 + p
975!
976 crit = ff0*(s2 - s3)**2
977 . + gg0*(s3 - s1)**2
978 . + hh0*(s1 - s2)**2
979 . + two*ll0*s5**2
980 . + two*mm0*s6**2
981 . + two*nn0*s4**2
982!
983 evar(i) = sqrt(crit)
984 ENDDO ! DO I=LFT,LLT
985 ELSEIF (mlw == 93) THEN
986!
987 DO i=lft,llt
988 evar(i) = gbuf%SEQ(i)
989 ENDDO ! DO I=LFT,LLT
990 ELSEIF (mlw == 104) THEN
991 DO i = lft, llt
992 evar(i) = zero
993 ENDDO
994 DO il=1,nlay
995 DO is=1,npts
996 DO it=1,nptt
997 DO ir=1,nptr
998 lbuf => elbuf_tab(ng)%BUFLY(il)%LBUF(ir,is,it)
999 DO i=lft,llt
1000 evar(i) = evar(i) + lbuf%SEQ(i)/nptg
1001 ENDDO
1002 ENDDO
1003 ENDDO
1004 ENDDO
1005 ENDDO
1006 ELSEIF (mlw == 115) THEN
1007!
1008 DO i=lft,llt
1009 evar(i) = gbuf%SEQ(i)
1010 ENDDO ! DO I=LFT,LLT
1011 ENDIF
1012!---
1013 ELSE ! VON MISES
1014 lbuf => elbuf_tab(ng)%BUFLY(1)%LBUF(1,1,1)
1015 DO i=lft,llt
1016 s11 = gbuf%SIG(jj(1) + i)
1017 s22 = gbuf%SIG(jj(2) + i)
1018 s33 = gbuf%SIG(jj(3) + i)
1019 s4 = gbuf%SIG(jj(4) + i)
1020 s5 = gbuf%SIG(jj(5) + i)
1021 s6 = gbuf%SIG(jj(6) + i)
1022 IF (ivisc > 0) THEN
1023 s11 = s11 + lbuf%VISC(jj(1) + i)
1024 s22 = s22 + lbuf%VISC(jj(2) + i)
1025 s33 = s33 + lbuf%VISC(jj(3) + i)
1026 s4 = s4 + lbuf%VISC(jj(4) + i)
1027 s5 = s5 + lbuf%VISC(jj(5) + i)
1028 s6 = s6 + lbuf%VISC(jj(6) + i)
1029 ENDIF
1030 p = - (s11 + s22 + s33) * third
1031 s1 = s11 + p
1032 s2 = s22 + p
1033 s3 = s33 + p
1034 vonm2 = three*(s4*s4 + s5*s5 + s6*s6 +
1035 . half*(s1*s1 + s2*s2 + s3*s3))
1036 vonm = sqrt(vonm2)
1037 evar(i) = vonm
1038 ENDDO ! DO i=lft,llt
1039 ENDIF ! IF (GBUF%G_SEQ > 0)
1040c-----------
1041 ELSEIF (ifunc == 4896) THEN ! /ANIM/ELEM/QVIS
1042 IF (gbuf%G_QVIS > 0) THEN
1043 DO i=lft,llt
1044 evar(i) = gbuf%QVIS(i)
1045 ENDDO
1046 ELSE
1047 DO i=lft,llt
1048 evar(i) = zero
1049 ENDDO
1050 ENDIF
1051 ELSEIF (ifunc >= 4931 .AND. ifunc <= 4934) THEN ! /ANIM/ELEM/QVIS - law51 phases
1052 IF (mlw == 51) THEN
1053 itrimat = ifunc - 4930
1054 !bijection for iform=12
1055 imat = ixs(1,nft+1)
1056 iadbuf = ipm(7,imat)
1057 nuparam= ipm(9,imat)
1058 uparam => bufmat(iadbuf:iadbuf+nuparam)
1059 isubmat = itrimat
1060 isubmat = uparam(276+isubmat) !bijective order
1061 ius=m51_n0phas+(isubmat-1)*m51_nvphas
1062 !
1063 llt = iparg(2,ng)
1064 ipos = 10
1065 k = llt * ((ius )+ipos-1)
1066 DO i=lft,llt
1067 evar(i) = mbuf%VAR(k+i)
1068 ENDDO
1069 ELSE
1070 DO i=lft,llt
1071 evar(i) = zero
1072 ENDDO
1073 ENDIF
1074c-----------
1075 ELSEIF (ifunc == 4921) THEN ! /ANIM/ELEM/VOLU
1076 IF (gbuf%G_VOL > 0) THEN
1077 ialel=iparg(7,ng)+iparg(11,ng)
1078 IF(ialel==0)THEN
1079 DO i=lft,llt
1080 mt = ixs(1,nft+1)
1081 evar(i) = pm(1,mt)*gbuf%VOL(i)
1082 IF(gbuf%RHO(i)>zero)evar(i)=evar(i)/gbuf%RHO(i)
1083 ENDDO
1084 ELSE
1085 DO i=lft,llt
1086 evar(i) = gbuf%VOL(i)
1087 ENDDO
1088 ENDIF
1089 ELSE
1090 DO i=lft,llt
1091 evar(i) = zero
1092 ENDDO
1093 ENDIF
1094c-----------
1095 ELSEIF(ifunc>=4897 .AND. ifunc<=4929 .AND. ifunc/=4921)THEN
1096 IF(mlw == 51)THEN
1097 !law51 phases
1098 ipos = 0
1099 IF( ifunc>=4897 .AND. ifunc<=4900)THEN
1100 ideb = 4896
1101 ipos = 12 !dens
1102 ELSEIF(ifunc>=4901 .AND. ifunc<=4904)THEN
1103 ideb = 4900
1104 ipos = 08 !ener (eint/V)
1105 ELSEIF(ifunc>=4905 .AND. ifunc<=4908)THEN
1106 ideb = 4904
1107 ipos = 16 !temp
1108 ELSEIF(ifunc>=4909 .AND. ifunc<=4912)THEN
1109 ideb = 4908
1110 ipos = 18 !pres
1111 ELSEIF(ifunc>=4913 .AND. ifunc<=4916)THEN
1112 ideb = 4912
1113 ipos = 15 !epsp
1114 ELSEIF(ifunc>=4917 .AND. ifunc<=4920)THEN
1115 ideb = 4916
1116 ipos = 14 !ssp
1117 ELSEIF(ifunc>=4922 .AND. ifunc<=4925)THEN
1118 ideb = 4921
1119 ipos = 11 !volume
1120 ELSEIF(ifunc>=4926 .AND. ifunc<=4929)THEN
1121 ideb = 4925
1122 ipos = 0 !mass
1123 ENDIF
1124 imat = ixs(1,nft+1)
1125 iadbuf = ipm(7,imat)
1126 nuparam = ipm(9,imat)
1127 uparam => bufmat(iadbuf:iadbuf+nuparam)
1128 itrimat = ifunc - ideb
1129 !bijection iform=12
1130 isubmat = itrimat
1131 isubmat = uparam(276+isubmat) !bijective order
1132 ius = m51_n0phas+(isubmat-1)*m51_nvphas
1133 !
1134 llt = iparg(2,ng)
1135 !all output expect mass en specific energy by mass : output value * vol
1136 IF(ipos /=0 .AND. ipos /= 08 )THEN
1137 k = llt * ((ius )+ipos-1)
1138 DO i=lft,llt
1139 evar(i) = mbuf%VAR(k+i)
1140 ENDDO
1141 !specific energy by mass
1142 ELSEIF(ipos == 08)THEN
1143 k1 = llt * ((ius )+08-1)
1144 k2 = llt * ((ius )+12-1)
1145 evar(lft:llt) = zero
1146 DO i=lft,llt
1147 IF(mbuf%VAR(k2+i) /= zero) evar(i) = mbuf%VAR(k1+i) / mbuf%VAR(k2+i) ! (eint/v) / rho
1148 ENDDO
1149 ELSEIF(ipos==0)THEN
1150 ! mass
1151 itrimat = ifunc - ideb
1152 llt = iparg(2,ng)
1153 k1 = llt * ((ius )+12-1)
1154 k2 = llt * ((ius )+11-1)
1155 DO i=lft,llt
1156 evar(i) = mbuf%VAR(k1+i) * mbuf%VAR(k2+i) !dens*vol
1157 ENDDO
1158 ELSE
1159 !should not happen
1160 evar(lft:llt) = zero
1161 ENDIF
1162 ELSE
1163 DO i=lft,llt
1164 evar(i) = zero
1165 ENDDO
1166 endif!IF(MLW == 51)
1167c-----------
1168 ELSEIF (ifunc == 4930) THEN ! /ANIM/ELEM/TDET
1169 IF (gbuf%G_TB > 0) THEN
1170 DO i=lft,llt
1171 evar(i) = -gbuf%TB(i)
1172 ENDDO
1173 ELSE
1174 DO i=lft,llt
1175 evar(i) = zero
1176 ENDDO
1177 ENDIF
1178c-----------
1179 ELSEIF (ifunc == 4935 .OR. ifunc == 4936) THEN ! /ANIM/ELEM/DENS for law37 submaterials
1180 IF (mlw /= 37) THEN
1181 evar(lft:llt) = zero
1182 ELSE
1183 user(lft:llt) = zero
1184 ius=3-ifunc+4935 !law37 user4 and user5
1185 DO il=1,nlay
1186 DO is=1,npts
1187 DO it=1,nptt
1188 DO ir=1,nptr
1189 mbuf => elbuf_tab(ng)%BUFLY(il)%MAT(ir,is,it)
1190 DO i=lft,llt
1191 user(i) = user(i) + mbuf%VAR(i+(ius-1)*nel)/nptg
1192 ENDDO
1193 ENDDO
1194 ENDDO
1195 ENDDO
1196 ENDDO
1197 evar(lft:llt) = user(lft:llt)
1198 ENDIF
1199c-----------
1200 ELSEIF (ifunc == 4937) THEN ! /ANIM/ELEM/DT
1201 IF(gbuf%G_DT>0)THEN
1202 DO i=lft,llt
1203 evar(i) = gbuf%DT(i)
1204 ENDDO
1205 ENDIF
1206c-----------
1207 !/ANIM/ELEM/MOM || MOMX || MOMY || MOMZ || MOMXY || MOMYZ || MOMXZ || |MOM|
1208 ELSEIF (ifunc>=4938 .AND. ifunc<=4944)THEN
1209 mt = ixs(1,nft+1)
1210 ialefvm_flg = ipm(251,mt)
1211 IF(ialefvm_flg >= 2)THEN
1212 IF (isolnod == 8)THEN
1213 IF(ifunc>=4938 .AND. ifunc<=4940)THEN
1214 DO i=lft,llt
1215 evar(i) = gbuf%MOM(jj(ifunc-4937) + i)
1216 ENDDO
1217 ELSEIF(ifunc==4941)THEN
1218 DO i=lft,llt
1219! IAD0 = (I-1)*3
1220 evar(i) = sqrt( gbuf%MOM(jj(1)+i)*gbuf%MOM(jj(1)+i)+
1221 + gbuf%MOM(jj(2)+i)*gbuf%MOM(jj(2)+i) )
1222 ENDDO
1223 ELSEIF(ifunc==4942)THEN
1224 DO i=lft,llt
1225! IAD0 = (I-1)*3
1226 evar(i) = sqrt( gbuf%MOM(jj(2)+i)*gbuf%MOM(jj(2)+i)+
1227 + gbuf%MOM(jj(3)+i)*gbuf%MOM(jj(3)+i) )
1228 ENDDO
1229 ELSEIF(ifunc==4943)THEN
1230 DO i=lft,llt
1231! IAD0 = (I-1)*3
1232 evar(i) = sqrt( gbuf%MOM(jj(1)+i)*gbuf%MOM(jj(1)+i)+
1233 + gbuf%MOM(jj(3)+i)*gbuf%MOM(jj(3)+i) )
1234 ENDDO
1235 ELSEIF(ifunc==4944)THEN
1236 DO i=lft,llt
1237! IAD0 = (I-1)*3
1238 evar(i) = sqrt( gbuf%MOM(jj(1)+i)*gbuf%MOM(jj(1)+i)+
1239 + gbuf%MOM(jj(2)+i)*gbuf%MOM(jj(2)+i)+
1240 + gbuf%MOM(jj(3)+i)*gbuf%MOM(jj(3)+i) )
1241 ENDDO
1242 ENDIF
1243 ENDIF
1244 ELSE
1245 evar(lft:llt)=zero
1246 endif!IF(IALEFVM_FLG >= 2)
1247c-----------
1248 !/ANIM/ELEM/VEL || VELX || VELY || VELZ || VELXY || VELYZ || VELXZ || |VEL|
1249 ELSEIF (ifunc>=4945 .AND. ifunc<=4951)THEN
1250 mt = ixs(1,nft+1)
1251 ialefvm_flg = ipm(251,mt)
1252 IF(ialefvm_flg >= 2)THEN
1253 IF (isolnod == 8)THEN
1254 IF(ifunc>=4945 .AND. ifunc<=4947)THEN
1255 DO i=lft,llt
1256 evar(i) = gbuf%MOM(jj(ifunc-4944)+i) / gbuf%RHO(i)
1257 ENDDO
1258 ELSEIF(ifunc==4948)THEN
1259 DO i=lft,llt
1260! IAD0 = (I-1)*3
1261 evar(i) = sqrt( gbuf%MOM(jj(1)+i)*gbuf%MOM(jj(1)+i)+
1262 + gbuf%MOM(jj(2)+i)*gbuf%MOM(jj(2)+i) ) / gbuf%RHO(i)
1263 ENDDO
1264 ELSEIF(ifunc==4949)THEN
1265 DO i=lft,llt
1266! IAD0 = (I-1)*3
1267 evar(i) = sqrt( gbuf%MOM(jj(2)+i)*gbuf%MOM(jj(2)+i)+
1268 + gbuf%MOM(jj(3)+i)*gbuf%MOM(jj(3)+i) ) / gbuf%RHO(i)
1269 ENDDO
1270 ELSEIF(ifunc==4950)THEN
1271 DO i=lft,llt
1272! iad0 = (i-1)*3
1273 evar(i) = sqrt( gbuf%MOM(jj(1)+i)*gbuf%MOM(jj(1)+i)+
1274 + gbuf%MOM(jj(3)+i)*gbuf%MOM(jj(3)+i) ) / gbuf%RHO(i)
1275 ENDDO
1276 ELSEIF(ifunc==4951)THEN
1277 DO i=lft,llt
1278! iad0 = (i-1)*3
1279 evar(i) = sqrt( gbuf%MOM(jj(1)+i)*gbuf%MOM(jj(1)+i)+
1280 + gbuf%MOM(jj(2)+i)*gbuf%MOM(jj(2)+i)+
1281 + gbuf%MOM(jj(3)+i)*gbuf%MOM(jj(3)+i) ) / gbuf%RHO(i)
1282 ENDDO
1283 ENDIF
1284 ENDIF
1285 ELSE
1286 evar(lft:llt)=zero
1287 endif!IF(IALEFVM_FLG >= 2)
1288c-----------
1289 !/ANIM/ELEM/FINT || FINTX || FINTY || FINXY || FINYZ || FINXZ
1290 ELSEIF (ifunc>=4952 .AND. ifunc<=4958)THEN
1291 mt = ixs(1,nft+1)
1292 ialefvm_flg = ipm(251,mt)
1293 IF(ialefvm_flg >= 2)THEN
1294 IF (isolnod == 8)THEN
1295 IF(ifunc>=4952 .AND. ifunc<=4954)THEN
1296 DO i=lft,llt
1297 ii = i+nft
1298 evar(i) = alefvm_buffer%FINT_CELL(ifunc-4951,ii)
1299 ENDDO
1300 ELSEIF(ifunc==4955)THEN
1301 DO i=lft,llt
1302 ii = i+nft
1303 evar(i) = sqrt( alefvm_buffer%FINT_CELL(1,ii)* alefvm_buffer%FINT_CELL(1,ii)+
1304 + alefvm_buffer%FINT_CELL(2,ii)* alefvm_buffer%FINT_CELL(2,ii) )
1305 ENDDO
1306 ELSEIF(ifunc==4956)THEN
1307 DO i=lft,llt
1308 ii = i+nft
1309 evar(i) = sqrt( alefvm_buffer%FINT_CELL(2,ii)* alefvm_buffer%FINT_CELL(2,ii)+
1310 + alefvm_buffer%FINT_CELL(3,ii)* alefvm_buffer%FINT_CELL(3,ii) )
1311 ENDDO
1312 ELSEIF(ifunc==4957)THEN
1313 DO i=lft,llt
1314 ii = i+nft
1315 evar(i) = sqrt( alefvm_buffer%FINT_CELL(1,ii)* alefvm_buffer%FINT_CELL(1,ii)+
1316 + alefvm_buffer%FINT_CELL(3,ii)* alefvm_buffer%FINT_CELL(3,ii) )
1317 ENDDO
1318 ELSEIF(ifunc==4958)THEN
1319 DO i=lft,llt
1320 ii = i+nft
1321 evar(i) = sqrt( alefvm_buffer%FINT_CELL(1,ii)* alefvm_buffer%FINT_CELL(1,ii)+
1322 + alefvm_buffer%FINT_CELL(2,ii)* alefvm_buffer%FINT_CELL(2,ii)+
1323 + alefvm_buffer%FINT_CELL(3,ii)* alefvm_buffer%FINT_CELL(3,ii) )
1324 ENDDO
1325 ENDIF
1326 ENDIF
1327 ELSE
1328 evar(lft:llt)=zero
1329 endif!IF(IALEFVM_FLG >= 2)
1330c-----------
1331 ELSEIF (ifunc == 4959) THEN ! /ANIM/ELEM/AMS
1332 IF(gbuf%G_ISMS>0)THEN
1333 DO i=lft,llt
1334 evar(i) = gbuf%ISMS(i)
1335 ENDDO
1336 ENDIF
1337c-----------
1338 ELSEIF(ifunc == 4960)THEN
1339 !VORTICITY-Y
1340 DO i=lft,llt
1341 evar(i) = fani_cell%VORT_Y(i+nft)
1342 ENDDO
1343c-----------
1344 ELSEIF(ifunc == 4961)THEN
1345 !VORTICITY-Z
1346 DO i=lft,llt
1347 evar(i) = fani_cell%VORT_Z(i+nft)
1348 ENDDO
1349c-----------
1350 ELSEIF(ifunc == 4962)THEN
1351 !VORTICITE-NORM
1352 DO i=lft,llt
1353 IF(mlw == 6 .OR. mlw == 17)THEN
1354 evar(i) = lbuf%VK(i)
1355 ELSEIF(mlw == 46 .OR. mlw == 47)THEN
1356 evar(i) = mbuf%VAR(nel+i) ! UVAR(I,2)
1357 ENDIF
1358 ENDDO
1359c-----------
1360 ELSEIF(ifunc == 4963)THEN
1361 !Internal Energy (J) = rho.e.V /ANIM/ELEM/ENER is sipmply "e" (J/kg)
1362 DO i=lft,llt
1363 evar(i) = gbuf%EINT(i)*gbuf%VOL(i)
1364 ENDDO
1365c-----------
1366 ELSEIF(ifunc == 4964 .AND. (mlw == 12 .OR. mlw ==14 .OR. mlw == 25))THEN
1367C
1368 DO i=lft,llt
1369 evar(i) = zero
1370 ENDDO
1371 IF (isolnod == 16.OR.isolnod == 20.OR.
1372 . (isolnod == 8.AND.jhbe == 14).OR.
1373 . ((isolnod == 6.OR.isolnod == 8).AND.jhbe == 15))THEN
1374 DO il=1,nlay
1375 IF (elbuf_tab(ng)%BUFLY(il)%L_PLA > 0) THEN
1376 DO is=1,npts
1377 DO it=1,nptt
1378 DO ir=1,nptr
1379 lbuf=>elbuf_tab(ng)%BUFLY(il)%LBUF(ir,is,it)
1380 DO i=lft,llt
1381 evar(i) = evar(i) + lbuf%PLA(i)/nptg
1382 ENDDO
1383 ENDDO
1384 ENDDO
1385 ENDDO
1386 ENDIF
1387 ENDDO
1388 ELSE
1389 DO i=lft,llt
1390 IF (gbuf%G_PLA > 0) evar(i) = gbuf%PLA(i)
1391 ENDDO
1392 ENDIF ! Isolid ...
1393c-----------OFF
1394 ELSEIF(ifunc == 4965)THEN
1395 DO i=lft,llt
1396 IF (gbuf%G_OFF > 0) THEN
1397 IF(gbuf%OFF(i) > one) THEN
1398 evar(i) = gbuf%OFF(i) - one
1399 ELSEIF((gbuf%OFF(i) >= zero .AND. gbuf%OFF(i) <= one)) THEN
1400 evar(i) = gbuf%OFF(i)
1401 ELSE
1402 evar(i) = -one
1403 ENDIF
1404 ENDIF
1405 ENDDO
1406c-----------Mach Number
1407 ELSEIF(ifunc == 4966) THEN
1408 IF (mlw == 151) THEN
1409 DO i = 1, nel
1410 vel(1) = multi_fvm%VEL(1, i + nft)
1411 vel(2) = multi_fvm%VEL(2, i + nft)
1412 vel(3) = multi_fvm%VEL(3, i + nft)
1413 vel(0) = sqrt(vel(1)*vel(1)+vel(2)*vel(2)+vel(3)*vel(3))
1414 evar(i) = vel(0)/multi_fvm%SOUND_SPEED(i + nft)
1415 ENDDO
1416 ELSEIF(alefvm_param%ISOLVER>1)THEN
1417 l = elbuf_tab(ng)%BUFLY(1)%L_SSP
1418 IF(elbuf_tab(ng)%BUFLY(1)%L_SSP /= 0)THEN
1419 lbuf => elbuf_tab(ng)%BUFLY(1)%LBUF(1,1,1)
1420 DO i=1,nel
1421 vel(1) = gbuf%MOM(jj(1) + i) / gbuf%RHO(i)
1422 vel(2) = gbuf%MOM(jj(2) + i) / gbuf%RHO(i)
1423 vel(3) = gbuf%MOM(jj(3) + i) / gbuf%RHO(i)
1424 vel(0) = sqrt(vel(1)*vel(1)+vel(2)*vel(2)+vel(3)*vel(3))
1425 evar(i) = vel(0)/lbuf%SSP(i)
1426 ENDDO
1427 ENDIF
1428 ELSE
1429 IF(elbuf_tab(ng)%BUFLY(1)%L_SSP /= 0)THEN
1430 lbuf => elbuf_tab(ng)%BUFLY(1)%LBUF(1,1,1)
1431 IF(is_ale /= 0)THEN
1432 !ale
1433 DO i=1,nel
1434 tmp(1,1:8)=v(1,ixs(2:9,i+nft))-w(1,ixs(2:9,i+nft))
1435 tmp(2,1:8)=v(2,ixs(2:9,i+nft))-w(2,ixs(2:9,i+nft))
1436 tmp(3,1:8)=v(3,ixs(2:9,i+nft))-w(3,ixs(2:9,i+nft))
1437 vel(1) = sum(tmp(1,1:8))*one_over_8
1438 vel(2) = sum(tmp(2,1:8))*one_over_8
1439 vel(3) = sum(tmp(3,1:8))*one_over_8
1440 evar(i) = sqrt(vel(1)*vel(1)+vel(2)*vel(2)+vel(3)*vel(3))/lbuf%SSP(i)
1441 ENDDO
1442 ELSE
1443 !euler and lagrange
1444 DO i=1,nel
1445 tmp(1,1:8)=v(1,ixs(2:9,i+nft))
1446 tmp(2,1:8)=v(2,ixs(2:9,i+nft))
1447 tmp(3,1:8)=v(3,ixs(2:9,i+nft))
1448 vel(1) = sum(tmp(1,1:8))*one_over_8
1449 vel(2) = sum(tmp(2,1:8))*one_over_8
1450 vel(3) = sum(tmp(3,1:8))*one_over_8
1451 evar(i) = sqrt(vel(1)*vel(1)+vel(2)*vel(2)+vel(3)*vel(3))/lbuf%SSP(i)
1452 ENDDO
1453 ENDIF
1454 ENDIF
1455 ENDIF
1456c------------------------------------ Color Function
1457 ELSEIF(ifunc == 4967)THEN
1458 gbuf => elbuf_tab(ng)%GBUF
1459 IF (mlw == 151) THEN
1460 nfrac=nlay
1461 DO imat=1,nlay
1462 lbuf => elbuf_tab(ng)%BUFLY(imat)%LBUF(1,1,1)
1463 DO i=1,nel
1464 vfrac(i,imat) = lbuf%VOL(i) / gbuf%VOL(i)
1465 ENDDO
1466 ENDDO
1467 ELSEIF(mlw == 20)THEN
1468 nfrac=2
1469 DO i=1,nel
1470 vfrac(i,1) = elbuf_tab(ng)%BUFLY(1)%LBUF(1,1,1)%VOL(i) / gbuf%VOL(i)
1471 vfrac(i,2) = elbuf_tab(ng)%BUFLY(2)%LBUF(1,1,1)%VOL(i) / gbuf%VOL(i)
1472 ENDDO
1473 ELSEIF(mlw == 37)THEN
1474 mbuf => elbuf_tab(ng)%BUFLY(1)%MAT(1,1,1)
1475 nfrac=2
1476 DO i=1,nel
1477 vfrac(i,1) = mbuf%VAR(i+3*nel)
1478 vfrac(i,2) = mbuf%VAR(i+4*nel)
1479 ENDDO
1480 ELSEIF(mlw == 51)THEN
1481 !get UPARAM
1482 imat = ixs(1,nft+1)
1483 iadbuf = ipm(7,imat)
1484 nuparam= ipm(9,imat)
1485 uparam => bufmat(iadbuf:iadbuf+nuparam)
1486 !bijective order !indexes
1487 isubmat = uparam(276+1); iu(1)=m51_n0phas+(isubmat-1)*m51_nvphas
1488 isubmat = uparam(276+2); iu(2)=m51_n0phas+(isubmat-1)*m51_nvphas
1489 isubmat = uparam(276+3); iu(3)=m51_n0phas+(isubmat-1)*m51_nvphas
1490 isubmat = uparam(276+4); iu(4)=m51_n0phas+(isubmat-1)*m51_nvphas
1491 mbuf => elbuf_tab(ng)%BUFLY(1)%MAT(1,1,1)
1492 nfrac=4
1493 DO i=1,nel
1494 vfrac(i,1) = mbuf%VAR(i+iu(1)*nel)
1495 vfrac(i,2) = mbuf%VAR(i+iu(2)*nel)
1496 vfrac(i,3) = mbuf%VAR(i+iu(3)*nel)
1497 vfrac(i,4) = mbuf%VAR(i+iu(4)*nel)
1498 ENDDO
1499 ELSE
1500 nfrac = 0
1501 vfrac(1:nel,1:21)=zero
1502 ENDIF
1503 IF(nfrac>0)THEN
1504 DO i=1,nel
1505 values(i)=zero
1506 DO imat=1,nfrac
1507 values(i) = values(i) + vfrac(i,imat)*imat
1508 ENDDO
1509 evar(i)=values(i)
1510 ENDDO
1511 ELSE
1512 evar(1:nel)=zero
1513 ENDIF
1514c------------------------------------ Damage
1515 ELSEIF ((ifunc == 4968).AND.gbuf%G_DMG>0) THEN ! /ANIM/ELEM/DAMG
1516 DO i = lft, llt
1517 evar(i) = zero
1518 ENDDO
1519 DO il=1,nlay
1520 DO is=1,npts
1521 DO it=1,nptt
1522 DO ir=1,nptr
1523 lbuf => elbuf_tab(ng)%BUFLY(il)%LBUF(ir,is,it)
1524 DO i=lft,llt
1525 evar(i) = evar(i) + lbuf%DMG(i)/nptg
1526 ENDDO
1527 ENDDO
1528 ENDDO
1529 ENDDO
1530 ENDDO
1531c------------------------------------ Non-local plastic strain
1532 ELSEIF ((ifunc == 4969).AND.gbuf%G_PLANL>0) THEN ! /ANIM/ELEM/NL_EPSP
1533 DO i = lft, llt
1534 evar(i) = zero
1535 ENDDO
1536 ! Only 1 layer is supported by non-local for now
1537 DO is=1,npts
1538 DO it=1,nptt
1539 DO ir=1,nptr
1540 lbuf => elbuf_tab(ng)%BUFLY(1)%LBUF(ir,is,it)
1541 DO i=lft,llt
1542 evar(i) = evar(i) + lbuf%PLANL(i)/nptg
1543 ENDDO
1544 ENDDO
1545 ENDDO
1546 ENDDO
1547c------------------------------------ Non-local plastic strain
1548 ELSEIF ((ifunc == 4970).AND.gbuf%G_EPSDNL>0) THEN ! /ANIM/ELEM/NL_EPSD
1549 DO i = lft, llt
1550 evar(i) = zero
1551 ENDDO
1552 ! Only 1 layer is supported by non-local for now
1553 DO is=1,npts
1554 DO it=1,nptt
1555 DO ir=1,nptr
1556 lbuf => elbuf_tab(ng)%BUFLY(1)%LBUF(ir,is,it)
1557 DO i=lft,llt
1558 evar(i) = evar(i) + lbuf%EPSDNL(i)/nptg
1559 ENDDO
1560 ENDDO
1561 ENDDO
1562 ENDDO
1563c------------------------------------ Tsai-Wu criterion
1564 ! -- Mean value
1565 ELSEIF(ifunc == 4971 .AND. gbuf%G_TSAIWU > 0)THEN
1566C
1567 DO i=lft,llt
1568 evar(i) = zero
1569 ENDDO
1570 DO il=1,nlay
1571 IF (elbuf_tab(ng)%BUFLY(il)%L_TSAIWU > 0) THEN
1572 DO is=1,npts
1573 DO it=1,nptt
1574 DO ir=1,nptr
1575 lbuf=>elbuf_tab(ng)%BUFLY(il)%LBUF(ir,is,it)
1576 DO i=lft,llt
1577 evar(i) = evar(i) + lbuf%TSAIWU(i)/nptg
1578 ENDDO
1579 ENDDO
1580 ENDDO
1581 ENDDO
1582 ENDIF
1583 ENDDO
1584C
1585 ! -- Layer value
1586 ELSEIF(ifunc >= 4971+1 .AND. ifunc<= 4971+200 .AND. gbuf%G_TSAIWU > 0) THEN
1587 DO i=lft,llt
1588 evar(i) = zero
1589 ENDDO
1590 ius = ifunc - 4971
1591 IF (isolnod == 16.OR.isolnod == 20.OR.
1592 . (isolnod == 8.AND.jhbe == 14).OR.
1593 . ((isolnod == 6.OR.isolnod == 8).AND.jhbe == 15))THEN
1594 IF (ius <= nptg) THEN
1595 DO il=1,nlay
1596 IF (elbuf_tab(ng)%BUFLY(il)%L_TSAIWU > 0) THEN
1597 DO is=1,npts
1598 DO it=1,nptt
1599 DO ir=1,nptr
1600 lbuf=>elbuf_tab(ng)%BUFLY(il)%LBUF(ir,is,it)
1601 DO i=lft,llt
1602 evar(i) = evar(i) + lbuf%TSAIWU(i)
1603 ENDDO
1604 ENDDO
1605 ENDDO
1606 ENDDO
1607 ENDIF
1608 ENDDO
1609 ENDIF
1610 ENDIF
1611
1612c------------------------------------ Tillotson Region id
1613 ELSEIF( ifunc == 5172 ) THEN
1614 evar(1:nel) = zero
1615 mt = ixs(1,nft+1)
1616 IF (mlw == 151) THEN
1617 nlay = elbuf_tab(ng)%NLAY
1618 !count number of submaterial based on /EOS/TILLOTSON (IEOS=3)
1619 ntillotson = 0
1620 DO imat=1,nlay
1621 ieos = ipm(4, mat_param(mt)%MULTIMAT%MID(imat) )
1622 IF(ieos == 3)THEN
1623 ntillotson = ntillotson + 1
1624 imat_tillotson = imat
1625 ENDIF
1626 ENDDO
1627 !several Tillotson EoS Value= sum ( Region_i*10**(i-1), i=1,imat)
1628 IF(ntillotson > 1)THEN
1629 fac=one
1630 DO imat=1,nlay
1631 ieos = ipm(4, mat_param(mt)%MULTIMAT%MID(imat) )
1632 IF(ieos == 3)THEN
1633 ebuf => elbuf_tab(ng)%BUFLY(imat)%EOS(1,1,1)
1634 nvareos = elbuf_tab(ng)%BUFLY(imat)%NVAR_EOS
1635 DO i=1,nel
1636 evar(i) = evar(i) + ebuf%VAR(i) * fac
1637 ENDDO
1638 ENDIF
1639 fac=fac*ten
1640 ENDDO
1641 !single Tillotson EoS Value= Region_i
1642 ELSEIF(ntillotson == 1)THEN
1643 ebuf => elbuf_tab(ng)%BUFLY(imat_tillotson)%EOS(1,1,1)
1644 nvareos = elbuf_tab(ng)%BUFLY(imat_tillotson)%NVAR_EOS
1645 DO i=1,nel
1646 evar(i) = ebuf%VAR(i)
1647 ENDDO
1648 ENDIF
1649 ELSE
1650 !monomaterial law
1651 ieos = ipm(4,mt)
1652 IF(ieos == 3)THEN
1653 ebuf => elbuf_tab(ng)%BUFLY(1)%EOS(1,1,1)
1654 nvareos = elbuf_tab(ng)%BUFLY(1)%NVAR_EOS
1655 DO i=1,nel
1656 evar(i) = ebuf%VAR(i)
1657 ENDDO
1658 ENDIF
1659 ENDIF
1660
1661c------------------------------------ Volumetric Strain (VSTRAIN)
1662 elseif(ifunc == 5173) then
1663!--------------------------------------------------
1664 DO i=1,nel
1665 func(el2fa(nn1+nft+i)) = zero
1666 ENDDO
1667
1668 mt = ixs(1,nft+1)
1669
1670 do i=1,nel
1671
1672 if(mlw == 151)then
1673 !multimaterial 151 (collocated scheme)
1674 do ilay=1,multi_fvm%nbmat
1675 mid = mat_param(mt)%multimat%mid(ilay)
1676 rho0i(ilay) = pm(89,mid)
1677 vi(ilay) = multi_fvm%phase_alpha(ilay,i+nft) * gbuf%vol(i)
1678 v0i(ilay) = multi_fvm%phase_rho(ilay,i+nft) * vi(ilay) / rho0i(ilay) !rho0.V0 = rho.V
1679 enddo
1680 v0g = sum(v0i)
1681 rho0g = zero
1682 do ilay=1,multi_fvm%nbmat
1683 rho0g = rho0g + rho0i(ilay)*v0i(ilay)
1684 end do
1685 rho0g = rho0g / v0g
1686 func(el2fa(nn1+nft+i)) = multi_fvm%rho(i+nft) / rho0g - one
1687
1688 elseif(mlw == 51)then
1689 !multimaterial 51 (staggered scheme)
1690 imat = ixs(1,nft+1)
1691 iadbuf = ipm(7,imat)
1692 nuparam= ipm(9,imat)
1693 uparam => bufmat(iadbuf:iadbuf+nuparam)
1694 mbuf => elbuf_tab(ng)%bufly(1)%mat(1,1,1)
1695 ipos = 1
1696 !bijective order !indexes
1697 isubmat = nint(uparam(276+1)); iu(1)=m51_n0phas+(isubmat-1)*m51_nvphas + ipos-1
1698 isubmat = nint(uparam(276+2)); iu(2)=m51_n0phas+(isubmat-1)*m51_nvphas + ipos-1
1699 isubmat = nint(uparam(276+3)); iu(3)=m51_n0phas+(isubmat-1)*m51_nvphas + ipos-1
1700 isubmat = nint(uparam(276+4)); iu(4)=m51_n0phas+(isubmat-1)*m51_nvphas + ipos-1
1701 vfrac(i,1) = mbuf%var(i+iu(1)*nel)
1702 vfrac(i,2) = mbuf%var(i+iu(2)*nel)
1703 vfrac(i,3) = mbuf%var(i+iu(3)*nel)
1704 vfrac(i,4) = mbuf%var(i+iu(4)*nel)
1705 ipos = 12
1706 !bijective order !indexes
1707 isubmat = nint(uparam(276+1)); iu(1)=m51_n0phas+(isubmat-1)*m51_nvphas + ipos-1
1708 isubmat = nint(uparam(276+2)); iu(2)=m51_n0phas+(isubmat-1)*m51_nvphas + ipos-1
1709 isubmat = nint(uparam(276+3)); iu(3)=m51_n0phas+(isubmat-1)*m51_nvphas + ipos-1
1710 isubmat = nint(uparam(276+4)); iu(4)=m51_n0phas+(isubmat-1)*m51_nvphas + ipos-1
1711 rhoi(1) = mbuf%var(i+iu(1)*nel)
1712 rhoi(2) = mbuf%var(i+iu(2)*nel)
1713 rhoi(3) = mbuf%var(i+iu(3)*nel)
1714 rhoi(4) = mbuf%var(i+iu(4)*nel)
1715 do ilay=1,4
1716 mid = mat_param(mt)%multimat%mid(ilay)
1717 rho0i(ilay) = pm(89,mid)
1718 vi(ilay) = vfrac(i,ilay) * gbuf%vol(i)
1719 ipos = 12
1720 v0i(ilay) = rhoi(ilay) * vi(ilay) / rho0i(ilay) !rho0.V0 = rho.V
1721 enddo
1722 v0g = sum(v0i)
1723 rho0g = zero
1724 do ilay=1,4
1725 rho0g = rho0g + rho0i(ilay)*v0i(ilay)
1726 end do
1727 rho0g = rho0g / v0g
1728 func(el2fa(nn1+nft+i)) = gbuf%rho(i) / rho0g - one
1729
1730 elseif(mlw == 37)then
1731 !multimaterial 37 (staggered scheme)
1732 imat = ixs(1,nft+1)
1733 iadbuf = ipm(7,imat)
1734 nuparam= ipm(9,imat)
1735 uparam => bufmat(iadbuf:iadbuf+nuparam)
1736 mbuf => elbuf_tab(ng)%bufly(1)%mat(1,1,1)
1737 rho0i(1) = uparam(11)
1738 rho0i(2) = uparam(12)
1739 vi(1) = mbuf%var(i+3*nel) * gbuf%vol(i) !UVAR(I,4) = VFRAC1
1740 vi(2) = mbuf%var(i+4*nel) * gbuf%vol(i) !UVAR(I,5) = VFRAC2
1741 rhoi(1) = mbuf%var(i+2*nel) !UVAR(I,3) = RHO1
1742 rhoi(2) = mbuf%var(i+1*nel) !UVAR(I,2) = RHO2
1743 v0i(1) = rhoi(1) * vi(1) / rho0i(1) !rho0.V0 = rho.V
1744 v0i(2) = rhoi(2) * vi(2) / rho0i(2) !rho0.V0 = rho.V
1745 v0g = sum(v0i)
1746 rho0g = zero
1747 do ilay=1,2
1748 rho0g = rho0g + rho0i(ilay)*v0i(ilay)
1749 end do
1750 rho0g = rho0g / v0g
1751 func(el2fa(nn1+nft+i)) = gbuf%rho(i) / rho0g - one
1752
1753 elseif(mlw == 20)then
1754 !multimaterial 20 (staggered scheme)
1755 lbuf1 => elbuf_tab(ng)%bufly(1)%lbuf(1,1,1)
1756 lbuf2 => elbuf_tab(ng)%bufly(2)%lbuf(1,1,1)
1757 mid = mat_param(mt)%multimat%mid(1)
1758 rho0i(1) = pm(89,mid)
1759 mid = mat_param(mt)%multimat%mid(2)
1760 rho0i(2) = pm(89,mid)
1761 vi(1) = lbuf1%vol(i)
1762 vi(2) = lbuf2%vol(i)
1763 rhoi(1) = lbuf1%rho(i)
1764 rhoi(2) = lbuf2%rho(i)
1765 v0i(1) = rhoi(1) * vi(1) / rho0i(1) !rho0.V0 = rho.V
1766 v0i(2) = rhoi(2) * vi(2) / rho0i(2) !rho0.V0 = rho.V
1767 v0g = sum(v0i)
1768 rho0g = zero
1769 do ilay=1,2
1770 rho0g = rho0g + rho0i(ilay)*v0i(ilay)
1771 end do
1772 rho0g = rho0g / v0g
1773 func(el2fa(nn1+nft+i)) = gbuf%rho(i) / rho0g - one
1774
1775 else
1776 !general case (monomaterial law)
1777 if(pm(89,mt) > zero)then
1778 func(el2fa(nn1+nft+i)) = gbuf%rho(i) / pm(89,mt) - one
1779 end if
1780 end if
1781
1782 enddo
1783c------------------------------------ Volumetric Strain (VSTRAIN)
1784 elseif(ifunc >= 5173+1 .and. ifunc <= 5173+10) then
1785!--------------------------------------------------
1786 detected = .false.
1787 ilay = ifunc - (15899 + 4*mx_ply_anim)
1788 if(mlw == 151 .and. ilay <= min(10,multi_fvm%nbmat))detected = .true.
1789 if(mlw == 51 .and. ilay <= 4 )detected = .true.
1790 if(mlw == 37 .and. ilay <= 2 )detected = .true.
1791 if(mlw == 20 .and. ilay <= 2 )detected = .true.
1792
1793 if(detected)then
1794
1795 mt = ixs(1,nft+1)
1796
1797 do i=1,nel
1798
1799 if(mlw == 151)then
1800 !multimaterial 151 (collocated scheme)
1801 mid = mat_param(mt)%multimat%mid(ilay)
1802 rho0i(ilay) = pm(89,mid)
1803 vi(ilay) = multi_fvm%phase_alpha(ilay,i+nft) * gbuf%vol(i)
1804 v0i(ilay) = multi_fvm%phase_rho(ilay,i+nft) * vi(ilay) / rho0i(ilay) !rho0.V0 = rho.V
1805 func(el2fa(nn1+nft+i)) = multi_fvm%phase_rho(ilay,i+nft) / rho0i(ilay) - one
1806
1807 elseif(mlw == 51)then
1808 !multimaterial 51 (staggered scheme)
1809 imat = ixs(1,nft+1)
1810 iadbuf = ipm(7,imat)
1811 nuparam= ipm(9,imat)
1812 uparam => bufmat(iadbuf:iadbuf+nuparam)
1813 mbuf => elbuf_tab(ng)%bufly(1)%mat(1,1,1)
1814 mid = mat_param(mt)%multimat%mid(ilay)
1815 rho0i(ilay) = pm(89,mid)
1816 ipos = 1
1817 !bijective order !indexes
1818 isubmat = nint(uparam(276+ilay)); iu(1)=m51_n0phas+(isubmat-1)*m51_nvphas + ipos-1
1819 vfrac(i,ilay) = mbuf%var(i+iu(ilay)*nel)
1820 vi(ilay) = vfrac(i,ilay) * gbuf%vol(i)
1821 ipos = 12
1822 !bijective order !indexes
1823 isubmat = nint(uparam(276+ilay)); iu(ilay)=m51_n0phas+(isubmat-1)*m51_nvphas + ipos-1
1824 rhoi(ilay) = mbuf%var(i+iu(ilay)*nel)
1825 v0i(ilay) = rhoi(ilay) * vi(ilay) / rho0i(ilay) !rho0.V0 = rho.V
1826 func(el2fa(nn1+nft+i)) = rhoi(ilay) / rho0i(ilay) - one
1827
1828 elseif(mlw == 37)then
1829 !multimaterial 37 (staggered scheme)
1830 imat = ixs(1,nft+1)
1831 iadbuf = ipm(7,imat)
1832 nuparam= ipm(9,imat)
1833 uparam => bufmat(iadbuf:iadbuf+nuparam)
1834 mbuf => elbuf_tab(ng)%bufly(1)%mat(1,1,1)
1835 rho0i(ilay) = uparam(10+ilay)
1836 vi(ilay) = mbuf%var(i+(ilay+2)*nel) * gbuf%vol(i)
1837 rhoi(ilay) = mbuf%var(i+(3-ilay)*nel) !UVAR(I,3) = RHO1
1838 v0i(ilay) = rhoi(ilay) * vi(ilay) / rho0i(ilay)
1839 func(el2fa(nn1+nft+i)) = rhoi(ilay) / rho0i(ilay) - one
1840
1841 elseif(mlw == 20)then
1842 !multimaterial 20 (staggered scheme)
1843 lbuf => elbuf_tab(ng)%bufly(ilay)%lbuf(1,1,1)
1844 mid = mat_param(mt)%multimat%mid(ilay)
1845 rho0i(ilay) = pm(89,mid)
1846 vi(ilay) = lbuf%vol(i)
1847 rhoi(ilay) = lbuf%rho(i)
1848 v0i(ilay) = rhoi(ilay) * vi(ilay) / rho0i(ilay) !rho0.V0 = rho.V
1849 func(el2fa(nn1+nft+i)) = rhoi(ilay) / rho0i(ilay) - one
1850
1851 else
1852 !general case (monomaterial law)
1853 func(el2fa(nn1+nft+i)) = zero
1854 end if
1855 enddo
1856
1857 end if
1858
1859c------------------------------------
1860 !OTHER IFUNC VALUES
1861 ELSE
1862 DO i=lft,llt
1863 evar(i) = zero
1864 ENDDO
1865 ENDIF ! IFUNC general
1866c-----------
1867 ENDIF ! IF (MLW /= 0 .and. MLW /= 13 .and. IGTYP /= 0)
1868c--------------------------------
1869
1870 IF (isolnod == 16)THEN
1871 DO i=lft,llt
1872 n = nn2 + i + nft
1873 IF(el2fa(n)/=0)THEN
1874 func(el2fa(n)) = evar(i)
1875 func(el2fa(n)+1) = evar(i)
1876 func(el2fa(n)+2) = evar(i)
1877 func(el2fa(n)+3) = evar(i)
1878 ENDIF
1879 ENDDO
1880 ELSE
1881 DO i=lft,llt
1882 n = nn2 + i + nft
1883 IF(el2fa(n)/=0)THEN
1884 func(el2fa(n)) = evar(i)
1885 ENDIF
1886 ENDDO
1887 ENDIF
1888C
1889C-----------------------------------------------
1890 ELSEIF (isph3d == 1.AND.ity == 51) THEN
1891C TETRAS SPH.
1892C-----------------------------------------------
1893 gbuf => elbuf_tab(ng)%GBUF
1894 mbuf => elbuf_tab(ng)%BUFLY(1)%MAT(1,1,1)
1895 lbuf => elbuf_tab(ng)%BUFLY(1)%LBUF(1,1,1)
1896 nlay = elbuf_tab(ng)%NLAY
1897 nptr = elbuf_tab(ng)%NPTR
1898 npts = elbuf_tab(ng)%NPTS
1899 nptt = elbuf_tab(ng)%NPTT
1900 nptg = nptt*npts*nptr*nlay
1901 jturb= iparg(12,ng)*(iparg(7,ng)+iparg(11,ng))
1902C-----------
1903 IF(ifunc == 1)THEN
1904 DO i=lft,llt
1905 n = i + nft
1906 VALUE = zero
1907 IF (el2fa(nn3+n)/=0)THEN
1908 IF (mlw == 21)THEN
1909 VALUE = lbuf%EPSQ(i)
1910 ELSEIF (gbuf%G_PLA > 0) THEN
1911 VALUE = gbuf%PLA(i)
1912 ENDIF
1913 func(el2fa(nn3+n)) = VALUE
1914 ENDIF
1915 ENDDO
1916C-----------
1917 ELSEIF(ifunc == 2)THEN
1918 DO i=lft,llt
1919 n = i + nft
1920 IF(el2fa(nn3+n)/=0)THEN
1921 VALUE = gbuf%RHO(i)
1922 func(el2fa(nn3+n)) = VALUE
1923 ENDIF
1924 ENDDO
1925C-----------
1926 ELSEIF(ifunc == 3)THEN
1927 DO i=lft,llt
1928 n = i + nft
1929 ialel=iparg(7,ng)+iparg(11,ng)
1930 IF(ialel == 0)THEN
1931 iprt=ipartsp(n)
1932 mt =ipart(1,iprt)
1933 VALUE = gbuf%EINT(i)/max(em30,pm(1,mt))
1934 ELSE
1935 VALUE = gbuf%EINT(i)/max(em30,gbuf%RHO(i))
1936 ENDIF
1937 func(el2fa(nn3+n)) = VALUE
1938 ENDDO
1939C-----------
1940 ELSEIF(ifunc == 4)THEN
1941 DO i=lft,llt
1942 n = i + nft
1943 IF(el2fa(nn3+n)/=0)THEN
1944 IF (gbuf%G_TEMP > 0) THEN
1945 VALUE = gbuf%TEMP(i)
1946 ELSE
1947 VALUE = zero
1948 ENDIF
1949 func(el2fa(nn3+n)) = VALUE
1950 ENDIF
1951 ENDDO
1952C-----------
1953 ELSEIF(ifunc == 6.OR.ifunc == 7)THEN
1954 DO i=lft,llt
1955 n = i + nft
1956 IF(el2fa(nn3+n)/=0)THEN
1957 s11 = gbuf%SIG(jj(1) + i)
1958 s22 = gbuf%SIG(jj(2) + i)
1959 s33 = gbuf%SIG(jj(3) + i)
1960 s4 = gbuf%SIG(jj(4) + i)
1961 s5 = gbuf%SIG(jj(5) + i)
1962 s6 = gbuf%SIG(jj(6) + i)
1963 IF(ivisc > 0 ) THEN
1964 s11 =s11 + lbuf%VISC(jj(1) + i)
1965 s22 =s22 + lbuf%VISC(jj(2) + i)
1966 s33 =s33 + lbuf%VISC(jj(3) + i)
1967 s4 =s4 + lbuf%VISC(jj(4) + i)
1968 s5 =s5 + lbuf%VISC(jj(5) + i)
1969 s6 =s6 + lbuf%VISC(jj(6) + i)
1970 ENDIF
1971 p = - (s11 + s22 + s33 ) * third
1972 VALUE = p
1973 IF(ifunc == 7) THEN
1974 s1=s11 + p
1975 s2=s22 + p
1976 s3=s33 + p
1977 vonm2= three*(s4*s4 + s5*s5 + s6*s6 +
1978 . half*(s1*s1+s2*s2+s3*s3) )
1979 vonm= sqrt(vonm2)
1980 VALUE = vonm
1981 ENDIF
1982 func(el2fa(nn3+n)) = VALUE
1983 ENDIF
1984 ENDDO
1985C-----------
1986 ELSEIF(ifunc == 8.AND.jturb/=0)THEN
1987C ENERGIE TURBULENTE
1988 DO i=lft,llt
1989 nn = el2fa(nn3 + i + nft)
1990 IF(nn/=0)THEN
1991 func(nn) = gbuf%RK(i)
1992 ENDIF
1993 ENDDO
1994C-----------
1995 ELSEIF(ifunc == 9)THEN
1996C VISCOSITE TURBULENTE
1997 DO i=lft,llt
1998 n = i + nft
1999 nn = el2fa(nn3 + i + nft)
2000 IF(nn/=0)THEN
2001 IF((mlw == 6 .OR. mlw == 17).AND.jturb/=0)THEN
2002 iprt=ipartsp(n)
2003 mt =ipart(1,iprt)
2004 VALUE=pm(81,mt)*gbuf%RK(i)**2/
2005 . max(em15,gbuf%RE(i))
2006 ELSEIF(mlw == 46 .OR. mlw == 47)THEN
2007 VALUE = mbuf%VAR(i)
2008 ELSE
2009 VALUE = zero
2010 ENDIF
2011 func(nn) = VALUE
2012 ENDIF
2013 ENDDO
2014C-----------
2015 ELSEIF(ifunc == 10)THEN
2016C VORTICITE
2017 DO i=lft,llt
2018 nn = el2fa(nn3 + i + nft)
2019 IF(nn/=0)THEN
2020 IF(mlw == 6 .OR. mlw == 17)THEN
2021 VALUE = lbuf%VK(i)
2022 ELSEIF(mlw == 46 .OR. mlw == 47)THEN
2023 VALUE = mbuf%VAR(nel+i)
2024 ELSE
2025 VALUE = zero
2026 ENDIF
2027 func(nn) = VALUE
2028 ENDIF
2029 ENDDO
2030C-----------
2031 ELSEIF((ifunc == 11.OR.ifunc == 12.OR.ifunc == 13)
2032 . .AND.mlw == 24)THEN
2033 DO i=lft,llt
2034 n = i + nft
2035 func(el2fa(nn3+n)) = lbuf%DAM(jj(ifunc-10) + i)
2036 ENDDO
2037C-----------
2038 ELSEIF(ifunc>=14.AND.ifunc<=19)THEN
2039 IF(ivisc == 0) THEN
2040 DO i=lft,llt
2041 n = i + nft
2042 IF(el2fa(nn3+n)/=0)THEN
2043 VALUE = gbuf%SIG(jj(ifunc - 13) + i)
2044 func(el2fa(nn3+n)) = VALUE
2045 ENDIF
2046 ENDDO
2047 ELSE
2048 DO i=lft,llt
2049 n = i + nft
2050 IF(el2fa(nn3+n)/=0)THEN
2051 VALUE = gbuf%SIG(jj(ifunc - 13) + i) +
2052 . lbuf%VISC(jj(ifunc - 13) + i)
2053 func(el2fa(nn3+n)) = VALUE
2054 ENDIF
2055 ENDDO
2056 ENDIF
2057
2058C-----------
2059 ELSEIF(ifunc>=20.AND.ifunc<=24)THEN
2060 ius = ifunc - 20
2061 nuvar = ipm(8,mt)
2062 IF (nuvar > 0) THEN
2063 DO i=lft,llt
2064 n = i + nft
2065 IF(el2fa(nn3+n)/=0 . and. ius <= nuvar)THEN
2066 VALUE = mbuf%VAR(i + ius*nel)
2067 func(el2fa(nn3+n)) = VALUE
2068 ENDIF
2069 ENDDO
2070 ENDIF
2071C-----------
2072 ELSEIF(ifunc == 25)THEN
2073 DO i=lft,llt
2074 n = i + nft
2075 IF(el2fa(nn3+n)/=0)THEN
2076C FUNC(EL2FA(NN3+N)) = EHOUR(N)
2077 VALUE=0.
2078 func(el2fa(nn3+n)) = VALUE
2079 ENDIF
2080 ENDDO
2081C-----------
2082 ELSEIF(ifunc == 887)THEN
2083 DO i=lft,llt
2084 n = i + nft
2085 VALUE = zero
2086 IF (el2fa(nn3+n)/=0)THEN
2087 IF (gbuf%G_BFRAC > 0)THEN
2088 VALUE = gbuf%BFRAC(i)
2089 ENDIF
2090 func(el2fa(nn3+n)) = VALUE
2091 ENDIF
2092 ENDDO
2093C-----------
2094 ELSEIF(ifunc == 3890) THEN
2095
2096 nfail = elbuf_tab(ng)%BUFLY(1)%NFAIL
2097 DO ir=1,nfail
2098 dfmax=>
2099 . elbuf_tab(ng)%BUFLY(1)%FAIL(1,1,1)%FLOC(ir)%DAMMX
2100 DO i=lft,llt
2101 n = i + nft
2102 func(el2fa(nn3+n)) = dfmax(i)
2103 ENDDO
2104 ENDDO
2105C-----------
2106 ELSEIF(ifunc == 4893)THEN
2107 DO i=lft,llt
2108 n = i + nft
2109 IF (el2fa(nn3+n)/=0)THEN
2110 func(el2fa(nn3+n)) = ispmd
2111 ENDIF
2112 ENDDO
2113C-----------
2114 ELSEIF(ifunc == 4894)THEN
2115 DO i=lft,llt
2116 n = i + nft
2117 IF (el2fa(nn3+n)/=0)THEN
2118 func(el2fa(nn3+n)) = gbuf%FILL(i)
2119 ENDIF
2120 ENDDO
2121C-----------
2122 ELSEIF (ifunc == 4895) THEN ! /ANIM/ELEM/SIGEQ
2123 ! equivalent stress - other then VON MISES
2124 IF (gbuf%G_SEQ > 0) THEN ! non VON MISES
2125! DO I=LFT,LLT
2126! EVAR_TMP = ZERO
2127! N = I + NFT
2128! IF (EL2FA(NN3+N) /= 0) THEN
2129! NPTG = NLAY*NPTR*NPTS*NPTT
2130! DO IL=1,NLAY
2131! DO IT=1,NPTT
2132! DO IR=1,NPTR
2133! DO IS=1,NPTS
2134! LBUF => ELBUF_TAB(NG)%BUFLY(IL)%LBUF(IR,IS,IT)
2135! IF (ELBUF_TAB(NG)%BUFLY(IL)%L_SEQ > 0) THEN
2136! EVAR_TMP = EVAR_TMP + LBUF%SEQ(I)/NPTG
2137! ELSE
2138! S11 = LBUF%SIG(JJ(1) + I)
2139! S22 = LBUF%SIG(JJ(2) + I)
2140! S33 = LBUF%SIG(JJ(3) + I)
2141! S4 = LBUF%SIG(JJ(4) + I)
2142! S5 = LBUF%SIG(JJ(5) + I)
2143! S6 = LBUF%SIG(JJ(6) + I)
2144! IF (IVISC > 0) THEN
2145! S11 = S11 + LBUF%VISC(JJ(1) + I)
2146! S22 = S22 + LBUF%VISC(JJ(2) + I)
2147! S33 = S33 + LBUF%VISC(JJ(3) + I)
2148! S4 = S4 + LBUF%VISC(JJ(4) + I)
2149! S5 = S5 + LBUF%VISC(JJ(5) + I)
2150! s6 = s6 + lbuf%VISC(jj(6) + i)
2151! ENDIF
2152! p = - (s11 + s22 + s33) * third
2153! S1 = S11 + P
2154! S2 = S22 + P
2155! S3 = S33 + P
2156! VONM2 = THREE*(S4*S4 + S5*S5 + S6*S6 +
2157! . HALF*(S1*S1 + S2*S2 + S3*S3))
2158! VONM = SQRT(VONM2)
2159! EVAR_TMP = EVAR_TMP + VONM/NPTG
2160! ENDIF ! IF (ELBUF_TAB(NG)%BUFLY(IL)%L_SEQ > 0)
2161! ENDDO ! DO IS=1,NPTS
2162! ENDDO ! DO IR=1,NPTR
2163! ENDDO ! DO IT=1,NPTT
2164! ENDDO ! DO IL=1,NLAY
2165! ENDIF ! IF (EL2FA(NN3+N) /= 0)
2166! FUNC(EL2FA(NN3+N)) = EVAR_TMP
2167! ENDDO ! DO I=LFT,LLT
2168!!!!!!
2169 iprt = ipartsp(nft+1)
2170 imat = ipart(1,iprt)
2171 iadbuf = ipm(7,imat)
2172 nuparam= ipm(9,imat)
2173 uparam => bufmat(iadbuf:iadbuf+nuparam)
2174 lbuf => elbuf_tab(ng)%BUFLY(1)%LBUF(1,1,1)
2175!---
2176 IF (mlw == 72) THEN
2177! (ILAW = 74) -- Hill MMC (anisotropic)
2178 DO i=lft,llt
2179 n = i + nft
2180 IF (el2fa(nn3+n) /= 0) THEN
2181 func(el2fa(nn3+n)) = gbuf%SEQ(i)
2182 ENDIF ! IF (EL2FA(NN3+N) /= 0)
2183 ENDDO ! DO I=LFT,LLT
2184 ELSEIF (mlw == 74) THEN
2185! (ILAW = 74) -- Thermal Hill Orthotropic 3D Material
2186 ff0 = uparam(7)
2187 gg0 = uparam(8)
2188 hh0 = uparam(9)
2189 ll0 = uparam(10)
2190 mm0 = uparam(11)
2191 nn0 = uparam(12)
2192 DO i=lft,llt
2193 n = i + nft
2194 IF (el2fa(nn3+n) /= 0) THEN
2195 s11 = gbuf%SIG(jj(1) + i)
2196 s22 = gbuf%SIG(jj(2) + i)
2197 s33 = gbuf%SIG(jj(3) + i)
2198 s4 = gbuf%SIG(jj(4) + i)
2199 s5 = gbuf%SIG(jj(5) + i)
2200 s6 = gbuf%SIG(jj(6) + i)
2201 IF (ivisc > 0) THEN
2202 s11 = s11 + lbuf%VISC(jj(1) + i)
2203 s22 = s22 + lbuf%VISC(jj(2) + i)
2204 s33 = s33 + lbuf%VISC(jj(3) + i)
2205 s4 = s4 + lbuf%VISC(jj(4) + i)
2206 s5 = s5 + lbuf%VISC(jj(5) + i)
2207 s6 = s6 + lbuf%VISC(jj(6) + i)
2208 ENDIF
2209 p = - (s11 + s22 + s33) * third
2210 s1 = s11 + p
2211 s2 = s22 + p
2212 s3 = s33 + p
2213!
2214 crit = ff0*(s2 - s3)**2
2215 . + gg0*(s3 - s1)**2
2216 . + hh0*(s1 - s2)**2
2217 . + two*ll0*s5**2
2218 . + two*mm0*s6**2
2219 . + two*nn0*s4**2
2220!
2221 func(el2fa(nn3+n)) = sqrt(crit)
2222 ENDIF ! IF (EL2FA(NN3+N) /= 0)
2223 ENDDO ! DO I=LFT,LLT
2224 ELSEIF (mlw == 93) THEN
2225! (ILAW = 93) -- orth Hill MMC
2226 DO i=lft,llt
2227 n = i + nft
2228 IF (el2fa(nn3+n) /= 0) THEN
2229 func(el2fa(nn3+n)) = gbuf%SEQ(i)
2230 ENDIF ! IF (EL2FA(NN3+N) /= 0)
2231 ENDDO ! DO I=LFT,LLT
2232 ELSEIF (mlw == 104) THEN
2233 DO il=1,nlay
2234 DO is=1,npts
2235 DO it=1,nptt
2236 DO ir=1,nptr
2237 lbuf => elbuf_tab(ng)%BUFLY(il)%LBUF(ir,is,it)
2238 DO i=lft,llt
2239 n = i + nft
2240 IF (el2fa(nn3+n) /= 0) THEN
2241 func(el2fa(nn3+n)) = func(el2fa(nn3+n)) + lbuf%SEQ(i)/nptg
2242 ENDIF
2243 ENDDO
2244 ENDDO
2245 ENDDO
2246 ENDDO
2247 ENDDO
2248 ELSEIF (mlw == 115) THEN
2249! (ILAW = 74) -- Hill MMC (anisotropic)
2250 DO i=lft,llt
2251 n = i + nft
2252 IF (el2fa(nn3+n) /= 0) THEN
2253 func(el2fa(nn3+n)) = gbuf%SEQ(i)
2254 ENDIF ! IF (EL2FA(NN3+N) /= 0)
2255 ENDDO ! DO I=LFT,LLT
2256 ENDIF ! IF (MLW == 72)
2257!---
2258 ELSE ! VON MISES
2259 IF (ivisc == 0) THEN
2260 DO i=lft,llt
2261 n = i + nft
2262 IF (el2fa(nn3+n) /= 0) THEN
2263 p = - (gbuf%SIG(jj(1) + i)
2264 . + gbuf%SIG(jj(2) + i)
2265 . + gbuf%SIG(jj(3) + i)) * third
2266 s1 = gbuf%SIG(jj(1) + i)+p
2267 s2 = gbuf%SIG(jj(2) + i)+p
2268 s3 = gbuf%SIG(jj(3) + i)+p
2269 vonm2 = three*(gbuf%SIG(jj(4) + i)**2 +
2270 . gbuf%SIG(jj(5) + i)**2 +
2271 . gbuf%SIG(jj(6) + i)**2 +
2272 . half*(s1*s1+s2*s2+s3*s3))
2273 vonm = sqrt(vonm2)
2274 func(el2fa(nn3+n)) = vonm
2275 ENDIF ! IF (EL2FA(NN3+N) /= 0)
2276 ENDDO ! DO I=LFT,LLT
2277 ELSE
2278 DO i=lft,llt
2279 n = i + nft
2280 IF (el2fa(nn3+n) /= 0) THEN
2281 s11 = gbuf%SIG(jj(1) + i) + lbuf%VISC(jj(1) + i)
2282 s22 = gbuf%SIG(jj(2) + i) + lbuf%VISC(jj(2) + i)
2283 s33 = gbuf%SIG(jj(3) + i) + lbuf%VISC(jj(3) + i)
2284 s4 = gbuf%SIG(jj(4) + i) + lbuf%VISC(jj(4) + i)
2285 s5 = gbuf%SIG(jj(5) + i) + lbuf%VISC(jj(5) + i)
2286 s6 = gbuf%SIG(jj(6) + i) + lbuf%VISC(jj(6) + i)
2287 p = - (s11 + s22 + s33) * third
2288 s1 = s11 + p
2289 s2 = s22 + p
2290 s3 = s33 + p
2291 vonm2 = three*(s4*s4 + s5*s5 + s6*s6 +
2292 . half*(s1*s1 + s2*s2 + s3*s3))
2293 vonm = sqrt(vonm2)
2294 func(el2fa(nn3+n)) = vonm
2295 ENDIF ! IF (EL2FA(NN3+N) /= 0)
2296 ENDDO ! DO I=LFT,LLT
2297 ENDIF ! IF(IVISC == 0)
2298 ENDIF ! IF (GBUF%G_SEQ > 0)
2299c-----------OFF
2300 ELSEIF(ifunc == 4965)THEN
2301 IF (gbuf%G_OFF > 0) THEN
2302 DO i=lft,llt
2303 n = i + nft
2304 IF(gbuf%OFF(i) > one) THEN
2305 func(el2fa(nn3+n)) = gbuf%OFF(i) - one
2306 ELSEIF((gbuf%OFF(i) >= zero .AND. gbuf%OFF(i) <= one)) THEN
2307 func(el2fa(nn3+n)) = gbuf%OFF(i)
2308 ELSE
2309 func(el2fa(nn3+n)) = -one
2310 ENDIF
2311 ENDDO
2312 ENDIF
2313C-----------
2314 ELSE
2315 DO i=lft,llt
2316 n = i + nft
2317 IF(el2fa(nn3+n)/=0)THEN
2318 func(el2fa(nn3+n)) = zero
2319 ENDIF
2320 ENDDO
2321 ENDIF ! IFUNC
2322C-----------------------------------------------
2323 ELSEIF (ity == 101) THEN
2324C ISOGEOMETRIC ELEMENT A VERIFIER
2325C-----------------------------------------------
2326 gbuf => elbuf_tab(ng)%GBUF
2327c-----------
2328 IF(ifunc == 1)THEN
2329 DO i=lft,llt
2330 IF (mlw == 10 .OR. mlw == 21) THEN
2331 evar(i) = lbuf%EPSQ(i)
2332 ELSEIF (gbuf%G_PLA > 0) THEN
2333 evar(i) = gbuf%PLA(i)
2334 ENDIF
2335 ENDDO
2336c
2337 ELSEIF(ifunc == 6 .OR. ifunc == 7)THEN
2338 DO i=lft,llt
2339 n = i + nft
2340 s11 = gbuf%SIG(jj(1) + i)
2341 s22 = gbuf%SIG(jj(2) + i)
2342 s33 = gbuf%SIG(jj(3) + i)
2343 s4 = gbuf%SIG(jj(4) + i)
2344 s5 = gbuf%SIG(jj(5) + i)
2345 s6 = gbuf%SIG(jj(6) + i)
2346 IF(ivisc > 0)THEN
2347 s11 = s11 + lbuf%VISC(jj(1) + i)
2348 s22 = s22 + lbuf%VISC(jj(2) + i)
2349 s33 = s33 + lbuf%VISC(jj(3) + i)
2350 s4 = s4 + lbuf%VISC(jj(4) + i)
2351 s5 = s5 + lbuf%VISC(jj(5) + i)
2352 s6 = s6 + lbuf%VISC(jj(6) + i)
2353 ENDIF
2354 p = - (s11 + s22 + s33) * third
2355 VALUE = p
2356 IF (ifunc==7) THEN
2357 s1= s11 + p
2358 s2= s22 + p
2359 s3= s33 + p
2360 vonm2= three*(s4*s4 + s5*s5 + s6*s6+
2361 . half*(s1*s1+s2*s2+s3*s3) )
2362 vonm= sqrt(vonm2)
2363 VALUE = vonm
2364 ENDIF
2365 evar(i) = VALUE
2366 ENDDO
2367
2368 ELSEIF(ifunc==2)THEN
2369 DO i=lft,llt
2370 evar(i) = gbuf%RHO(i)
2371 ENDDO
2372
2373 ELSEIF(ifunc==3)THEN
2374 DO i=lft,llt
2375 VALUE = gbuf%EINT(i)/max(em30,gbuf%RHO(i))
2376 evar(i) = VALUE
2377 ENDDO
2378
2379 ELSEIF (ifunc == 26) THEN ! element strain rate
2380 evar(lft:llt) = gbuf%EPSD(lft:llt)
2381!
2382 ELSE
2383 DO i=lft,llt
2384 n = i + nft
2385 evar(i) = zero
2386 ENDDO
2387 ENDIF ! IFUNC
2388C
2389 DO i=lft,llt
2390 n = i + nft
2391 DO j=1,27
2392 func(el2fa(nn4+n)+j-1) = evar(i)
2393 ENDDO
2394 ENDDO
2395 ELSE
2396 CONTINUE
2397 ENDIF ! ITY
2398C-----------------------------------------------
2399 ENDDO ! FIN DE BOUCLE SUR LES OFFSET
2400 ENDIF ! mlw /= 13
2401 ENDDO !next NG
2402C-----------------------------------------------
2403
2404 IF (nspmd == 1) THEN
2405 DO n=1,nbf
2406 r4 = func(n)
2407 CALL write_r_c(r4,1)
2408 ENDDO
2409 ELSE
2410 DO n = 1, nbf
2411 wal(n) = func(n)
2412 ENDDO
2413 IF (ispmd == 0) THEN
2414 buf = numelsg+3*numels16g+numsphg
2415 ELSE
2416 buf=1
2417 ENDIF
2418 CALL spmd_r4get_partn(1,nbf,nbpart,iadg,wal,buf)
2419 ENDIF
2420c-----------
2421 IF(ALLOCATED(wa_l))DEALLOCATE(wa_l)
2422 RETURN
2423 END
my_real
#define my_real
Definition cppsort.cpp:32
dfuncs
subroutine dfuncs(elbuf_tab, func, ifunc, iparg, geo, ixs, mass, pm, el2fa, nbf, ipm, igeo, nbpart, ehour, anim, iadg, spbuf, ipart, ipartsp, isph3d, x, v, w, ale_connectivity, nercvois, nesdvois, lercvois, lesdvois, bufmat, fani_cell, multi_fvm, mat_param, itherm)
Definition dfunc6.F:55
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21
ale_connectivity_mod
Definition ale_connectivity_mod.F:223
aleanim_mod
Definition aleanim_mod.F:40
alefvm_mod
Definition alefvm_mod.F:88
alefvm_mod::alefvm_buffer
type(alefvm_buffer_), target alefvm_buffer
Definition alefvm_mod.F:120
alefvm_mod::alefvm_param
type(alefvm_param_), target alefvm_param
Definition alefvm_mod.F:121
i22tri_mod
Definition cut-cell-search_mod.F:212
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
schlieren_mod
Definition schlieren_mod.F:46
output_schlieren
subroutine output_schlieren(evar, ix, x, iparg, wa_l, elbuf_tab, ale_connectivity, vol, ng, nix, ityp)
Definition output_schlieren.F:40
schlieren_buffer_gathering
subroutine schlieren_buffer_gathering(nercvois, nesdvois, lercvois, lesdvois, iparg, elbuf_tab, multi_fvm, itherm)
Definition schlieren_buffer_gathering.F:44
spmd_r4get_partn
subroutine spmd_r4get_partn(size, nbf_l, nbpart, iadg, wal, buf)
Definition spmd_r4get_partn.F:47
srotorth
subroutine srotorth(x, ixs, gama, khbe, ityp, icsig)
Definition srotorth.F:35
ale_connectivity_mod::t_ale_connectivity
Definition ale_connectivity_mod.F:254
aleanim_mod::fani_cell_
Definition aleanim_mod.F:44
write_r_c
void write_r_c(float *w, int *len)
Definition write_routtines.c:519