34
35
36
38
39
40
41 USE spmd_comm_world_mod, ONLY : spmd_comm_world
42#include "implicit_f.inc"
43#include "spmd.inc"
44
45
46
47#include "com01_c.inc"
48#include "task_c.inc"
49
50
51
52
53
54
55
56#ifdef MPI
57 INTEGER STATUS(MPI_STATUS_SIZE),IERROR,MSGOFF
58 INTEGER SIZ,MSGTYP,I,J,K,L,NG,NREC,MSGOFF2,IDOM,IPOS
59 INTEGER NCELL, NPTS, NBMAT
60
61 DATA msgoff/10002/
62
63 my_real,
ALLOCATABLE,
DIMENSION(:,:) :: buff_r
64
65
66
67
68
69
70
71 IF (ispmd/=0) THEN
74 ALLOCATE (buff_r(ncell, 1 + 4*nbmat))
75
76 DO i=1,ncell
78 k=1
79 DO j=1,nbmat
80 k=k+1
82 k=k+1
84 k=k+1
86 k=k+1
88 ENDDO
89 ENDDO
90 msgtyp = msgoff
91 siz = ncell*(1+4*nbmat)
92 CALL mpi_send(buff_r, siz, real,it_spmd(1),msgtyp,spmd_comm_world,ierror)
93 IF(ALLOCATED(buff_r))DEALLOCATE(buff_r)
94 ELSE
96 DO i=2,nspmd
97
98 msgtyp = msgoff
101 siz = ncell*(1+4*nbmat)
102 ALLOCATE (buff_r(ncell, 1 + 4*nbmat ))
103 CALL mpi_recv(buff_r,siz,real,it_spmd(i),msgtyp,spmd_comm_world,status,ierror)
106 DO j=1,nbmat
111 ENDDO
112 DO l=1,ncell
114 k=1
115 DO j=1,nbmat
116 k=k+1
118 k=k+1
120 k=k+1
122 k=k+1
124 ENDDO
125 ENDDO
126 IF(ALLOCATED(buff_r))DEALLOCATE (buff_r)
127 ENDDO
128 ENDIF
129
130
131
132
133 IF (ispmd /= 0) THEN
135 ALLOCATE (buff_r(npts,2))
136 DO i=1,npts
139 ENDDO
140 msgtyp = msgoff
141 siz = 2*npts
142 CALL mpi_send(buff_r, siz, real,it_spmd(1),msgtyp,spmd_comm_world,ierror)
143 IF(ALLOCATED(buff_r))DEALLOCATE (buff_r)
144
146 DO j=1,nbmat
151 ENDDO
156 ELSE
158 DO i=1,npts
160 ENDDO
161 DO i=2,nspmd
162
163 msgtyp = msgoff
165 siz = 2*npts
166 ALLOCATE (buff_r(npts, 2 ))
167 CALL mpi_recv(buff_r,siz,real,it_spmd(i),msgtyp,spmd_comm_world,status,ierror)
170 DO l=1,npts
173 ENDDO
174 IF(ALLOCATED(buff_r))DEALLOCATE (buff_r)
175 ENDDO
176 ENDIF
177
178
179#endif
180 RETURN
subroutine mpi_recv(buf, cnt, datatype, source, tag, comm, status, ierr)
subroutine mpi_send(buf, cnt, datatype, dest, tag, comm, ierr)
type(map_struct), dimension(:), allocatable state_inimap_buf