35
36
37
39 USE elbufdef_mod
40
41
42
43#include "implicit_f.inc"
44
45
46
47#include "vect01_c.inc"
48#include "com01_c.inc"
49#include "com08_c.inc"
50#include "sphcom.inc"
51#include "param_c.inc"
52
53
54
55 INTEGER IPARTSP(*), IPARG(NPARG,*), KXSP(NISP,*), WASPACT(*)
56 my_real spbuf(nspbuf,*) , partsav(npsav,*)
57 TYPE (ELBUF_STRUCT_), TARGET, DIMENSION(NGROUP) :: ELBUF_TAB
58
59
60
61 INTEGER N,IPRT, NG, NEL, NS
63 . volo,dt05
64 TYPE() ,POINTER :: GBUF
65
66 dt05=half*dt2
67 DO ns=1,nsphact
68 n=waspact(ns)
69 IF (kxsp(2,n)>0)THEN
70
71 spbuf(10,n)=spbuf(10,n)+dt05*spbuf(11,n)
72
73
74
75 ng=mod(kxsp(2,n),ngroup+1)
76 gbuf => elbuf_tab(ng)%GBUF
78 2 mtn ,nel ,nft ,iad ,ity ,
79 3 npt ,jale ,ismstr ,jeul ,jtur ,
80 4 jthe ,jlag ,jmult ,jhbe ,jivf ,
81 5 nvaux ,jpor ,jcvt ,jclose ,jplasol ,
82 6 irep ,iint ,igtyp ,israt ,isrot ,
83 7 icsen ,isorth ,isorthg ,ifailure,jsms )
84
85 volo=gbuf%VOL(n-nft)
86 gbuf%EINT(n-nft) = gbuf%EINT(n-nft)
87 . - dt12*spbuf(11,n)/
max(em20,volo)
88 iprt=ipartsp(n)
89 partsav(1,iprt)=partsav(1,iprt)-dt12*spbuf(11,n)
90 END IF
91 ENDDO
92
93 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)