44
45
46
47
49 USE elbufdef_mod
53 USE multimat_param_mod , ONLY : m51_n0phas, m51_nvphas
54
55
56
57#include "implicit_f.inc"
58
59
60
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"
69
70
71
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
83
84
85
87 . value(mvsiz),mass(mvsiz),pres(mvsiz)
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,,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
107
108 DO i=1,numsph
109 is_written_sph(i) = 0
110 ENDDO
111
112 DO ng=1,ngroup
113
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
124
125 DO i=1,6
126 jj(i) = nel*(i-1)
127 ENDDO
128
129 DO i=1,nel
130 value(i) = zero
131 is_written_value(i) = 0
132 ENDDO
133
134 IF (ity == 51) THEN
135
136 IF (jcvt==1.AND.isorth/=0) jcvt=2
137
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
149
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
156
157 iuvar = iuvar_input
158
159
160
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
170
171 IF (mlw /= 0 .and. mlw /= 13 .and. igtyp /= 0) THEN
172 jturb=iparg(12,ng)*(iparg(7,ng)+iparg(11,ng))
173
174 IF (keyword == 'MASS') THEN
175
176 DO i=1,nel
177 value(i) = mass(i)
178 is_written_value(i) = 1
179 ENDDO
180
181 ELSEIF(keyword == 'DIAMETER')THEN
182
183 DO i=1,nel
184 value(i) = spbuf(1,nft+i)
185 is_written_value(i) = 1
186 ENDDO
187
188 ELSEIF(keyword == 'EPSP')THEN
189
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
196
197 ELSEIF(keyword == 'DENS')THEN
198
199 DO i=1,nel
200 value(i) = gbuf%RHO(i)
201 is_written_value(i) = 1
202 ENDDO
203
204 ELSEIF (keyword == 'EINTM' .OR. keyword == 'ENER')THEN
205
206
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
214
215 ELSEIF (keyword == 'EINTV')THEN
216
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
224
225 ELSEIF (keyword == 'EINT')THEN
226
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
235
236 ELSEIF (keyword(1:4) == 'ENTH')THEN
237
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
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
274
275 ELSEIF(keyword == 'TEMP')THEN
276
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
283
284 ELSEIF(keyword == 'P')THEN
285
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
297
298 ELSEIF(keyword == 'VONM')THEN
299
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
318
319 ELSEIF(keyword == 'K' .AND.jturb/=0)THEN
320
321
322 DO i=1,nel
323 value(i) = gbuf%RK(i)
324 is_written_value(i) = 1
325 ENDDO
326
327 ELSEIF(keyword == 'TVIS')THEN
328
329
330 DO i=1,nel
331 IF((mlw == 6 .OR. mlw == 17).AND.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 ELSEIF(mlw == 46 .OR. mlw == 47)THEN
338 value(i) = mbuf%VAR(i)
339 is_written_value(i) = 1
340 ENDIF
341 ENDDO
342
343 ELSEIF(keyword == 'VORTX')THEN
344
345
346 DO i=1,nel
347 IF(mlw == 6 .OR. mlw == 17)THEN
348 value(i) = lbuf%VK(i)
349 is_written_value(i) = 1
350 ELSEIF(mlw == 46 .OR. mlw == 47)THEN
351 value(i) = mbuf%VAR(nel+i)
352 is_written_value(i) = 1
353 ENDIF
354 ENDDO
355
356 ELSEIF(keyword == 'DAM1' .AND.mlw == 24)THEN
357
358 DO i=1,nel
359 value(i) = lbuf%DAM(jj(1) + i)
360 is_written_value(i) = 1
361 ENDDO
362
363 ELSEIF(keyword == 'DAM2' .AND.mlw == 24)THEN
364
365 DO i=1,nel
366 value(i) = lbuf%DAM(jj(2) + i)
367 is_written_value(i) = 1
368 ENDDO
369
370 ELSEIF(keyword == 'DAM3' .AND.mlw == 24)THEN
371
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
377
378 ELSEIF(keyword == 'SIGX')THEN
379
380 DO i=1,nel
381 value(i) = gbuf%SIG(jj(1) + i)
382 is_written_value(i) = 1
383 ENDDO
384
385 ELSEIF(keyword == 'SIGY')THEN
386
387 DO i=1,nel
388 value(i) = gbuf%SIG(jj(2) + i)
389 is_written_value(i) = 1
390 ENDDO
391
392 ELSEIF(keyword'SIGZ'THEN
393
394 DO i=1,nel
395 value(i) = gbuf%SIG(jj(3) + i)
396 is_written_value(i) = 1
397 ENDDO
398
399 ELSEIF(keyword == 'SIGXY')THEN
400
401 DO i=1,nel
402 value(i) = gbuf%SIG(jj(4) + i)
403 is_written_value(i) = 1
404 ENDDO
405
406 ELSEIF(keyword == 'SIGYZ')THEN
407
408 DO i=1,nel
409 value(i) = gbuf%SIG(jj(5) + i)
410 is_written_value(i) = 1
411 ENDDO
412
413 ELSEIF(keyword == 'sigzx')THEN
414
415 DO I=1,NEL
416 VALUE(I) = GBUF%SIG(JJ(6) + I)
417 IS_WRITTEN_VALUE(I) = 1
418 ENDDO
419
420 ELSEIF(KEYWORD == 'user')THEN
421
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
432
433 ELSEIF(KEYWORD == 'hourglass')THEN
434
435
436
437 ELSEIF(KEYWORD == 'bfrac')THEN
438
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
446
447 ELSEIF(KEYWORD == 'dama') THEN
448
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
461
462 ELSEIF(KEYWORD == 'failure') THEN
463
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
478
479 ELSEIF(KEYWORD == 'domain')THEN
480
481 DO I=1,NEL
482 VALUE(I) = ISPMD
483 IS_WRITTEN_VALUE(I) = 1
484 ENDDO
485
486 ELSEIF(KEYWORD == 'fill')THEN
487
488 DO I=1,NEL
489 VALUE(I) = GBUF%FILL(I)
490 IS_WRITTEN_VALUE(I) = 1
491 ENDDO
492
493 ELSEIF (KEYWORD == 'sigeq') THEN
494
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
517
518 ELSEIF (KEYWORD == 'tdet') THEN ! /H3D/ELEM/TDET
519
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
534
535 ELSEIF(KEYWORD == 'group')THEN
536
537 DO I=1,NEL
538 VALUE(I) = NG
539 IS_WRITTEN_VALUE(I) = 1
540 ENDDO
541
542 ELSEIF(KEYWORD == 'internal.
id')THEN
543
544 DO I=1,NEL
545 VALUE(I) = I+NFT
546 IS_WRITTEN_VALUE(I) = 1
547 ENDDO
548
549 ELSEIF(KEYWORD == 'local.
id')THEN
550
551 DO I=1,NEL
552 VALUE(I) = I
553 IS_WRITTEN_VALUE(I) = 1
554 ENDDO
555
556 ELSEIF(KEYWORD == 'off')THEN
557
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
570
572
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
585
586 ELSEIF(KEYWORD == 'neighbours')THEN
587
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
603
604 ENDIF ! IFUNC
605
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
612
613 RETURN
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)
integer, parameter ncharline100
subroutine tillotson(iflag, nel, pm, off, eint, mu, mu2, espe, dvol, df, vnew, mat, psh, pnew, dpdm, dpde, vareos, nvareos)