OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
dfunc0.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!|| dfunc0 ../engine/source/output/anim/generate/dfunc0.F
25!||--- called by ------------------------------------------------------
26!|| genani ../engine/source/output/anim/generate/genani.F
27!||--- calls -----------------------------------------------------
28!|| schlieren_buffer_gathering ../engine/source/output/anim/generate/schlieren_buffer_gathering.F
29!|| spmd_r4get_partn ../engine/source/mpi/anim/spmd_r4get_partn.F
30!|| write_r_c ../common_source/tools/input_output/write_routtines.c
31!||--- uses -----------------------------------------------------
32!|| ale_connectivity_mod ../common_source/modules/ale/ale_connectivity_mod.F
33!|| alefvm_mod ../common_source/modules/ale/alefvm_mod.F
34!|| elbufdef_mod ../common_source/modules/mat_elem/elbufdef_mod.F90
35!|| initbuf_mod ../engine/share/resol/initbuf.F
36!|| matparam_def_mod ../common_source/modules/mat_elem/matparam_def_mod.F90
37!|| multi_fvm_mod ../common_source/modules/ale/multi_fvm_mod.F90
38!|| multimat_param_mod ../common_source/modules/multimat_param_mod.F90
39!|| my_alloc_mod ../common_source/tools/memory/my_alloc.F90
40!|| schlieren_mod ../engine/share/modules/schlieren_mod.F
41!||====================================================================
42 SUBROUTINE dfunc0(ELBUF_TAB, FUNC ,IFUNC ,IPARG ,
43 2 MASS , PM ,EL2FA ,NBF ,
44 3 NBPART , IADG ,SPBUF ,IPART ,
45 4 IPARTSP , ALE_CONNECTIVITY ,IPM ,
46 5 X , V ,W ,ITHERM ,
47 6 NERCVOIS , NESDVOIS ,LERCVOIS ,LESDVOIS,
48 7 BUFMAT , MULTI_FVM ,KXSP ,DEFAULT_OUTPUT,
49 8 MAT_PARAM)
50C-----------------------------------------------
51C M o d u l e s
52C-----------------------------------------------
53 USE initbuf_mod
54 USE elbufdef_mod
55 USE alefvm_mod
56 USE multi_fvm_mod
57 USE schlieren_mod
58 USE ale_connectivity_mod
59 USE my_alloc_mod
60 USE matparam_def_mod , ONLY : matparam_struct_
61 USE multimat_param_mod , ONLY : m51_n0phas, m51_nvphas
62C-----------------------------------------------
63C I m p l i c i t T y p e s
64C-----------------------------------------------
65#include "implicit_f.inc"
66C-----------------------------------------------
67C C o m m o n B l o c k s
68C-----------------------------------------------
69#include "vect01_c.inc"
70#include "mvsiz_p.inc"
71#include "com01_c.inc"
72#include "com04_c.inc"
73#include "sphcom.inc"
74#include "scr17_c.inc"
75#include "scr25_c.inc"
76#include "param_c.inc"
77#include "task_c.inc"
78#include "spmd_c.inc"
79C-----------------------------------------------
80C D u m m y A r g u m e n t s
81C-----------------------------------------------
82 my_real func(*), mass(*) ,pm(npropm,nummat),spbuf(nspbuf,*),x(3,numnod),v(3,numnod), w(*)
83 my_real, TARGET :: bufmat(*)
84 INTEGER IPARG(NPARG,NGROUP),EL2FA(*),IFUNC,NBF,
85 . NBPART,IADG(NSPMD,*),IPART(LIPART1,*),IPARTSP(*),
86 . NERCVOIS(*),NESDVOIS(*),LERCVOIS(*),LESDVOIS(*),IPM(NPROPMI,NUMMAT)
87 INTEGER, INTENT(IN) :: ITHERM
88 INTEGER, INTENT(IN) :: KXSP(NISP,NUMSPH),DEFAULT_OUTPUT
89 TYPE (ELBUF_STRUCT_), DIMENSION(NGROUP), TARGET :: ELBUF_TAB
90 TYPE(multi_fvm_struct), INTENT(IN) :: MULTI_FVM
91 TYPE(t_ale_connectivity), INTENT(IN) :: ALE_CONNECTIVITY
92 TYPE (MATPARAM_STRUCT_) ,DIMENSION(NUMMAT) ,INTENT(IN) :: MAT_PARAM
93C-----------------------------------------------
94C L o c a l V a r i a b l e s
95C-----------------------------------------------
96 my_real evar(mvsiz), p, vonm2, vonm, s1, s2, s3, VALUE
97 INTEGER I,II(6),N,NN,NN1,NG,NEL,JTURB,MT,MLW,IALEL,IPRT,IUS,BUF,NUVAR,IR,NFAIL,IALEFVM_FLG,IEOS,NVAREOS
98 REAL R4
99 REAL,DIMENSION(:),ALLOCATABLE :: WA
100 TYPE(G_BUFEL_) ,POINTER :: GBUF
101 TYPE(L_BUFEL_) ,POINTER :: LBUF, LBUF1,LBUF2
102 TYPE(BUF_MAT_) ,POINTER :: MBUF
103 TYPE(buf_eos_) ,POINTER :: EBUF
104 my_real, DIMENSION(:),POINTER :: dfmax
105 my_real, DIMENSION(:) ,POINTER :: uparam
106 INTEGER MID,IMAT,NUPARAM,IPOS,IADBUF,ISUBMAT,IU(4),ILAY
107 my_real :: vi(21) !< submaterial volumes at reference densities (max submat : 21)
108 my_real :: v0i(21) !< submaterial volumes at reference densities (max submat : 21)
109 my_real :: v0g !< global volume at reference density (mixture)
110 my_real :: rho0i(21) !< submaterial initial mass densities (max submat : 21)
111 my_real :: rhoi(21) !< submaterial mass densities (max submat : 21)
112 my_real :: rho0g !< global initial mass density (mixture)
113 LOGICAL detected
114C-----------------------------------------------
115C S o u r c e L i n e s
116C-----------------------------------------------
117 CALL my_alloc(wa,nbf)
118 nn1 = 1
119
120 !-------------------------------------------------------!
121 ! INITIALIZATION IF SCHLIEREN DEFINED !
122 !-------------------------------------------------------!
123 IF(ifunc==4892)THEN
124 CALL schlieren_buffer_gathering(nercvois ,nesdvois ,lercvois ,lesdvois, iparg, elbuf_tab, multi_fvm, itherm)
125 endif!(IFUNC==4892)
126
127C-----------------------------------------------
128 DO ng=1,ngroup
129 mlw = iparg(1,ng)
130 nel = iparg(2,ng)
131 nft = iparg(3,ng)
132 ity = iparg(5,ng)
133 lft=1
134 llt=nel
135!
136 DO i=1,6
137 ii(i) = nel*(i-1)
138 ENDDO
139!
140C-----------------------------------------------
141 IF (ity == 51) THEN
142C-----------------------------------------------
143C SPH PARTICLES
144C DEFAULT_OUTPUT = 1 -> diameter always printed
145C DEFAULT_OUTPUT = 2 -> nb of neighbours always printed
146C-----------------------------------------------
147 IF(ifunc == 0)THEN
148 IF (default_output == 1) THEN
149 DO i=lft,llt
150 n = i + nft
151 func(el2fa(nn1+n)) = spbuf(1,n)
152 ENDDO
153 ELSEIF (default_output == 2) THEN
154 DO i=lft,llt
155 n = i + nft
156 func(el2fa(nn1+n)) = kxsp(4,n)
157 ENDDO
158 ENDIF
159 ELSE
160 gbuf => elbuf_tab(ng)%GBUF
161 lbuf => elbuf_tab(ng)%BUFLY(1)%LBUF(1,1,1)
162 mbuf => elbuf_tab(ng)%BUFLY(1)%MAT(1,1,1)
163 jturb = iparg(12,ng)*(iparg(7,ng)+iparg(11,ng))
164 nuvar = elbuf_tab(ng)%BUFLY(1)%NVAR_MAT
165C-----------
166 IF (ifunc == 1 .AND. gbuf%G_PLA > 0) THEN
167 DO i=lft,llt
168 n = i + nft
169 IF (el2fa(nn1+n)/=0) THEN
170 func(el2fa(nn1+n)) = gbuf%PLA(i)
171 ENDIF
172 ENDDO
173c-----------
174 ELSEIF (ifunc == 2) THEN
175 DO i=lft,llt
176 n = i + nft
177 func(el2fa(nn1+n)) = gbuf%RHO(i)
178 ENDDO
179 ELSEIF (ifunc == 3) THEN
180 DO i=lft,llt
181 n = i + nft
182 ialel=iparg(7,ng)+iparg(11,ng)
183 IF(ialel == 0)THEN
184 iprt=ipartsp(n)
185 mt =ipart(1,iprt)
186 VALUE = gbuf%EINT(i)/max(em30,pm(89,mt))
187 ELSE
188 VALUE = gbuf%EINT(i)/max(em30,gbuf%RHO(i))
189 ENDIF
190 func(el2fa(nn1+n)) = VALUE
191 ENDDO
192c-----------
193 ELSEIF (ifunc == 4 .AND. gbuf%G_TEMP > 0) THEN
194 DO i=lft,llt
195 n = i + nft
196 IF (el2fa(nn1+n)/=0) func(el2fa(nn1+n)) = gbuf%TEMP(i)
197 ENDDO
198c-----------
199 ELSEIF(ifunc == 6 .OR. ifunc == 7)THEN
200 DO i=lft,llt
201 n = i + nft
202 IF(el2fa(nn1+n)/=0)THEN
203 p = - (gbuf%SIG(ii(1) + i)
204 . + gbuf%SIG(ii(2) + i)
205 . + gbuf%SIG(ii(3) + i) ) * third
206 VALUE = p
207 IF (ifunc == 7) THEN
208 s1=gbuf%SIG(ii(1) + i) + p
209 s2=gbuf%SIG(ii(2) + i) + p
210 s3=gbuf%SIG(ii(3) + i) + p
211 vonm2= three*(gbuf%SIG(ii(4) + i)**2 +
212 . gbuf%SIG(ii(5) + i)**2 +
213 . gbuf%SIG(ii(6) + i)**2 +
214 . half*(s1*s1+s2*s2+s3*s3) )
215 vonm= sqrt(vonm2)
216 VALUE = vonm
217 ENDIF
218 func(el2fa(nn1+n)) = VALUE
219 ENDIF
220 ENDDO
221c-----------
222 ELSEIF(ifunc == 8 .AND. jturb/=0)THEN
223C ENERGIE TURBULENTE
224 DO i=lft,llt
225 nn = el2fa(nn1 + i + nft)
226 IF(nn/=0)THEN
227 func(nn) = gbuf%RK(i)
228 ENDIF
229 ENDDO
230c-----------
231 ELSEIF(ifunc == 9)THEN
232C VISCOSITE TURBULENTE
233 DO i=lft,llt
234 n = i + nft
235 nn = el2fa(nn1 + i + nft)
236 IF(nn/=0)THEN
237 IF(mlw == 6.AND.jturb/=0)THEN
238 iprt=ipartsp(n)
239 mt =ipart(1,iprt)
240 VALUE = pm(81,mt)*gbuf%RK(i)**2 / max(em15,gbuf%RE(i))
241 ELSE
242 VALUE = zero
243 ENDIF
244 func(nn) = VALUE
245 ENDIF
246 ENDDO
247c-----------
248 ELSEIF(ifunc == 10)THEN
249C VORTICITE
250 DO i=lft,llt
251 nn = el2fa(nn1 + i + nft)
252 IF(nn/=0)THEN
253 IF(mlw == 6 .OR. mlw == 17)THEN
254 VALUE = lbuf%VK(i)
255 ELSEIF(mlw == 46 .OR. mlw == 47)THEN
256 VALUE = mbuf%VAR(nel+i) !UVAR(I,2)
257 ELSE
258 VALUE = zero
259 ENDIF
260 func(nn) = VALUE
261 ENDIF
262 ENDDO
263c-----------
264 ELSEIF((ifunc == 11.OR.ifunc == 12.OR.ifunc == 13)
265 . .AND.mlw == 24)THEN
266C dam 1 2 3
267 DO i=lft,llt
268 n = i + nft
269 func(el2fa(nn1+n)) = lbuf%DAM(ii(ifunc-10) + i)
270 ENDDO
271c-----------
272 ELSEIF(ifunc>=14.AND.ifunc<=19)THEN
273 DO i=lft,llt
274 n = i + nft
275 IF(el2fa(nn1+n)/=0)THEN
276 func(el2fa(nn1+n)) = gbuf%SIG(ii(ifunc-13) + i)
277 ENDIF
278 ENDDO
279c-----------
280 ELSEIF(ifunc>=20.AND.ifunc<=24)THEN
281 ius = ifunc - 20
282 DO i=lft,llt
283 n = i + nft
284 IF(el2fa(nn1+n)/=0)THEN
285 IF ( (ius + 1) < nuvar) THEN
286 VALUE = mbuf%VAR(i+ius*nel)
287 ELSE
288 VALUE = zero
289 ENDIF
290 func(el2fa(nn1+n)) = VALUE
291 ENDIF
292 ENDDO
293c-----------
294 ELSEIF(ifunc == 25)THEN
295 DO i=lft,llt
296 n = i + nft
297 IF(el2fa(nn1+n)/=0)THEN
298C FUNC(EL2FA(NN1+N)) = EHOUR(N)
299 VALUE=0.
300 func(el2fa(nn1+n)) = VALUE
301 ENDIF
302 ENDDO
303c-----------
304 ELSEIF(ifunc == 3890) THEN
305
306 nfail = elbuf_tab(ng)%BUFLY(1)%NFAIL
307 DO ir=1,nfail
308 dfmax=>
309 . elbuf_tab(ng)%BUFLY(1)%FAIL(1,1,1)%FLOC(ir)%DAMMX
310 DO i=lft,llt
311 n = i + nft
312 func(el2fa(nn1+n)) = dfmax(i)
313 ENDDO
314 ENDDO
315c-----------
316 ELSEIF (ifunc == 4893) THEN
317 DO i=lft,llt
318 n = i + nft
319 func(el2fa(nn1+n)) = ispmd
320 ENDDO
321c-----------
322 ELSEIF (ifunc == 4895) THEN ! /ANIM/ELEM/SIGEQ
323C equivalent stress - (NON VON MISES / VON MISES)
324 IF (gbuf%G_SEQ > 0) THEN ! non VON MISES
325 DO i=lft,llt
326 n = i + nft
327 IF (el2fa(nn1+n) /= 0) THEN
328 func(el2fa(nn1+n)) = gbuf%SEQ(i)
329 ENDIF
330 ENDDO
331 ELSE ! VON MISES
332 DO i=lft,llt
333 n = i + nft
334 IF (el2fa(nn1+n) /= 0) THEN
335 p = -(gbuf%SIG(ii(1) + i)
336 . + gbuf%SIG(ii(2) + i)
337 . + gbuf%SIG(ii(3) + i)) * third
338 s1=gbuf%SIG(ii(1) + i) + p
339 s2=gbuf%SIG(ii(2) + i) + p
340 s3=gbuf%SIG(ii(3) + i) + p
341 vonm2= three*(gbuf%SIG(ii(4) + i)**2 +
342 . gbuf%SIG(ii(5) + i)**2 +
343 . gbuf%SIG(ii(6) + i)**2 +
344 . half*(s1*s1+s2*s2+s3*s3))
345 vonm= sqrt(vonm2)
346 func(el2fa(nn1+n)) = vonm
347 ENDIF
348 ENDDO
349 ENDIF
350c-----------
351 ELSEIF(ifunc == 4930 )THEN !/ANIM/ELEM/TDET
352 IF(gbuf%G_TB > 0)THEN
353 DO i=lft,llt
354 n = i + nft
355 IF(el2fa(nn1+n)/=0)THEN
356 func(el2fa(nn1+n)) = -gbuf%TB(i)
357 ENDIF
358 ENDDO
359 ENDIF
360c-----------
361 ELSEIF(ifunc == 4937 )THEN !/ANIM/ELEM/DT
362 IF(gbuf%G_DT>0)THEN
363 DO i=lft,llt
364 n = i + nft
365 IF(el2fa(nn1+n)/=0)THEN
366 func(el2fa(nn1+n)) = gbuf%DT(i)
367 ENDIF
368 ENDDO
369 ENDIF
370c-----------
371 ELSEIF(ifunc>=4938 .AND. ifunc<=4944)THEN
372 IF(gbuf%G_MOM>0 )THEN
373 IF(ifunc>=4938.AND.ifunc<=4940)THEN
374 DO i=lft,llt
375 n = i + nft
376 IF(el2fa(nn1+n)/=0)THEN
377 func(el2fa(nn1+n)) = gbuf%MOM( ii((ifunc-4937) + i ) )
378 ENDIF
379 ENDDO
380 ELSEIF(ifunc==4941)THEN
381 DO i=lft,llt
382 n = i + nft
383 IF(el2fa(nn1+n)/=0)THEN
384 func(el2fa(nn1+n)) = sqrt( gbuf%MOM(ii(1) + i)+gbuf%MOM(ii(1) + i)
385 + +gbuf%MOM(ii(2) + i)+gbuf%MOM(ii(2) + i) )
386 ENDIF
387 ENDDO
388 ELSEIF(ifunc==4942)THEN
389 DO i=lft,llt
390 n = i + nft
391 IF(el2fa(nn1+n)/=0)THEN
392 func(el2fa(nn1+n)) = sqrt( gbuf%MOM(ii(2) + i)+gbuf%MOM(ii(2) + i)
393 + +gbuf%MOM(ii(3) + i)+gbuf%MOM(ii(3) + i) )
394 ENDIF
395 ENDDO
396 ELSEIF(ifunc==4943)THEN
397 DO i=lft,llt
398 n = i + nft
399 IF(el2fa(nn1+n)/=0)THEN
400 func(el2fa(nn1+n)) = sqrt( gbuf%MOM(ii(1) + i)+gbuf%MOM(ii(1) + i)
401 + +gbuf%MOM(ii(3) + i)+gbuf%MOM(ii(3) + i) )
402 ENDIF
403 ENDDO
404 ELSEIF(ifunc==4944)THEN
405 DO i=lft,llt
406 n = i + nft
407 IF(el2fa(nn1+n)/=0)THEN
408 func(el2fa(nn1+n)) = sqrt( gbuf%MOM(ii(1) + i)+gbuf%MOM(ii(1) + i)
409 + +gbuf%MOM(ii(2) + i)+gbuf%MOM(ii(2) + i)
410 + +gbuf%MOM(ii(3) + i)+gbuf%MOM(ii(3) + i) )
411 ENDIF
412 ENDDO
413 ENDIF
414 ENDIF
415c-----------
416 ELSEIF(ifunc>=4945 .AND. ifunc<=4951)THEN
417 IF(gbuf%G_MOM>0 )THEN
418 IF(ifunc>=4945.AND.ifunc<=4947)THEN
419 DO i=lft,llt
420 n = i + nft
421 IF(el2fa(nn1+n)/=0)THEN
422 func(el2fa(nn1+n)) = gbuf%MOM( ii(ifunc-4944) + i ) / gbuf%RHO(i)
423 ENDIF
424 ENDDO
425 ELSEIF(ifunc==4948)THEN
426 DO i=lft,llt
427 n = i + nft
428 IF(el2fa(nn1+n)/=0)THEN
429 func(el2fa(nn1+n)) = sqrt( gbuf%MOM(ii(1) + i)+gbuf%MOM(ii(1) + i)
430 + +gbuf%MOM(ii(2) + i)+gbuf%MOM(ii(2) + i) ) / gbuf%RHO(i)
431 ENDIF
432 ENDDO
433 ELSEIF(ifunc==4949)THEN
434 DO i=lft,llt
435 n = i + nft
436 IF(el2fa(nn1+n)/=0)THEN
437 func(el2fa(nn1+n)) = sqrt( gbuf%MOM(ii(2) + i)+gbuf%MOM(ii(2) + i)
438 + +gbuf%MOM(ii(3) + i)+gbuf%MOM(ii(3) + i) ) / gbuf%RHO(i)
439 ENDIF
440 ENDDO
441 ELSEIF(ifunc==4950)THEN
442 DO i=lft,llt
443 n = i + nft
444 IF(el2fa(nn1+n)/=0)THEN
445 func(el2fa(nn1+n)) = sqrt( gbuf%MOM(ii(1) + i)+gbuf%MOM(ii(1) + i)
446 + +gbuf%MOM(ii(3) + i)+gbuf%MOM(ii(3) + i) ) / gbuf%RHO(i)
447 ENDIF
448 ENDDO
449 ELSEIF(ifunc==4951)THEN
450 DO i=lft,llt
451 n = i + nft
452 IF(el2fa(nn1+n)/=0)THEN
453 func(el2fa(nn1+n)) = sqrt( gbuf%MOM(ii(1) + i)+gbuf%MOM(ii(1) + i)
454 + +gbuf%MOM(ii(2) + i)+gbuf%MOM(ii(2) + i)
455 + +gbuf%MOM(ii(3) + i)+gbuf%MOM(ii(3) + i) ) / gbuf%RHO(i)
456 ENDIF
457 ENDDO
458 ENDIF
459 ENDIF
460c-----------
461 !/ANIM/ELEM/FINT || FINTX || FINTY || FINXY || FINYZ || FINXZ
462 ELSEIF (ifunc>=4952 .AND. ifunc<=4958)THEN
463 ialefvm_flg = alefvm_param%IFORM
464 IF(ialefvm_flg >= 2)THEN
465 IF(ifunc>=4952 .AND. ifunc<=4954)THEN
466 DO i=lft,llt
467 n = i+nft
468 IF(el2fa(nn1+ n)/=0)THEN
469 func(el2fa(nn1+ n)) = alefvm_buffer%FINT_CELL(ifunc-4951, n)
470 ENDIF
471 ENDDO
472 ELSEIF(ifunc==4955)THEN
473 DO i=lft,llt
474 n = i+nft
475 IF(el2fa(nn1+ n)/=0)THEN
476 func(el2fa(nn1+ n)) = sqrt( alefvm_buffer%FINT_CELL(1, n)* alefvm_buffer%FINT_CELL(1, n)+
477 + alefvm_buffer%FINT_CELL(2, n)* alefvm_buffer%FINT_CELL(2, n) )
478 ENDIF
479 ENDDO
480 ELSEIF(ifunc==4956)THEN
481 DO i=lft,llt
482 n = i+nft
483 IF(el2fa(nn1+ n)/=0)THEN
484 func(el2fa(nn1+ n)) = sqrt( alefvm_buffer%FINT_CELL(2, n)* alefvm_buffer%FINT_CELL(2, n)+
485 + alefvm_buffer%FINT_CELL(3, n)* alefvm_buffer%FINT_CELL(3, n) )
486 ENDIF
487 ENDDO
488 ELSEIF(ifunc==4957)THEN
489 DO i=lft,llt
490 n = i+nft
491 IF(el2fa(nn1+ n)/=0)THEN
492 func(el2fa(nn1+ n)) = sqrt( alefvm_buffer%FINT_CELL(1, n)* alefvm_buffer%FINT_CELL(1,n)+
493 + alefvm_buffer%FINT_CELL(3, n)* alefvm_buffer%FINT_CELL(3,n) )
494 ENDIF
495 ENDDO
496 ELSEIF(ifunc==4958)THEN
497 DO i=lft,llt
498 n = i+nft
499 IF(el2fa(nn1+ n)/=0)THEN
500 func(el2fa(nn1+ n)) = sqrt( alefvm_buffer%FINT_CELL(1, n)* alefvm_buffer%FINT_CELL(1, n)+
501 + alefvm_buffer%FINT_CELL(2, n)* alefvm_buffer%FINT_CELL(2, n)+
502 + alefvm_buffer%FINT_CELL(3, n)* alefvm_buffer%FINT_CELL(3, n) )
503 ENDIF
504 ENDDO
505 ENDIF
506 ELSE
507 evar(lft:llt)=zero
508 endif!IF(IALEFVM_FLG >= 2)
509c-----------
510 ELSEIF(ifunc == 4959)THEN !/ANIM/ELEM/AMS
511 IF(gbuf%G_ISMS>0)THEN
512 DO i=lft,llt
513 n = i + nft
514 IF(el2fa(nn1+n)/=0)THEN
515 func(el2fa(nn1+n)) = gbuf%ISMS(i)
516 ENDIF
517 ENDDO
518 ENDIF
519c-----------OFF
520 ELSEIF(ifunc == 4965)THEN
521 IF (gbuf%G_OFF > 0) THEN
522 DO i=lft,llt
523 n = i + nft
524 IF(gbuf%OFF(i) > one) THEN
525 func(el2fa(nn1+n)) = gbuf%OFF(i) - one
526 ELSEIF((gbuf%OFF(i) >= zero .AND. gbuf%OFF(i) <= one)) THEN
527 func(el2fa(nn1+n)) = gbuf%OFF(i)
528 ELSE
529 func(el2fa(nn1+n)) = -one
530 ENDIF
531 ENDDO
532 ENDIF
533c-----------TILLOTSON
534 ELSEIF(ifunc == 5172)THEN !/ANIM/ELEM/TILLOTSON
535 evar(1:nel) = zero
536 n=1+nft
537 iprt=ipartsp(n)
538 mt=ipart(1,iprt)
539 ieos=ipm(4,mt)
540 IF(ieos == 3)THEN
541 ebuf => elbuf_tab(ng)%BUFLY(1)%EOS(1,1,1)
542 nvareos = elbuf_tab(ng)%BUFLY(1)%NVAR_EOS
543 DO i=1,nel
544 evar(i) = ebuf%VAR(i)
545 ENDDO
546 ENDIF
547 func(el2fa(nn1+nft+1:nn1+nft+nel)) = evar(1:nel)
548
549c-----------VOLUMETRIC STRAIN (VSTRAIN)
550 ELSEIF(ifunc == 5173)THEN !/ANIM/ELEM/VSTRAIN
551 evar(1:nel) = zero
552 iprt=ipartsp(1+nft)
553 mt=ipart(1,iprt)
554 IF(pm(89,mt) > zero)THEN
555 DO i=1,nel
556 evar(i) = gbuf%RHO(i) / pm(89,mt) - one
557 ENDDO
558 ENDIF
559 func(el2fa(nn1+nft+1:nn1+nft+nel)) = evar(1:nel)
560
561 ELSEIF(ifunc >= 5173+1 .AND. ifunc <= 5173+21)THEN !/ANIM/ELEM/VSTRAIN
562 evar(1:nel) = zero
563 func(el2fa(nn1+nft+1:nn1+nft+nel)) = evar(1:nel)
564 !submaterial modeling not compatible with sph (output 0.0 for VSTRAIN/[i])
565c-----------
566 ELSE
567 DO i=lft,llt
568 n = i + nft
569 IF(el2fa(nn1+n)/=0)THEN
570 func(el2fa(nn1+n)) = zero
571 ENDIF
572 ENDDO
573 ENDIF
574 ENDIF
575 ELSE
576 ENDIF
577C-----------------------------------------------
578C FIN DE BOUCLE SUR LES GROUPES
579C-----------------------------------------------
580 ENDDO ! next NG
581C-----------------------------------------------
582
583 IF (nspmd == 1) THEN
584 DO n=1,nbf
585 r4 = func(n)
586 CALL write_r_c(r4,1)
587 ENDDO
588 ELSE
589 DO n = 1, nbf
590 wa(n) = func(n)
591 ENDDO
592
593 IF (ispmd == 0) THEN
594 buf = numsphg
595 ELSE
596 buf=1
597 ENDIF
598
599 CALL spmd_r4get_partn(1,nbf,nbpart,iadg,wa,buf)
600 ENDIF
601c-----------
602 IF(ALLOCATED(wa_l))DEALLOCATE(wa_l)
603 IF(ALLOCATED(wa))DEALLOCATE(wa)
604 RETURN
605 END
my_real
#define my_real
Definition cppsort.cpp:32
dfunc0
subroutine dfunc0(elbuf_tab, func, ifunc, iparg, mass, pm, el2fa, nbf, nbpart, iadg, spbuf, ipart, ipartsp, ale_connectivity, ipm, x, v, w, itherm, nercvois, nesdvois, lercvois, lesdvois, bufmat, multi_fvm, kxsp, default_output, mat_param)
Definition dfunc0.F:50
max
#define max(a, b)
Definition macros.h:21
ale_connectivity_mod
Definition ale_connectivity_mod.F:223
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
initbuf_mod
Definition initbuf.F:160
schlieren_mod
Definition schlieren_mod.F:46
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
write_r_c
void write_r_c(float *w, int *len)
Definition write_routtines.c:519