37
38
39
40 USE elbufdef_mod
41 USE my_alloc_mod
42
43
44
45#include "implicit_f.inc"
46
47
48
49#include "com01_c.inc"
50#include "com04_c.inc"
51#include "param_c.inc"
52#include "task_c.inc"
53#include "spmd_c.inc"
54
55
56
57 INTEGER IPARG(NPARG,*),EL2FA(*),NBF,IOFF(*),
58 . IADD(*),NBPART, IADG(NSPMD,*),IOFFX1(*),
59 . NANIM1D_L
60
61 TYPE (ELBUF_STRUCT_), TARGET, DIMENSION(NGROUP) :: ELBUF_TAB
62
63
64
65 INTEGER I,NG,NEL,NFT,ITY,LFT,LLT,N,J,MLW,
66 . NN, K1, K2,MT, IMID,N1,N2,N3,N4,N_FA,
67 . NN1,NN2,NN3,NN4,NN5,NN6,NN7,NN8,NN9,,NBF2,RBUF
68 INTEGER,DIMENSION(:),ALLOCATABLE :: IOFFF
69
70 TYPE(G_BUFEL_) ,POINTER :: GBUF
71
72 CALL my_alloc(iofff,nbf+nanim1d_l)
73 nn1 = 1
74 nn2 = 1
75 nn3 = 1
76 nn4 = nn3
77 nn5 = nn4
78 nn6 = nn5
79 nn7 = nn6 + numelt
80 nn8 = nn7 + numelp
81 nn9 = nn8 + numelr
82 nn10= nn9
83
84 DO ng=1,ngroup
85 mlw =iparg(1,ng)
86 nel =iparg(2,ng)
87 ity =iparg(5,ng)
88 nft =iparg(3,ng)
89 lft=1
90 llt=nel
91
92 gbuf => elbuf_tab(ng)%GBUF
93
94
95
96 IF (ity == 4) THEN
97 n_fa = nn6 + nft
98
99
100
101 ELSEIF (ity == 5) THEN
102 n_fa = nn7 + nft
103
104
105
106 ELSEIF (ity == 6) THEN
107 n_fa = nn8 + nft
108 ELSE
109 ity=0
110 ENDIF
111
112 IF (ity /= 0) THEN
113 IF (mlw == 0 .OR. mlw == 13) THEN
114
115
116
117 IF (ity == 4 .OR. ity == 5) THEN
118 DO i=lft,llt
119 ioff(el2fa(n_fa+i)) = 1
120 ENDDO
121 ELSE
122 DO i=lft,llt
123 ioff(el2fa(n_fa+i)) = 0
124 ENDDO
125 END IF
126
127 ELSEIF (ity == 4 .OR. ity == 5) THEN
128 DO i=lft,llt
129 ioff(el2fa(n_fa+i)) = nint(
min(gbuf%OFF(i),one))
130 ENDDO
131
132 ELSEIF (ity == 6 .AND. mlw == 3) THEN
133
134
135
136 DO i=lft,llt
137 ioff(el2fa(n_fa+i)) = nint(
min(gbuf%OFF(i),one))
138 ioff(el2fa(n_fa+i)+1) = nint(
min(gbuf%OFF(i),one))
139 ENDDO
140
141 ELSEIF (ity == 1 .or. ity == 2 .or. ity == 51 .or.
142 . ity == 3 .or. ity == 7 .or. ity == 6) THEN
143 DO i=lft,llt
144 ioff(el2fa(n_fa+i)) = nint(
min(gbuf%OFF(i),one))
145 ENDDO
146 ENDIF
147 ENDIF
148
149 ENDDO
150
151 IF (nspmd == 1) THEN
154 ELSE
155 DO i = 1, nbf
156 iofff(i) = ioff(i)
157 ENDDO
158 DO i=1,nanim1d_l
159 iofff(i+nbf)=ioffx1(i)
160 ENDDO
161 nbf2 = nbf + nanim1d_l
162 IF (ispmd == 0) THEN
163 rbuf = nb1dg+nanim1d
164 ELSE
165 rbuf = 1
166 ENDIF
168 ENDIF
169
170 DEALLOCATE(iofff)
171 RETURN
subroutine spmd_iget_partn(size, nbf_l, np, nbpart, iadg, srbuf, iflag)
void write_c_c(int *w, int *len)