35
36
37
38
39
40 USE spmd_comm_world_mod, ONLY : spmd_comm_world
41#include "implicit_f.inc"
42
43
44
45#include "spmd.inc"
46
47
48
49#include "com01_c.inc"
50#include "com04_c.inc"
51#include "task_c.inc"
52#include "sms_c.inc"
53
54
55
56 INTEGER ICSIZE, NOD2ADD(*),LJOINT(*),FR_CJ(*),
57 . IADCJ(NSPMD+1,*), TAG_LNK_SMS(*), NODNX_SMS(*),
58 . INDX1_SMS(*)
59
60
61
62#ifdef MPI
63 INTEGER MSGTYP,MSGOFF,IERROR,LOC_PROC,NOD,L,I,J,N,
64 . IDEB,IAD,SIZ,A_AR,NBINDEX,
65 . INDEXI(NSPMD),REQ_S(NSPMD),STATUS(MPI_STATUS_SIZE),
66 . LEN(NSPMD),IBUF(ICSIZE)
67 DATA msgoff/104/
68
69
70
71 loc_proc = ispmd + 1
72 IF (loc_proc==1) THEN
73 l = 0
74 ideb = 1
75
76 DO i = 2, nspmd
77 len(i)=0
78 DO n=1,njoint
79 IF(tag_lnk_sms(n)/=0)
80 . len(i) = len(i)+iadcj(i+1,n)-iadcj(i,n)
81 END DO
82 IF(len(i)>0) THEN
83 l=l+1
84 indexi(l)=i
85 DO n=1,njoint
86 IF(tag_lnk_sms(n)==0)cycle
87 DO j = iadcj(i,n), iadcj(i+1,n)-1
88 nod = fr_cj(j)
89 ibuf(ideb ) = nod2add(nod)
90 ideb = ideb + 1
91 END DO
92 END DO
93 END IF
94 END DO
95 nbindex = l
96
97 ideb = 1
98
99 DO l=1,nbindex
100 i = indexi(l)
101 siz = len(i)
102 msgtyp = msgoff
104 s ibuf(ideb),siz,mpi_integer,it_spmd(i),msgtyp,
105 g spmd_comm_world,req_s(l),ierror)
106 ideb = ideb + siz
107 END DO
108
109 DO l=1,nbindex
111 ENDDO
112 ELSEIF(icsize>0) THEN
113
114 ideb = 1
115 siz = icsize
116 msgtyp = msgoff
118 s ibuf,siz,mpi_integer,it_spmd(1),msgtyp,
119 g spmd_comm_world,status,ierror)
120 DO n = 1, njoint
121 IF(tag_lnk_sms(n)==0)cycle
122 DO j = iadcj(1,n),iadcj(nspmd+1,n)-1
123 nod = fr_cj(j)
124 IF(nodnx_sms(nod)==0.AND.nod2add(nod)==0.AND.
125 . ibuf(ideb)/=0)THEN
126 nindx1_sms=nindx1_sms+1
127 indx1_sms(nindx1_sms)=nod
128 nodnx_sms(nod)=nindx1_sms
129 nod2add(nod)=1
130 END IF
131 ideb = ideb + 1
132 END DO
133 END DO
134 END IF
135
136#endif
137 RETURN
subroutine mpi_recv(buf, cnt, datatype, source, tag, comm, status, ierr)
subroutine mpi_isend(buf, cnt, datatype, dest, tag, comm, ireq, ierr)
subroutine mpi_waitany(cnt, array_of_requests, index, status, ierr)