OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
h3d_sph_scalar.F
Go to the documentation of this file.
1Copyright> OpenRadioss
2Copyright> Copyright (C) 1986-2025 Altair Engineering Inc.
3Copyright>
4Copyright> This program is free software: you can redistribute it and/or modify
5Copyright> it under the terms of the GNU Affero General Public License as published by
6Copyright> the Free Software Foundation, either version 3 of the License, or
7Copyright> (at your option) any later version.
8Copyright>
9Copyright> This program is distributed in the hope that it will be useful,
10Copyright> but WITHOUT ANY WARRANTY; without even the implied warranty of
11Copyright> MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12Copyright> GNU Affero General Public License for more details.
13Copyright>
14Copyright> You should have received a copy of the GNU Affero General Public License
15Copyright> along with this program. If not, see <https://www.gnu.org/licenses/>.
16Copyright>
17Copyright>
18Copyright> Commercial Alternative: Altair Radioss Software
19Copyright>
20Copyright> As an alternative to this open-source version, Altair also offers Altair Radioss
21Copyright> software under a commercial license. Contact Altair to discuss further if the
22Copyright> commercial version may interest you: https://www.altair.com/radioss/.
23!||====================================================================
24!|| h3d_sph_scalar ../engine/source/output/h3d/h3d_results/h3d_sph_scalar.F
25!||--- called by ------------------------------------------------------
26!|| genh3d ../engine/source/output/h3d/h3d_results/genh3d.F
27!||--- calls -----------------------------------------------------
28!|| h3d_write_scalar ../engine/source/output/h3d/h3d_results/h3d_write_scalar.f
29!|| initbuf ../engine/share/resol/initbuf.F
30!||--- uses -----------------------------------------------------
31!|| elbufdef_mod ../common_source/modules/mat_elem/elbufdef_mod.F90
32!|| initbuf_mod ../engine/share/resol/initbuf.F
33!|| multimat_param_mod ../common_source/modules/multimat_param_mod.F90
34!|| names_and_titles_mod ../common_source/modules/names_and_titles_mod.F
35!|| schlieren_mod ../engine/share/modules/schlieren_mod.F
36!|| stack_mod ../engine/share/modules/stack_mod.F
37!||====================================================================
38 SUBROUTINE h3d_sph_scalar(
39 . ELBUF_TAB ,SPH_SCALAR ,IFUNC ,IPARG ,
40 . KXSP ,PM ,IPART ,
41 . IPM ,
42 . ID_ELEM ,IPARTSP ,IUVAR_INPUT ,H3D_PART ,
43 . IS_WRITTEN_SPH,KEYWORD ,SPBUF ,ID )
44
45C-----------------------------------------------
46C M o d u l e s
47C-----------------------------------------------
48 USE initbuf_mod
49 USE elbufdef_mod
50 USE schlieren_mod
51 USE stack_mod
52 USE names_and_titles_mod, ONLY: ncharline100
53 USE multimat_param_mod , ONLY : m51_n0phas, m51_nvphas
54C-----------------------------------------------
55C I m p l i c i t T y p e s
56C-----------------------------------------------
57#include "implicit_f.inc"
58C-----------------------------------------------
59C C o m m o n B l o c k s
60C-----------------------------------------------
61#include "vect01_c.inc"
62#include "mvsiz_p.inc"
63#include "com01_c.inc"
64#include "com04_c.inc"
65#include "scr17_c.inc"
66#include "param_c.inc"
67#include "task_c.inc"
68#include "sphcom.inc"
69C-----------------------------------------------
70C D u m m y A r g u m e n t s
71C-----------------------------------------------
72 my_real
73 . sph_scalar(*),
74 . pm(npropm,*)
75 INTEGER IPARG(NPARG,*),KXSP(NISP,*),IFUNC,
76 . IPM(NPROPMI,*),
77 . id_elem(*),ipartsp(*),
78 . h3d_part(*),is_written_sph(*),iuvar_input,ipart(lipart1,*)
79 TYPE (ELBUF_STRUCT_), DIMENSION(NGROUP), TARGET :: ELBUF_TAB
80 CHARACTER(NCHARLINE100) :: KEYWORD
81 INTEGER, INTENT(IN) :: ID
82 my_real :: SPBUF(NSPBUF,*)
83C-----------------------------------------------
84C L o c a l V a r i a b l e s
85C-----------------------------------------------
86 my_real
87 . value(mvsiz),mass(mvsiz),pres(mvsiz)
88 my_real
89 . p,vonm2,s1,s2,s3,
90 . s11,s22,s33,s4,s5,s6,vonm,
91 . mass0,vol
92 INTEGER I,NG,NEL,NPTR,NPTS,NPTT,NLAY,
93 . ir,mlw, nuvar,ius,nfail,
94 . n,k,jturb,mt,
95 . offset,
96 . iuvar,iprt,
97 . ieos
98 INTEGER
99 . NPTG,
100 . IOK_PART(MVSIZ),JJ(6),
101 . IS_WRITTEN_VALUE(MVSIZ),IPOS,ITRIMAT,NVAREOS
102 TYPE(G_BUFEL_) ,POINTER :: GBUF
103 TYPE(l_bufel_) ,POINTER :: LBUF
104 TYPE(BUF_MAT_) ,POINTER :: MBUF
105 TYPE(BUF_EOS_) ,POINTER :: EBUF
106 my_real, DIMENSION(:), POINTER :: DFMAX
107C-----------------------------------------------
108 DO i=1,numsph
109 is_written_sph(i) = 0
110 ENDDO
111c
112 DO ng=1,ngroup
113
114 CALL initbuf(iparg ,ng ,
115 2 mlw ,nel ,nft ,iad ,ity ,
116 3 npt ,jale ,ismstr ,jeul ,jtur ,
117 4 jthe ,jlag ,jmult ,jhbe ,jivf ,
118 5 nvaux ,jpor ,jcvt ,jclose ,jplasol ,
119 6 irep ,iint ,igtyp ,israt ,isrot ,
120 7 icsen ,isorth ,isorthg ,ifailure,jsms )
121 IF (mlw /= 13) THEN
122 nft = iparg(3,ng)
123 iok_part(1:nel) = 0
124c
125 DO i=1,6
126 jj(i) = nel*(i-1)
127 ENDDO
128c
129 DO i=1,nel
130 value(i) = zero
131 is_written_value(i) = 0
132 ENDDO
133C-----------------------------------------------
134 IF (ity == 51) THEN
135c SPH ELEMENTS
136 IF (jcvt==1.AND.isorth/=0) jcvt=2
137C-----------------------------------------------
138 gbuf => elbuf_tab(ng)%GBUF
139 mbuf => elbuf_tab(ng)%BUFLY(1)%MAT(1,1,1)
140 lbuf => elbuf_tab(ng)%BUFLY(1)%LBUF(1,1,1)
141 nlay = elbuf_tab(ng)%NLAY
142 nptr = elbuf_tab(ng)%NPTR
143 npts = elbuf_tab(ng)%NPTS
144 nptt = elbuf_tab(ng)%NPTT
145 nptg = nptt*npts*nptr*nlay
146 jturb= iparg(12,ng)*(iparg(7,ng)+iparg(11,ng))
147
148 offset = 0
149c
150 DO i=1,nel
151 IF (ity == 51) THEN
152 id_elem(offset+nft+i) = kxsp(nisp,nft+i)
153 IF( h3d_part(ipartsp(nft+i)) == 1) iok_part(i) = 1
154 ENDIF
155 ENDDO
156c
157 iuvar = iuvar_input
158C-----------------------------------------------
159C Mass computation
160C-----------------------------------------------
161 IF (keyword == 'MASS') THEN
162 gbuf => elbuf_tab(ng)%GBUF
163 DO i=1,nel
164 n = i + nft
165 iprt=ipartsp(n)
166 mt =ipart(1,iprt)
167 mass(i)=pm(89,mt)*gbuf%VOL(i)
168 ENDDO
169 ENDIF
170C-----------
171 IF (mlw /= 0 .and. mlw /= 13 .and. igtyp /= 0) THEN
172 jturb=iparg(12,ng)*(iparg(7,ng)+iparg(11,ng))
173C--------------------------------------------------
174 IF (keyword == 'MASS') THEN ! MASS
175C--------------------------------------------------
176 DO i=1,nel
177 value(i) = mass(i)
178 is_written_value(i) = 1
179 ENDDO
180C--------------------------------------------------
181 ELSEIF(keyword == 'DIAMETER')THEN
182C--------------------------------------------------
183 DO i=1,nel
184 value(i) = spbuf(1,nft+i)
185 is_written_value(i) = 1
186 ENDDO
187C--------------------------------------------------
188 ELSEIF(keyword == 'EPSP')THEN
189C--------------------------------------------------
190 IF( gbuf%G_PLA > 0)THEN
191 DO i=1,nel
192 value(i) = gbuf%PLA(i)
193 is_written_value(i) = 1
194 ENDDO
195 ENDIF
196C--------------------------------------------------
197 ELSEIF(keyword == 'DENS')THEN
198C----------------------------------------------------
199 DO i=1,nel
200 value(i) = gbuf%RHO(i)
201 is_written_value(i) = 1
202 ENDDO
203C--------------------------------------------------
204 ELSEIF (keyword == 'EINTM' .OR. keyword == 'ENER')THEN
205C--------------------------------------------------
206 !LAG: GBUF%VOL = V0, GBUF%EINT=rho0.e
207 DO i=1,nel
208 n = i + nft
209 iprt=ipartsp(n)
210 mt =ipart(1,iprt)
211 value(i) = gbuf%EINT(i)/max(em20,pm(89,mt)) !
212 is_written_value(i) = 1
213 ENDDO
214C--------------------------------------------------
215 ELSEIF (keyword == 'EINTV')THEN
216C--------------------------------------------------
217 DO i=1,nel
218 n = i + nft
219 iprt=ipartsp(n)
220 mt =ipart(1,iprt)
221 value(i) = gbuf%EINT(i)/max(em20,pm(89,mt))*gbuf%RHO(i)
222 is_written_value(i) = 1
223 ENDDO
224C--------------------------------------------------
225 ELSEIF (keyword == 'EINT')THEN
226C--------------------------------------------------
227 DO i=1,nel
228 n = i + nft
229 iprt=ipartsp(n)
230 mt =ipart(1,iprt)
231 vol=gbuf%VOL(i)*pm(89,mt)/gbuf%RHO(i)
232 value(i) = gbuf%EINT(i)/pm(89,mt)*gbuf%RHO(i)*vol
233 is_written_value(i) = 1
234 ENDDO
235C--------------------------------------------------
236 ELSEIF (keyword(1:4) == 'ENTH')THEN
237C--------------------------------------------------
238 DO i=1,nel
239 pres(i) = -(gbuf%SIG(jj(1)+i)+ gbuf%SIG(jj(2)+i) + gbuf%SIG(jj(3)+i))*third
240 ENDDO
241 !GBUF%EINT is rho.e
242 IF(keyword == 'ENTH')THEN
243 DO i=1,nel
244 n = i + nft
245 iprt=ipartsp(n)
246 mt =ipart(1,iprt)
247 mass0=gbuf%VOL(i)*pm(89,mt)
248 vol=mass0/max(em20,gbuf%RHO(i))
249 value(i) = gbuf%EINT(i)/max(em20,pm(89,mt)) + pres(i)*vol !
250 is_written_value(i) = 1
251 ENDDO
252 ELSEIF(keyword == 'ENTHV')THEN
253 DO i=1,nel
254 n = i + nft
255 iprt=ipartsp(n)
256 mt =ipart(1,iprt)
257 mass0=gbuf%VOL(i)*pm(89,mt)
258 vol=mass0/max(em20,gbuf%RHO(i))
259 value(i) = gbuf%EINT(i)/max(em20,pm(89,mt))/vol + pres(i) !
260 is_written_value(i) = 1
261 ENDDO
262 ELSEIF(keyword == 'enthm')THEN
263 DO I=1,NEL
264 N = I + NFT
265 IPRT=IPARTSP(N)
266 MT =IPART(1,IPRT)
267 MASS0=GBUF%VOL(I)*PM(89,MT)
268 VOL=MASS0/MAX(EM20,GBUF%RHO(I))
269 MASS(I)=MASS0
270 VALUE(I) = (GBUF%EINT(I)/MAX(EM20,PM(89,MT)) + PRES(I)*VOL)/MASS(I) !
271 IS_WRITTEN_VALUE(I) = 1
272 ENDDO
273 ENDIF
274C--------------------------------------------------
275 ELSEIF(KEYWORD == 'temp')THEN
276C--------------------------------------------------
277 DO I=1,NEL
278 IF (GBUF%G_TEMP > 0) THEN
279 VALUE(I) = GBUF%TEMP(I)
280 IS_WRITTEN_VALUE(I) = 1
281 ENDIF
282 ENDDO
283C--------------------------------------------------
284 ELSEIF(KEYWORD == 'p')THEN
285C--------------------------------------------------
286 DO I=1,NEL
287 S11 = GBUF%SIG(JJ(1) + I)
288 S22 = GBUF%SIG(JJ(2) + I)
289 S33 = GBUF%SIG(JJ(3) + I)
290 S4 = GBUF%SIG(JJ(4) + I)
291 S5 = GBUF%SIG(JJ(5) + I)
292 S6 = GBUF%SIG(JJ(6) + I)
293 P = - (S11 + S22 + S33 ) * THIRD
294 VALUE(I) = P
295 IS_WRITTEN_VALUE(I) = 1
296 ENDDO
297C--------------------------------------------------
298 ELSEIF(KEYWORD == 'vonm')THEN
299C--------------------------------------------------
300 DO I=1,NEL
301 S11 = GBUF%SIG(JJ(1) + I)
302 S22 = GBUF%SIG(JJ(2) + I)
303 S33 = GBUF%SIG(JJ(3) + I)
304 S4 = GBUF%SIG(JJ(4) + I)
305 S5 = GBUF%SIG(JJ(5) + I)
306 S6 = GBUF%SIG(JJ(6) + I)
307 P = - (S11 + S22 + S33 ) * THIRD
308 VALUE(I) = P
309 S1=S11 + P
310 S2=S22 + P
311 S3=S33 + P
312 VONM2= THREE*(S4*S4 + S5*S5 + S6*S6 +
313 . HALF*(S1*S1+S2*S2+S3*S3) )
314 VONM= SQRT(VONM2)
315 VALUE(I) = VONM
316 IS_WRITTEN_VALUE(I) = 1
317 ENDDO
318C--------------------------------------------------
319 ELSEIF(KEYWORD == 'k.AND.' JTURB/=0)THEN
320C--------------------------------------------------
321C ENERGIE TURBULENTE
322 DO I=1,NEL
323 VALUE(I) = GBUF%RK(I)
324 IS_WRITTEN_VALUE(I) = 1
325 ENDDO
326C--------------------------------------------------
327 ELSEIF(KEYWORD == 'tvis')THEN
328C--------------------------------------------------
329C VISCOSITE TURBULENTE
330 DO I=1,NEL
331.OR..AND. IF((MLW == 6 MLW == 17)JTURB/=0)THEN
332 IPRT=IPARTSP(N)
333 MT =IPART(1,IPRT)
334 VALUE(I)=PM(81,MT)*GBUF%RK(I)**2/
335 . MAX(EM15,GBUF%RE(I))
336 IS_WRITTEN_VALUE(I) = 1
337.OR. ELSEIF(MLW == 46 MLW == 47)THEN
338 VALUE(I) = MBUF%VAR(I)
339 IS_WRITTEN_VALUE(I) = 1
340 ENDIF
341 ENDDO
342C--------------------------------------------------
343 ELSEIF(KEYWORD == 'vortx')THEN
344C--------------------------------------------------
345C VORTICITE
346 DO I=1,NEL
347.OR. IF(MLW == 6 MLW == 17)THEN
348 VALUE(I) = LBUF%VK(I)
349 IS_WRITTEN_VALUE(I) = 1
350.OR. ELSEIF(MLW == 46 MLW == 47)THEN
351 VALUE(I) = MBUF%VAR(NEL+I)
352 IS_WRITTEN_VALUE(I) = 1
353 ENDIF
354 ENDDO
355C--------------------------------------------------
356 ELSEIF(KEYWORD == 'dam1.AND.' MLW == 24)THEN
357C--------------------------------------------------
358 DO I=1,NEL
359 VALUE(I) = LBUF%DAM(JJ(1) + I)
360 IS_WRITTEN_VALUE(I) = 1
361 ENDDO
362C--------------------------------------------------
363 ELSEIF(KEYWORD == 'dam2.AND.' MLW == 24)THEN
364C--------------------------------------------------
365 DO I=1,NEL
366 VALUE(I) = LBUF%DAM(JJ(2) + I)
367 IS_WRITTEN_VALUE(I) = 1
368 ENDDO
369C--------------------------------------------------
370 ELSEIF(KEYWORD == 'dam3.AND.' MLW == 24)THEN
371C--------------------------------------------------
372 DO I=1,NEL
373 N = I + NFT
374 VALUE(I) = LBUF%DAM(JJ(3) + I)
375 IS_WRITTEN_VALUE(I) = 1
376 ENDDO
377C--------------------------------------------------
378 ELSEIF(KEYWORD == 'sigx')THEN
379C--------------------------------------------------
380 DO I=1,NEL
381 VALUE(I) = GBUF%SIG(JJ(1) + I)
382 IS_WRITTEN_VALUE(I) = 1
383 ENDDO
384C--------------------------------------------------
385 ELSEIF(KEYWORD == 'sigy')THEN
386C--------------------------------------------------
387 DO I=1,NEL
388 VALUE(I) = GBUF%SIG(JJ(2) + I)
389 IS_WRITTEN_VALUE(I) = 1
390 ENDDO
391C--------------------------------------------------
392 ELSEIF(KEYWORD == 'sigz')THEN
393C--------------------------------------------------
394 DO I=1,NEL
395 VALUE(I) = GBUF%SIG(JJ(3) + I)
396 IS_WRITTEN_VALUE(I) = 1
397 ENDDO
398C--------------------------------------------------
399 ELSEIF(KEYWORD == 'sigxy')THEN
400C--------------------------------------------------
401 DO I=1,NEL
402 VALUE(I) = GBUF%SIG(JJ(4) + I)
403 IS_WRITTEN_VALUE(I) = 1
404 ENDDO
405C--------------------------------------------------
406 ELSEIF(KEYWORD == 'sigyz')THEN
407C--------------------------------------------------
408 DO I=1,NEL
409 VALUE(I) = GBUF%SIG(JJ(5) + I)
410 IS_WRITTEN_VALUE(I) = 1
411 ENDDO
412C--------------------------------------------------
413 ELSEIF(KEYWORD == 'sigzx')THEN
414C--------------------------------------------------
415 DO I=1,NEL
416 VALUE(I) = GBUF%SIG(JJ(6) + I)
417 IS_WRITTEN_VALUE(I) = 1
418 ENDDO
419C--------------------------------------------------
420 ELSEIF(KEYWORD == 'user')THEN
421C--------------------------------------------------
422 IUS = IFUNC - 20
423 NUVAR = IPM(8,MT)
424 IF (NUVAR > 0) THEN
425 DO I=1,NEL
426 IF(IUS <= NUVAR)THEN
427 VALUE(I) = MBUF%VAR(I + IUS*NEL)
428 IS_WRITTEN_VALUE(I) = 1
429 ENDIF
430 ENDDO
431 ENDIF
432C--------------------------------------------------
433 ELSEIF(KEYWORD == 'hourglass')THEN
434C--------------------------------------------------
435c
436C--------------------------------------------------
437 ELSEIF(KEYWORD == 'bfrac')THEN
438C--------------------------------------------------
439 DO I=1,NEL
440 VALUE = ZERO
441 IF (MLW == 5)THEN
442 VALUE(I) = GBUF%BFRAC(I)
443 IS_WRITTEN_VALUE(I) = 1
444 ENDIF
445 ENDDO
446C--------------------------------------------------
447 ELSEIF(KEYWORD == 'dama') THEN
448C--------------------------------------------------
449 DO I = 1,NEL
450 VALUE(I) = ZERO
451 ENDDO
452 NFAIL = ELBUF_TAB(NG)%BUFLY(1)%NFAIL
453 DO IR=1,NFAIL
454 DFMAX=>
455 . ELBUF_TAB(NG)%BUFLY(1)%FAIL(1,1,1)%FLOC(IR)%DAMMX
456 DO I=1,NEL
457 VALUE(I) = MAX(DFMAX(I),VALUE(I))
458 IS_WRITTEN_VALUE(I) = 1
459 ENDDO
460 ENDDO
461C--------------------------------------------------
462 ELSEIF(KEYWORD == 'failure') THEN
463C--------------------------------------------------
464 DO I = 1,NEL
465 VALUE(I) = ZERO
466 ENDDO
467 NFAIL = ELBUF_TAB(NG)%BUFLY(1)%NFAIL
468 DO IR=1,NFAIL
469 IF (ELBUF_TAB(NG)%BUFLY(1)%FAIL(1,1,1)%FLOC(IR)%IDFAIL == ID) THEN
470 DFMAX=>
471 . ELBUF_TAB(NG)%BUFLY(1)%FAIL(1,1,1)%FLOC(IR)%DAMMX
472 DO I=1,NEL
473 VALUE(I) = DFMAX(I)
474 IS_WRITTEN_VALUE(I) = 1
475 ENDDO
476 ENDIF
477 ENDDO
478C--------------------------------------------------
479 ELSEIF(KEYWORD == 'domain')THEN
480C--------------------------------------------------
481 DO I=1,NEL
482 VALUE(I) = ISPMD
483 IS_WRITTEN_VALUE(I) = 1
484 ENDDO
485C--------------------------------------------------
486 ELSEIF(KEYWORD == 'fill')THEN
487C--------------------------------------------------
488 DO I=1,NEL
489 VALUE(I) = GBUF%FILL(I)
490 IS_WRITTEN_VALUE(I) = 1
491 ENDDO
492C--------------------------------------------------
493 ELSEIF (KEYWORD == 'sigeq') THEN
494C--------------------------------------------------
495 IF (GBUF%G_SEQ > 0) THEN ! non VON MISES
496 DO I=1,NEL
497 VALUE(I) = GBUF%SEQ(I)
498 IS_WRITTEN_VALUE(I) = 1
499 ENDDO
500 ELSE ! VON MISES
501 DO I=1,NEL
502 P = -(GBUF%SIG(JJ(1) + I)
503 . + GBUF%SIG(JJ(2) + I)
504 . + GBUF%SIG(JJ(3) + I)) * THIRD
505 S1=GBUF%SIG(JJ(1) + I) + P
506 S2=GBUF%SIG(JJ(2) + I) + P
507 S3=GBUF%SIG(JJ(3) + I) + P
508 VONM2= THREE*(GBUF%SIG(JJ(4) + I)**2 +
509 . GBUF%SIG(JJ(5) + I)**2 +
510 . GBUF%SIG(JJ(6) + I)**2 +
511 . HALF*(S1*S1+S2*S2+S3*S3))
512 VONM= SQRT(VONM2)
513 VALUE(I) = VONM
514 IS_WRITTEN_VALUE(I) = 1
515 ENDDO
516 ENDIF
517C--------------------------------------------------
518 ELSEIF (KEYWORD == 'tdet') THEN ! /H3D/ELEM/TDET
519C--------------------------------------------------
520.AND. IF (MLW /= 51 GBUF%G_TB > 0) THEN
521 DO I=1,NEL
522 VALUE(I) = -GBUF%TB(I)
523 IS_WRITTEN_VALUE(I) = 1
524 ENDDO
525 ELSEIF (MLW == 51)THEN
526 IPOS = 15
527 ITRIMAT = 4
528 K = IPARG(2,NG) * ((M51_N0PHAS + (ITRIMAT-1)*M51_NVPHAS )+IPOS-1)
529 DO I=1,IPARG(2,NG)
530 VALUE(I) = -MBUF%VAR(K+I)
531 IS_WRITTEN_VALUE(I) = 1
532 ENDDO
533 ENDIF
534C--------------------------------------------------
535 ELSEIF(KEYWORD == 'group')THEN
536C--------------------------------------------------
537 DO I=1,NEL
538 VALUE(I) = NG
539 IS_WRITTEN_VALUE(I) = 1
540 ENDDO
541C--------------------------------------------------
542 ELSEIF(KEYWORD == 'internal.id')THEN
543C--------------------------------------------------
544 DO I=1,NEL
545 VALUE(I) = I+NFT
546 IS_WRITTEN_VALUE(I) = 1
547 ENDDO
548C--------------------------------------------------
549 ELSEIF(KEYWORD == 'local.id')THEN
550C--------------------------------------------------
551 DO I=1,NEL
552 VALUE(I) = I
553 IS_WRITTEN_VALUE(I) = 1
554 ENDDO
555C--------------------------------------------------
556 ELSEIF(KEYWORD == 'off')THEN
557C--------------------------------------------------
558 DO I=1,NEL
559 IF (GBUF%G_OFF > 0) THEN
560 IF(GBUF%OFF(I) > ONE) THEN
561 VALUE(I) = GBUF%OFF(I) - ONE
562.AND. ELSEIF((GBUF%OFF(I) >= ZERO GBUF%OFF(I) <= ONE)) THEN
563 VALUE(I) = GBUF%OFF(I)
564 ELSE
565 VALUE(I) = -ONE
566 ENDIF
567 ENDIF
568 IS_WRITTEN_VALUE(I) = 1
569 ENDDO
570C--------------------------------------------------
571 ELSEIF(KEYWORD == 'tillotson') THEN
572C--------------------------------------------------
573 N = I + NFT
574 IPRT=IPARTSP(N)
575 MT =IPART(1,IPRT)
576 IEOS = IPM(4,MT)
577 IF(IEOS == 3)THEN
578 EBUF => ELBUF_TAB(NG)%BUFLY(1)%EOS(1,1,1)
579 NVAREOS = ELBUF_TAB(NG)%BUFLY(1)%NVAR_EOS
580 DO I=1,NEL
581 VALUE(I) = EBUF%VAR(I)
582 IS_WRITTEN_VALUE(I) = 1
583 ENDDO
584 ENDIF
585C--------------------------------------------------
586 ELSEIF(KEYWORD == 'neighbours')THEN
587C--------------------------------------------------
588 DO I=1,NEL
589 VALUE(I) = KXSP(4,NFT+I)
590 IS_WRITTEN_VALUE(I) = 1
591 ENDDO
592!--------------------------------------------------
593 ELSEIF(KEYWORD == 'vstrain') then
594!--------------------------------------------------
595 DO I=1,NEL
596 IPRT = IPARTSP(N)
597 MT = IPART(1,IPRT)
598 IF(PM(89,MT) > ZERO)THEN
599 VALUE(I) = GBUF%RHO(I) / PM(89,MT) - ONE
600 IS_WRITTEN_VALUE(I) = 1
601 END IF
602 ENDDO
603C--------------------------------------------------
604 ENDIF ! IFUNC
605C--------------------------------------------------
606 CALL H3D_WRITE_SCALAR(IOK_PART,IS_WRITTEN_SPH,SPH_SCALAR,NEL,OFFSET,NFT,VALUE,IS_WRITTEN_VALUE)
607 ENDIF
608 ENDIF
609 ENDIF
610
611 ENDDO ! NG
612C-----------------------------------------------
613 RETURN
614 END
my_real
#define my_real
Definition cppsort.cpp:32
h3d_sph_scalar
subroutine h3d_sph_scalar(elbuf_tab, sph_scalar, ifunc, iparg, kxsp, pm, ipart, ipm, id_elem, ipartsp, iuvar_input, h3d_part, is_written_sph, keyword, spbuf, id)
Definition h3d_sph_scalar.F:44
h3d_write_scalar
subroutine h3d_write_scalar(iok_part, is_written, scalar, nel, offset, nft, value, is_written_value)
Definition h3d_write_scalar.F:35
max
#define max(a, b)
Definition macros.h:21
initbuf_mod
Definition initbuf.F:160
initbuf_mod::initbuf
subroutine initbuf(iparg, ng, mtn, llt, nft, iad, ity, npt, jale, ismstr, jeul, jtur, jthe, jlag, jmult, jhbe, jivf, mid, jpor, jcvt, jclose, jpla, irep, iint, igtyp, israt, isrot, icsen, isorth, isorthg, ifailure, jsms)
Definition initbuf.F:261
names_and_titles_mod
Definition names_and_titles_mod.F:997
names_and_titles_mod::ncharline100
integer, parameter ncharline100
Definition names_and_titles_mod.F:1002
schlieren_mod
Definition schlieren_mod.F:46
stack_mod
Definition stack_mod.F:72
tillotson
subroutine tillotson(iflag, nel, pm, off, eint, mu, mu2, espe, dvol, df, vnew, mat, psh, pnew, dpdm, dpde, vareos, nvareos)
Definition tillotson.F:32