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