31
32
33
34
35
36
37 USE spmd_comm_world_mod, ONLY : spmd_comm_world
38#include "implicit_f.inc"
39
40
41
42#include "spmd.inc"
43
44
45
46#include "com01_c.inc"
47#include "task_c.inc"
48
49
50
51 INTEGER LEN,
53 . v(len)
54
55
56
57#ifdef MPI
58 INTEGER MSGOFF,MSGTYP,I,K
59 DATA msgoff/107/
60 INTEGER STATUS(MPI_STATUS_SIZE),IERROR
62 . vtmp(len)
63
64
65
66 IF (ispmd/=0) THEN
67 msgtyp=msgoff
68 CALL mpi_send(v,len,real,it_spmd(1),msgtyp,
69 . spmd_comm_world,ierror)
70 ELSE
71 DO k=2,nspmd
72 msgtyp=msgoff
73 CALL mpi_recv(vtmp,len,real,it_spmd(k),msgtyp,
74 . spmd_comm_world,status,ierror)
75 DO i=1,len1
76 IF(abs(v(i))<abs(vtmp(i))) THEN
77 v(i) = vtmp(i)
78 ENDIF
79 ENDDO
80
81 DO i=len1+1,len
82 v(i) = v(i)+vtmp(i)
83 ENDDO
84 ENDDO
85 ENDIF
86
87#endif
88 RETURN
subroutine mpi_recv(buf, cnt, datatype, source, tag, comm, status, ierr)
subroutine mpi_send(buf, cnt, datatype, dest, tag, comm, ierr)