49
50
51
52 USE elbufdef_mod
57 use element_mod , only : nixr
58
59
60
61#include "implicit_f.inc"
62
63
64
65#include "com01_c.inc"
66#include "com04_c.inc"
67#include "param_c.inc"
68#include "task_c.inc"
69#include "tabsiz_c.inc"
70
71
72
73 INTEGER, INTENT(IN) :: SITHBUF
74 INTEGER NTHGRP2
75 INTEGER IPARG(NPARG,*),IGEO(NPROPGI,*),
76 . ITHGRP(NITHGR,*),ITHBUF(SITHBUF),IXR(NIXR,*),WEIGHT(NUMNOD)
77 INTEGER, INTENT(in) :: ID
78
79 TYPE (ELBUF_STRUCT_), DIMENSION(NGROUP) :: ELBUF_TAB
80
81
82
83 INTEGER I,J,N,
84 . ELTYPE
85 INTEGER :: MY_SIZE,TOTAL_INDEX_WA_SIZE,IJK
86 INTEGER, DIMENSION(NTHGRP2+1) :: LOCAL_WA
87 INTEGER, DIMENSION(:), ALLOCATABLE :: INDEX_WA_ELTYPE_P0,INDEX_WA_SIZE_P0
88 INTEGER, DIMENSION(:), ALLOCATABLE :: WA_INDEX_DIPLS
89 TYPE(TH_COMM), DIMENSION(:), POINTER :: WA_COMM
90 INTEGER, DIMENSION(:), POINTER :: WA_SIZE,
91 TYPE(TH_PROC_TYPE), DIMENSION(:), POINTER :: ELTYPE_STRUCT
92 TYPE(TH_WA_REAL), DIMENSION(:), POINTER :: WA_P0,WA
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113! proc= 2 | a3 | a4 | b3 | c1 |
114
115! n= 2 3
116
117! / \ / \
118
119
120
121
122
123
124
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
155 ALLOCATE( index_wa_size_p0(nspmd) )
156 ALLOCATE( wa_index_dipls(nspmd) )
157
158 DO eltype=1,9
159
160
161
162
163
164
165
166
167
168 IF(eltype==1) THEN
175 ELSEIF(eltype==2) THEN
182 ELSEIF(eltype==3) THEN
189 ELSEIF(eltype==4) THEN
196 ELSEIF(eltype==5) THEN
203 ELSEIF(eltype==6) THEN
210 ELSEIF(eltype==7) THEN
217 ELSEIF(eltype==8) THEN
224 ELSEIF(eltype==9) THEN
231 ENDIF
232
233 ALLOCATE( wa_comm(
id)%TH_SIZE(nspmd) )
234 ALLOCATE( wa_comm(
id)%TH_DIPLS(nspmd) )
235
236 wa_comm(
id)%TH_SIZE(1:nspmd) = 0
238 index_wa_size_p0(1:nspmd) = 0
239 wa_index_dipls(1:nspmd) = 0
240
241
242 IF(eltype==1) THEN
245 ELSEIF(eltype==2) THEN
247 . weight,sithbuf)
248 ELSEIF(eltype==3) THEN
250 . iparg,ithbuf,sithbuf )
251 ELSEIF(eltype==4) THEN
253 . iparg,ithbuf,sithbuf )
254 ELSEIF(eltype==5) THEN
256 . iparg,ithbuf,sithbuf )
257 ELSEIF(eltype==6) THEN
259 . iparg ,ithbuf,sithbuf)
260 ELSEIF(eltype==7) THEN
262 . iparg , ithbuf,sithbuf )
263 ELSEIF(eltype==8) THEN
265 . iparg, ithbuf ,sithbuf)
266 ELSEIF(eltype==9) THEN
268 . iparg,ithbuf,sithbuf)
269 ENDIF
270
271
273 IF(nspmd>1) THEN
275 ELSE
276 index_wa_size_p0 = my_size
277 ENDIF
278
279
280 wa_comm(
id)%TH_DIPLS(1:nspmd) = 0
281 total_wa_size(
id) = 0
282 total_index_wa_size = 0
283 IF(ispmd==0) THEN
284 wa_index_dipls(1) = 0
285 DO i=1,nspmd-1
286 wa_index_dipls(i+1) = wa_index_dipls(i) + index_wa_size_p0(i)
287 total_index_wa_size = total_index_wa_size + index_wa_size_p0(i)
288 ENDDO
289 total_index_wa_size = total_index_wa_size + index_wa_size_p0(nspmd)
290 ENDIF
291
292 ALLOCATE( index_wa_eltype_p0(total_index_wa_size) )
293
294 IF(nspmd>1) THEN
295
297 . index_wa_size_p0,wa_index_dipls)
298
299
301 ELSE
303 wa_comm(
id)%TH_SIZE(1) = wa_size(
id)
304 ENDIF
305
306 IF(ispmd==0) THEN
307
308 wa_comm(
id)%TH_DIPLS(1) = 0
309 DO i=1,nspmd-1
310 wa_comm(
id)%TH_DIPLS(i+1) = wa_comm(
id)%TH_DIPLS(i) + wa_comm
311 total_wa_size(
id) = total_wa_size(
id) + wa_comm(
id)%TH_SIZE(i)
312 ENDDO
313 total_wa_size(
id) = total_wa_size(
id) + wa_comm(
id)%TH_SIZE(nspmd)
314 ENDIF
315
316 IF(ispmd==0) THEN
317
318 ALLOCATE( eltype_struct(
id)%TH_PROC(nspmd) )
319 DO i=1,nspmd
320 local_wa(1:nthgrp2+1) = 0
321 j = wa_index_dipls(i)
322 local_wa(1) = wa_comm(
id)%TH_DIPLS(i)
323
324 DO ijk=1,index_wa_size_p0(i)/2
325 n = index_wa_eltype_p0(2*ijk+j)
326 local_wa(n+1) = wa_comm(
id)%TH_DIPLS(i) + index_wa_eltype_p0(2*ijk-1+j)
327 ENDDO
328
329 DO n=2,nthgrp2+1
330 IF(local_wa(n)==0) THEN
331 local_wa(n)=local_wa(n-1)
332 ENDIF
333 ENDDO
334
335
336 IF(index_wa_size_p0(i)/2>0) THEN
337
338 ijk = 0
339 DO n=2,nthgrp2+1
340 IF(local_wa(n)-local_wa(n-1)>0) THEN
341 ijk=ijk+1
342 ENDIF
343 ENDDO
344 ijk=ijk+1
345
346 eltype_struct(
id)%TH_PROC(i)%TH_ELM_SIZE = ijk
347 ijk = eltype_struct(
id)%TH_PROC(i)%TH_ELM_SIZE
348 ALLOCATE( eltype_struct(
id)%TH_PROC(i)%TH_ELM(ijk,2) )
349
350 ijk = 0
351 DO n=2,nthgrp2+1
352 IF(local_wa(n)-local_wa(n-1)>0) THEN
353 ijk=ijk+1
354 eltype_struct(
id)%TH_PROC(i)%TH_ELM(ijk,1) = local_wa(n-1)
355 eltype_struct(
id)%TH_PROC(i)%TH_ELM(ijk,2) = n-1
356 ENDIF
357 ENDDO
358 ijk=ijk+1
359 eltype_struct(
id)%TH_PROC(i)%TH_ELM(ijk,1) = local_wa(nthgrp2+1)
360 eltype_struct(
id)%TH_PROC(i)%TH_ELM(ijk,2) = nthgrp2+1
361 ELSE
362
363 eltype_struct(
id)%TH_PROC(i)%TH_ELM_SIZE = 0
364 ALLOCATE( eltype_struct(
id)%TH_PROC(i)%TH_ELM(0,0) )
365 ENDIF
366 ENDDO
367 ENDIF
368
369
370 ALLOCATE( wa(
id)%WA_REAL(wa_size(
id)) )
371 ALLOCATE( wa_p0(
id)%WA_REAL(total_wa_size(
id)) )
372
373 DEALLOCATE( index_wa_eltype_p0 )
374 ENDDO
375
377 DEALLOCATE( index_wa_size_p0 )
378 DEALLOCATE( wa_index_dipls )
379
380 RETURN
end diagonal values have been computed in the(sparse) matrix id.SOL
type(th_wa_real), dimension(10), target wa_sol
type(th_wa_real), dimension(10), target wa_trus
type(th_wa_real), dimension(10), target wa_coq_p0
integer, dimension(10), target total_wa_sol_size
integer, dimension(10), target total_wa_nst_size
type(th_proc_type), dimension(10), target coq_struct
type(th_wa_real), dimension(10), target wa_nod
type(th_wa_real), dimension(10), target wa_sph
type(th_wa_real), dimension(10), target wa_coq
type(th_proc_type), dimension(10), target nst_struct
type(th_comm), dimension(10), target wa_sol_comm
type(th_wa_real), dimension(10), target wa_sol_p0
type(th_comm), dimension(10), target wa_sph_comm
type(th_wa_real), dimension(10), target wa_nod_p0
integer, dimension(10), target wa_spring_size
integer, dimension(10), target total_wa_nod_size
type(th_comm), dimension(10), target wa_spring_comm
integer, dimension(10), target total_wa_quad_size
type(th_proc_type), dimension(10), target sph_struct
type(th_wa_real), dimension(10), target wa_spring
type(th_wa_real), dimension(10), target wa_pout_p0
integer, dimension(10), target wa_quad_size
type(th_wa_real), dimension(10), target wa_nst
integer, dimension(10), target total_wa_trus_size
type(th_comm), dimension(10), target wa_nod_comm
integer, dimension(10), target total_wa_sph_size
type(th_proc_type), dimension(10), target quad_struct
integer, dimension(10), target wa_nst_size
type(th_proc_type), dimension(10), target spring_struct
integer, dimension(10), target wa_trus_size
integer, dimension(:), allocatable index_wa_eltype
type(th_comm), dimension(10), target wa_coq_comm
type(th_wa_real), dimension(10), target wa_spring_p0
type(th_comm), dimension(10), target wa_pout_comm
integer, dimension(10), target total_wa_pout_size
type(th_wa_real), dimension(10), target wa_pout
type(th_wa_real), dimension(10), target wa_nst_p0
integer, dimension(10), target wa_sph_size
integer, dimension(10), target total_wa_spring_size
integer, dimension(10), target total_wa_coq_size
type(th_proc_type), dimension(10), target sol_struct
type(th_wa_real), dimension(10), target wa_trus_p0
type(th_proc_type), dimension(10), target nod_struct
type(th_comm), dimension(10), target wa_nst_comm
type(th_comm), dimension(10), target wa_trus_comm
type(th_wa_real), dimension(10), target wa_quad_p0
integer, dimension(10), target wa_pout_size
integer, dimension(10), target wa_sol_size
type(th_comm), dimension(10), target wa_quad_comm
integer, dimension(10), target wa_nod_size
type(th_proc_type), dimension(10), target trus_struct
integer, dimension(10), target wa_coq_size
type(th_wa_real), dimension(10), target wa_quad
type(th_proc_type), dimension(10), target pout_struct
type(th_wa_real), dimension(10), target wa_sph_p0
subroutine spmd_gather_int(sendbuf, recvbuf, proc, send_size, rcv_size)
subroutine spmd_gatherv_int(sendbuf, recvbuf, proc, send_size, total_rcv_size, rcv_size, dipls)
subroutine thcoq_count(nthgrp2, ithgrp, wa_size, index_wa_coq, iparg, ithbuf, sithbuf)
subroutine thnod_count(ithgrp, nthgrp2, wa_size, index_wa_nod, ithbuf, weight, sithbuf)
subroutine thnst_count(nthgrp2, ithgrp, wa_size, index_wa_nst, iparg, ithbuf, sithbuf)
subroutine thpout_count(nthgrp2, ithgrp, wa_size, index_wa_pout, iparg, ithbuf, sithbuf)
subroutine thquad_count(nthgrp2, ithgrp, wa_size, index_wa_quad, iparg, ithbuf, sithbuf)
subroutine thres_count(iparg, ithbuf, elbuf_tab, igeo, ixr, ithgrp, nthgrp2, wa_size, index_wa_spring, sithbuf)
subroutine thsol_count(nthgrp2, ithgrp, wa_size, index_wa_sol, iparg, ithbuf, sithbuf)
subroutine thsph_count(nthgrp2, ithgrp, wa_size, index_wa_sph, iparg, ithbuf, sithbuf)
subroutine thtrus_count(nthgrp2, ithgrp, wa_size, index_wa_trus, iparg, ithbuf, sithbuf)