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, 3 + 4*nbmat))
75
76 DO i=1,ncell
80 k=3
81 DO j=1,nbmat
82 k=k+1
84 k=k+1
86 k=k+1
88 k=k+1
90 ENDDO
91 ENDDO
92 msgtyp = msgoff
93 siz = ncell*(3+4*nbmat)
94 CALL mpi_send(buff_r, siz, real,it_spmd(1),msgtyp,spmd_comm_world,ierror)
95 IF(ALLOCATED(buff_r))DEALLOCATE(buff_r)
96 ELSE
97 DO i=2,nspmd
98
99 msgtyp = msgoff
102 siz = ncell*(3+4*nbmat)
103
104 ALLOCATE (buff_r(ncell, 3+4*nbmat ))
105 CALL mpi_recv(buff_r,siz,real,it_spmd(i),msgtyp,spmd_comm_world,status,ierror)
110 DO j=1,nbmat
115 ENDDO
116 DO l=1,ncell
120 k=3
121 DO j=1,nbmat
122 k=k+1
124 k=k+1
126 k=k+1
128 k=k+1
130 ENDDO
131 ENDDO
132 IF(ALLOCATED(buff_r))DEALLOCATE (buff_r)
133 ENDDO
134 ENDIF
135
136
137
138
139 IF (ispmd /= 0) THEN
141 ALLOCATE (buff_r(npts,5))
142 DO i=1,npts
148 ENDDO
149 msgtyp = msgoff
150 siz = 5*npts
151 CALL mpi_send(buff_r, siz, real,it_spmd(1),msgtyp,spmd_comm_world,ierror)
152 IF(ALLOCATED(buff_r))DEALLOCATE (buff_r)
153
155 DO j=1,nbmat
160 ENDDO
169 ELSE
171 DO i=2,nspmd
172
173 msgtyp = msgoff
175 siz = 5*npts
176 ALLOCATE (buff_r(npts, 5 ))
177 CALL mpi_recv(buff_r,siz,real,it_spmd(i),msgtyp,spmd_comm_world,status,ierror)
183 DO l=1,npts
189 ENDDO
190 IF(ALLOCATED(buff_r))DEALLOCATE (buff_r)
191 ENDDO
192 ENDIF
193
194
195#endif
196 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