48
49
50
51 USE elbufdef_mod
56
57
58
59#include "implicit_f.inc"
60
61
62
63#include "com01_c.inc"
64#include "com04_c.inc"
65#include "param_c.inc"
66#include "task_c.inc"
67#include "tabsiz_c.inc"
68
69
70
71 INTEGER, INTENT(IN) :: SITHBUF
72 INTEGER MBUFFER, NPARTL,NTHGRP2
73 INTEGER IPARG(NPARG,*),IGEO(NPROPGI,*),
74 . ITHGRP(NITHGR,*),ITHBUF(SITHBUF),IXR(NIXR,*),WEIGHT(NUMNOD)
75 INTEGER, INTENT(in) :: ID
76
77 TYPE (ELBUF_STRUCT_), DIMENSION(NGROUP) :: ELBUF_TAB
78
79
80
81 INTEGER I,J,K,L,M,N,II,JJ,IP,NP,NN,NG,ITY,NEL,NFT,N1,N2,NPT,NRWA,
82 . JALE,FSAVMAX,PROC,NVAR,IAD,ITYP,IADV,FIRST,KRBHOL,ISKN,NNOD,ELTYPE
83 INTEGER :: MY_SIZE,TOTAL_INDEX_WA_SIZE,IJK
84 INTEGER, DIMENSION(NTHGRP2+1) :: LOCAL_WA
85 INTEGER, DIMENSION(:), ALLOCATABLE :: INDEX_WA_ELTYPE_P0,INDEX_WA_SIZE_P0
86 INTEGER, DIMENSION(:), ALLOCATABLE :: WA_INDEX_DIPLS
87 TYPE(TH_COMM), DIMENSION(:), POINTER :: WA_COMM
88 INTEGER, DIMENSION(:), POINTER :: WA_SIZE,TOTAL_WA_SIZE
89 TYPE(TH_PROC_TYPE), DIMENSION(:), POINTER :: ELTYPE_STRUCT
90 TYPE(TH_WA_REAL), DIMENSION(:), POINTER :: WA_P0,WA
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123! --> need to know where are the data in WA_SPRING_P0 and where the data must be
124! written in the TH file
125
126
127
128
129
130! the position of the first element in the TH file is added at the end of each chunk ax, bx,
131
132
133
134
135
136
137
138
139
140! N=2 | b1 | b2 | b3 |
141
142
143
144
145
146
147
148
149
150
151
153 ALLOCATE( index_wa_size_p0(nspmd) )
154 ALLOCATE( wa_index_dipls(nspmd) )
155
156 DO eltype=1,9
157
158
159
160
161
162
163
164
165
166 IF(eltype==1) THEN
173 ELSEIF(eltype==2) THEN
180 ELSEIF(eltype==3) THEN
186 wa_p0
187 ELSEIF(eltype==4) THEN
194 ELSEIF(eltype==5) THEN
201 ELSEIF(eltype==6) THEN
208 ELSEIF(eltype==7) THEN
215 ELSEIF(eltype==8) THEN
222 ELSEIF(eltype==9) THEN
229 ENDIF
230
231 ALLOCATE( wa_comm(
id)%TH_SIZE(nspmd) )
232 ALLOCATE( wa_comm(
id)%TH_DIPLS(nspmd) )
233
234 wa_comm(
id)%TH_SIZE(1:nspmd) = 0
236 index_wa_size_p0(1:nspmd) = 0
237 wa_index_dipls(1:nspmd) = 0
238
239
240 IF(eltype==1) THEN
243 ELSEIF(eltype==2) THEN
245 . weight,sithbuf)
246 ELSEIF(eltype==3) THEN
248 . iparg,ithbuf,sithbuf )
249 ELSEIF(eltype==4) THEN
251 . iparg,ithbuf,sithbuf )
252 ELSEIF(eltype==5) THEN
254 . iparg,ithbuf,sithbuf )
255 ELSEIF(eltype==6) THEN
257 . iparg ,ithbuf,sithbuf)
258 ELSEIF(eltype==7) THEN
260 . iparg , ithbuf,sithbuf )
261 ELSEIF(eltype==8) THEN
263 . iparg, ithbuf ,sithbuf)
264 ELSEIF(eltype==9) THEN
266 . iparg,ithbuf,sithbuf)
267 ENDIF
268
269
271 IF(nspmd>1) THEN
273 ELSE
274 index_wa_size_p0 = my_size
275 ENDIF
276
277
278 wa_comm(
id)%TH_DIPLS(1:nspmd) = 0
279 total_wa_size(
id) = 0
280 total_index_wa_size = 0
281 IF(ispmd==0) THEN
282 wa_index_dipls(1) = 0
283 DO i=1,nspmd-1
284 wa_index_dipls(i+1) = wa_index_dipls(i) + index_wa_size_p0(i)
285 total_index_wa_size = total_index_wa_size + index_wa_size_p0(i
286 ENDDO
287 total_index_wa_size = total_index_wa_size + index_wa_size_p0(nspmd)
288 ENDIF
289
290 ALLOCATE( index_wa_eltype_p0(total_index_wa_size) )
291
292 IF(nspmd>1) THEN
293
295 . index_wa_size_p0,wa_index_dipls)
296
297
299 ELSE
301 wa_comm(
id)%TH_SIZE(1) = wa_size(
id)
302 ENDIF
303
304 IF(ispmd==0) THEN
305
306 wa_comm(
id)%TH_DIPLS(1) = 0
307 DO i=1,nspmd-1
308 wa_comm(
id)%TH_DIPLS(i+1) = wa_comm(
id)%TH_DIPLS(i) + wa_comm(
id)%TH_SIZE(i)
309 total_wa_size(
id) = total_wa_size(
id) + wa_comm(
id)%TH_SIZE(i)
310 ENDDO
311 total_wa_size(
id) = total_wa_size(
id) + wa_comm(
id)%TH_SIZE(nspmd)
312 ENDIF
313
314 IF(ispmd==0) THEN
315
316 ALLOCATE( eltype_struct(
id)%TH_PROC(nspmd) )
317 DO i=1,nspmd
318 local_wa(1:nthgrp2+1) = 0
319 j = wa_index_dipls(i)
320 local_wa(1) = wa_comm(
id)%TH_DIPLS(i)
321
322 DO ijk=1,index_wa_size_p0(i)/2
323 n = index_wa_eltype_p0(2*ijk+j)
324 local_wa(n+1) = wa_comm(
id)%TH_DIPLS(i) + index_wa_eltype_p0(2*ijk-1+j)
325 ENDDO
326
327 DO n=2,nthgrp2+1
328 IF(local_wa(n)==0) THEN
329 local_wa(n)=local_wa(n-1)
330 ENDIF
331 ENDDO
332
333
334 IF(index_wa_size_p0(i)/2>0) THEN
335
336 ijk = 0
337 DO n=2,nthgrp2+1
338 IF(local_wa(n)-local_wa(n-1)>0) THEN
339 ijk=ijk+1
340 ENDIF
341 ENDDO
342 ijk=ijk+1
343
344 eltype_struct(
id)%TH_PROC(i)%TH_ELM_SIZE = ijk
345 ijk = eltype_struct(
id)%TH_PROC(i)%TH_ELM_SIZE
346 ALLOCATE( eltype_struct(
id)%TH_PROC(i)%TH_ELM(ijk,2) )
347
348 ijk = 0
349 DO n=2,nthgrp2+1
350 IF(local_wa(n)-local_wa(n-1)>0) THEN
351 ijk=ijk+1
352 eltype_struct(
id)%TH_PROC(i)%TH_ELM(ijk,1) = local_wa(n-1)
353 eltype_struct(
id)%TH_PROC(i)%TH_ELM(ijk,2) = n-1
354 ENDIF
355 ENDDO
356 ijk=ijk+1
357 eltype_struct(
id)%TH_PROC(i)%TH_ELM(ijk,1) = local_wa(nthgrp2+1)
358 eltype_struct(
id)%TH_PROC(i)%TH_ELM(ijk,2) = nthgrp2+1
359 ELSE
360
361 eltype_struct(
id)%TH_PROC(i)%TH_ELM_SIZE = 0
362 ALLOCATE( eltype_struct(
id)%TH_PROC(i)%TH_ELM(0,0) )
363 ENDIF
364 ENDDO
365 ENDIF
366
367
368 ALLOCATE( wa(
id)%WA_REAL(wa_size(
id)) )
369 ALLOCATE( wa_p0(
id)%WA_REAL(total_wa_size(
id)) )
370
371 DEALLOCATE( index_wa_eltype_p0 )
372 ENDDO
373
375 DEALLOCATE( index_wa_size_p0 )
376 DEALLOCATE( wa_index_dipls )
377
378 RETURN
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)