32 USE spmd_mod
33
34
35
36#include "implicit_f.inc"
37#include "spmd.inc"
38#include "com04_c.inc"
39#include "task_c.inc"
40
41
42
44 . xsec(3,3,nsect),x(3,*)
45 INTEGER NSTRF(*),WEIGHT(*),ITAB(*)
46
47
48
49#ifdef MPI
50 INTEGER IERROR,
51 . STATUS(MPI_STATUS_SIZE)
52
54 . xsectmp(3,3,nsect)
55
56 INTEGER I,K1,N1,N2,N3,LEN
57
58 DO i=1,nsect
59 xsectmp(1,1,i)=zero
60 xsectmp(1,2,i)=zero
61 xsectmp(1,3,i)=zero
62
63 xsectmp(2,1,i)=zero
64 xsectmp(2,2,i)=zero
65 xsectmp(2,3,i)=zero
66
67 xsectmp(3,1,i)=zero
68 xsectmp(3,2,i)=zero
69 xsectmp(3,3,i)=zero
70
71 xsec(1,1,i)=zero
72 xsec(1,2,i)=zero
73 xsec(1,3,i)=zero
74
75 xsec(2,1,i)=zero
76 xsec(2,2,i)=zero
77 xsec(2,3,i)=zero
78
79 xsec(3,1,i)=zero
80 xsec(3,2,i)=zero
81 xsec(3,3,i)=zero
82
83 ENDDO
84
85 k1 = 33
86
87 DO i=1,nsect
88 n1 = nstrf(k1+1)
89 n2 = nstrf(k1+2)
90 n3 = nstrf(k1+3)
91 IF (n1>0) THEN
92 IF (weight(n1)==1) THEN
93 xsectmp(1,1,i) = x(1,n1)
94 xsectmp(1,2,i) = x(2,n1)
95 xsectmp(1,3,i) = x(3,n1)
96 ENDIF
97 ENDIF
98
99 IF (n2>0) THEN
100 IF (weight(n2)==1) THEN
101 xsectmp(2,1,i) = x(1,n2)
102 xsectmp(2,2,i) = x(2,n2)
103 xsectmp(2,3,i) = x(3,n2)
104 ENDIF
105 ENDIF
106
107 IF (n3>0) THEN
108 IF (weight(n3)==1) THEN
109 xsectmp(3,1,i) = x(1,n3)
110 xsectmp(3,2,i) = x(2,n3)
111 xsectmp(3,3,i) = x(3,n3)
112 ENDIF
113 ENDIF
114
115 k1= nstrf(k1+22)+2
116 ENDDO
117
118 len = 9*nsect
119
120
122 . real,mpi_sum,it_spmd(1),
123 . spmd_comm_world,ierror)
124
125
126
127
128
129
130
131
132
133
134
135#endif
136 RETURN
subroutine mpi_reduce(sendbuf, recvbuf, cnt, datatype, op, root, comm, ierr)
1.15.0