39 USE spmd_comm_world_mod,
ONLY : spmd_comm_world
40#include "implicit_f.inc"
51 INTEGER IAD_ELEM(2,*), FR_ELEM(*)
52 TYPE (NLOCAL_STR_) ,
TARGET :: NLOC_DMG
56 INTEGER,
DIMENSION(:),
ALLOCATABLE :: COUNT,
57 INTEGER P,J,TOTAL_NODES,NCOUNT,NOD,NN,NPOS,NDDL
59 INTEGER :: LSD,LRD,CC,LOC_PROC,KK
69 IF (
ALLOCATED(nloc_dmg%IAD_ELEM))
DEALLOCATE (nloc_dmg%IAD_ELEM)
70 IF (
ALLOCATED(nloc_dmg%IAD_SIZE))
DEALLOCATE (nloc_dmg%IAD_SIZE)
71 IF (
ALLOCATED(nloc_dmg%FR_ELEM ))
DEALLOCATE (nloc_dmg%FR_ELEM)
74 ALLOCATE(count(nspmd))
75 ALLOCATE(count2(nspmd))
83 IF (nodadt > 0) kk = 2
87 DO j=iad_elem(1,p),iad_elem(1,p+1)-1
89 nn = nloc_dmg%IDXI(nod)
90 IF (nloc_dmg%IDXI(nod) > 0)
THEN
91 npos = nloc_dmg%POSI(nn)
92 nddl = nloc_dmg%POSI(nn+1) - npos
93 count(p) = count(p) +1
94 count2(p)= count2(p)+kk*nddl
97 total_nodes = total_nodes + count(p)
101 ALLOCATE(nloc_dmg%IAD_ELEM(nspmd+1))
102 ALLOCATE(nloc_dmg%IAD_SIZE(nspmd+1))
103 ALLOCATE(nloc_dmg%FR_ELEM(total_nodes))
106 nloc_dmg%IAD_ELEM(1) = 1
107 nloc_dmg%IAD_SIZE(1) = 1
111 nloc_dmg%IAD_ELEM(p) = nloc_dmg%IAD_ELEM(p-1) + count(p-1)
112 nloc_dmg%IAD_SIZE(p) = nloc_dmg%IAD_SIZE(p-1) + count2(p-1)
119 DO j=iad_elem(1,p),iad_elem(1,p+1)-1
121 nn = nloc_dmg%IDXI(nod)
124 nloc_dmg%FR_ELEM(ncount) = nn
133 IF (
ALLOCATED(count))
DEALLOCATE(count)
134 IF (
ALLOCATED(count2))
DEALLOCATE(count2)
140! ------------------------
146 DO j=nloc_dmg%IAD_ELEM(p),nloc_dmg%IAD_ELEM(p+1)-1
147 nn = nloc_dmg%FR_ELEM(j)
148 nddl = nloc_dmg%POSI(nn+1) - nloc_dmg%POSI(nn)
149 DO cc = nloc_dmg%ADDCNE(nn),nloc_dmg%ADDCNE(nn+1)-1
150 IF( nloc_dmg%PROCNE(cc)==loc_proc)
THEN
152 ELSEIF(nloc_dmg%PROCNE(cc)==p)
THEN
161 ALLOCATE( nloc_dmg%ISENDSP(lsd) )
162 ALLOCATE( nloc_dmg%IRECSP(lrd) )
163 nloc_dmg%ISENDSP(1:lsd) = 0
164 nloc_dmg%IRECSP(1:lrd) = 0
168 IF( .NOT.
ALLOCATED( nloc_dmg%IADSDP ) )
ALLOCATE( nloc_dmg%IADSDP(nspmd+1) )
169 IF( .NOT.
ALLOCATED( nloc_dmg%IADRCP ) )
ALLOCATE( nloc_dmg%IADRCP(nspmd+1) )
170 IF( .NOT.
ALLOCATED( nloc_dmg%FR_NBCC ) )
ALLOCATE( nloc_dmg%FR_NBCC(2,nspmd+1) )
172 IF( .NOT.
ALLOCATED( nloc_dmg%FR_ELEM_S ) )
ALLOCATE( nloc_dmg%FR_ELEM_S(lsd) )
173 IF( .NOT.
ALLOCATED( nloc_dmg%FR_ELEM_R ) )
ALLOCATE( nloc_dmg%FR_ELEM_R(lrd) )
174 nloc_dmg%FR_ELEM_S(1:lsd) = 0
175 nloc_dmg%FR_ELEM_R(1:lrd) = 0
177 nloc_dmg%IADSDP(1:nspmd+1) = 0
178 nloc_dmg%IADRCP(1:nspmd+1) = 0
179 nloc_dmg%FR_NBCC(1:2,1:nspmd+1) = 0
185 nloc_dmg%IADSDP(p)=lsd
186 nloc_dmg%IADRCP(p)=lrd
188 DO j=nloc_dmg%IAD_ELEM(p),nloc_dmg%IAD_ELEM(p+1)-1
189 nn = nloc_dmg%FR_ELEM(j)
190 nddl = nloc_dmg%POSI(nn+1) - nloc_dmg%POSI(nn)
192 DO cc = nloc_dmg%ADDCNE(nn),nloc_dmg%ADDCNE(nn+1)-1
193 IF( nloc_dmg%PROCNE(cc)==loc_proc)
THEN
194 nloc_dmg%FR_NBCC(1,p) = nloc_dmg%FR_NBCC(1,p)+kk*nddl
195 nloc_dmg%ISENDSP(lsd)=cc
196 nloc_dmg%FR_ELEM_S(lsd)=nn
198 ELSEIF(nloc_dmg%PROCNE(cc)==p)
THEN
199 nloc_dmg%FR_NBCC(2,p) = nloc_dmg%FR_NBCC(2,p)+kk*nddl
200 nloc_dmg%IRECSP(lrd)=cc
201 nloc_dmg%FR_ELEM_R(lrd)=nn
209 nloc_dmg%FR_NBCC(1:2,nspmd+1) = 0
211 nloc_dmg%FR_NBCC(1,nspmd+1) = nloc_dmg%FR_NBCC(1,nspmd+1) + nloc_dmg%FR_NBCC(1,j)
212 nloc_dmg%FR_NBCC(2,nspmd+1) = nloc_dmg%FR_NBCC(2,nspmd+1) + nloc_dmg%FR_NBCC(2,j)
215 nloc_dmg%IADSDP(nspmd+1)=lsd
216 nloc_dmg%IADRCP(nspmd+1)=lrd
238 USE spmd_comm_world_mod,
ONLY : spmd_comm_world
239#include "implicit_f.inc"
247#include "com01_c.inc"
249#include "scr02_c.inc"
253 TYPE (NLOCAL_STR_) ,
TARGET
259 INTEGER NDDL,NSIZESUB,NN,NPOS,SIZEA
263 INTEGER MSGTYP,NOD,LOC_PROC, SIZ,NB_NOD,NB,MAXLEV
265INTEGER STATUS(MPI_STATUS_SIZE),IERROR
268 INTEGER IAD_SEND(NSPMD+1),IAD_RECV(NSPMD+1)
269 INTEGER SEND_SIZ(NSPMD),RECV_SIZ(NSPMD)
270 INTEGER SIZ_SEND,SIZ_RECV
275 my_real,
DIMENSION(:),
ALLOCATABLE :: send_buf,recv_buf
279 nsizesub=nloc_dmg%NNOD
280 sizea = nloc_dmg%L_NLOC
284 siz = nloc_dmg%IAD_SIZE(nspmd+1)-nloc_dmg%IAD_SIZE(1)
285 ALLOCATE(recv_buf(siz))
286 ALLOCATE(send_buf(siz))
293 siz = nloc_dmg%IAD_SIZE(i+1)-nloc_dmg%IAD_SIZE(i)
296 CALL mpi_irecv( recv_buf(l),siz,real,it_spmd(i),msgtyp,
297 g spmd_comm_world,req_r(i),ierror)
308 DO j=nloc_dmg%IAD_ELEM(i),nloc_dmg%IAD_ELEM(i+1)-1
309 nn = nloc_dmg%FR_ELEM(j)
310 npos = nloc_dmg%POSI(nn)
311 nddl = nloc_dmg%POSI(nn+1)-nloc_dmg%POSI(nn)
314 send_buf(k) = nloc_dmg%FNL(npos+l-1,1)
328 siz = iad_send(i+1)-iad_send(i)
333 s send_buf(l),siz,real,it_spmd(i),msgtyp,
334 g spmd_comm_world,req_s(i),ierror)
342 siz = nloc_dmg%IAD_SIZE(i+1)-nloc_dmg%IAD_SIZE(i)
344 CALL mpi_wait(req_r(i),status,ierror)
348 DO j=nloc_dmg%IAD_ELEM(i),nloc_dmg%IAD_ELEM(i+1)-1
349 nn = nloc_dmg%FR_ELEM(j)
350 npos = nloc_dmg%POSI(nn)
351 nddl = nloc_dmg%POSI(nn+1) - nloc_dmg%POSI(nn)
354 nloc_dmg%FNL(npos+l-1,1)=nloc_dmg%FNL(npos+l-1,1)+recv_buf(k)
357 nloc_dmg%STIFNL(npos+l-1,1)=nloc_dmg%STIFNL(npos+l-1,1)+recv_buf(k)
371 siz = iad_send(i+1)-iad_send(i)
373 CALL mpi_wait(req_s(i),status,ierror)
402! - fill
the sending buffer
412 USE spmd_comm_world_mod,
ONLY : spmd_comm_world
413#include "implicit_f.inc"
421#include "com01_c.inc"
423#include "scr02_c.inc"
427 TYPE (NLOCAL_STR_) ,
TARGET :: NLOC_DMG
432 INTEGER I,J,,L,M,ND,IJK
433 INTEGER ,,NN,NPOS,SIZEA
437 INTEGER MSGTYP,NOD,LOC_PROC, SIZ,NB_NOD,NB,MAXLEV,VALUE
439 INTEGER STATUS(MPI_STATUS_SIZE),IERROR
442 INTEGER (NSPMD+1),(NSPMD+1)
443 INTEGER SEND_SIZ(NSPMD),RECV_SIZ(NSPMD)
444 INTEGER SIZ_SEND,SIZ_RECV
446 INTEGER :: SIZ_S,SIZ_R
450 my_real,
DIMENSION(:),
ALLOCATABLE :: send_buf,recv_buf
454 nsizesub=nloc_dmg%NNOD
455 sizea = nloc_dmg%L_NLOC
459 siz_s = nloc_dmg%FR_NBCC(1,nspmd+1)
460 siz_r = nloc_dmg%FR_NBCC(2,nspmd+1)
461 ALLOCATE(recv_buf(siz_r))
462 ALLOCATE(send_buf(siz_s))
464 recv_buf(1:siz_r) = -123456.
465 send_buf(1:siz_s) = 123456.
472 siz = nloc_dmg%FR_NBCC(2,i)
475 CALL mpi_irecv( recv_buf(l),siz,real,it_spmd(i),msgtyp,
476 g spmd_comm_world,req_r(i),ierror)
488 DO j = nloc_dmg%IADSDP(i), nloc_dmg%IADSDP(i+1)-1
489 nn = nloc_dmg%FR_ELEM_S(j)
490 npos = nloc_dmg%POSI(nn)
491 nddl = nloc_dmg%POSI(nn+1)-nloc_dmg%POSI(nn)
492 ijk = nloc_dmg%ISENDSP(j)
494 send_buf(k) = nloc_dmg%FSKY(ijk,l)
497 send_buf(k) = nloc_dmg%STSKY(ijk,l)
509 siz = nloc_dmg%FR_NBCC(1,i)
514 s send_buf(l),siz,real,it_spmd(i),msgtyp,
515 g spmd_comm_world,req_s(i),ierror)
523 siz = nloc_dmg%FR_NBCC(2,i)
525 CALL mpi_wait(req_r(i),status,ierror)
528 DO j=nloc_dmg%IADRCP(i),nloc_dmg%IADRCP(i+1)-1
529 nn = nloc_dmg%FR_ELEM_R(j)
530 npos = nloc_dmg%POSI(nn)
531 nddl = nloc_dmg%POSI(nn+1) - nloc_dmg%POSI(nn)
533 ijk = nloc_dmg%IRECSP(j)
535 nloc_dmg%FSKY(ijk,l) = recv_buf(k)
538 nloc_dmg%STSKY(ijk,l) = recv_buf(k)
550 siz = nloc_dmg%FR_NBCC(1,i)
552 CALL mpi_wait(req_s(i),status,ierror)