32
33
34
35 USE elbufdef_mod
36
37
38
39#include "implicit_f.inc"
40
41
42
43#include "com01_c.inc"
44#include "sphcom.inc"
45#include "param_c.inc"
46
47
48
49 INTEGER IPARG(NPARG,*),EL2FA(*),NBF,IOFF(*),SIOFF,SPH2SOL(*)
50 TYPE (ELBUF_STRUCT_), DIMENSION(NGROUP), TARGET :: ELBUF_TAB
51
52
53
54
55 INTEGER I, NG, NEL, NFT, ITY, LFT,
56 . , NN1, LLT, MLW, IOFFBUF(NBF),RBUF,IOFF_LOC(SIOFF)
57 TYPE(G_BUFEL_) ,POINTER :: GBUF
58
59 nn1 = 1
60
61 DO 490 ng=1,ngroup
62 mlw =iparg(1,ng)
63 nel =iparg(2,ng)
64 ity =iparg(5,ng)
65 nft =iparg(3,ng)
66 lft=1
67 llt=nel
68
69 IF(ity==51)THEN
70
71
72
73 IF(mlw==0)THEN
74 DO i=lft,llt
75 n = nft + i
76 ioff(el2fa(nn1+n)) = 0
77 ENDDO
78 ELSEIF (nsphsol/=0) THEN
79
80 gbuf => elbuf_tab(ng)%GBUF
81 DO i=lft,llt
82 n = nft + i
83 ioff(el2fa(nn1+n)) = nint(
min(gbuf%OFF(i),one))
84 IF (sph2sol(n)==0) THEN
85 ioff_loc(el2fa(nn1+n)) = ioff(el2fa(nn1+n))
86 ELSE
87 ioff_loc(el2fa(nn1+n)) = 0
88 ENDIF
89 ENDDO
90 ELSE
91 gbuf => elbuf_tab(ng)%GBUF
92 DO i=lft,llt
93 n = nft + i
94 ioff(el2fa(nn1+n)) = nint(
min(gbuf%OFF(i),one))
95 ioff_loc(el2fa(nn1+n)) = nint(
min(gbuf%OFF(i),one))
96 ENDDO
97 ENDIF
98 ELSE
99 ENDIF
100
101 490 CONTINUE
102
104
105 RETURN
void write_c_c(int *w, int *len)