MPI+Fortran的源代码，报错，希望好心人帮忙运行一下

DLUTCC

[Fortran] 纯文本查看 复制代码

查看代码

打印?

001	PROGRAM  T5_2D

002	IMPLICIT REAL*8 (A-H,O-Z)

003	INCLUDE 'mpif.h'

004	PARAMETER   (KK=20,NN=120,MM=160, KM=3,NN1=NN-1,MM1=MM-1)

005	PARAMETER   (JP=2, IP=4, N=NN/JP, M=MM/IP, NP=JP*IP)

006	DIMENSION    TT(KM,NN,MM)

007	DIMENSION    U1(KK,0:N+1,0:M+1),V1(KK,0:N+1,0:M+1),PS1(0:N+1,0:M+1)

008	COMMON/BLK4/F1(KM,0:N+1,0:M+1),F2(KM,0:N+1,0:M+1),HXU(0:N+1,0:M+1),HXV(0:N+1,0:M+1),HMMX(0:N+1,0:M+1),HMMY(0:N+1,0:M+1)

009	COMMON/BLK5/VECINV(KK,KK),AM7(KK)

010	DIMENSION    D7(0:N+1,0:M+1),D8(0:N+1,0:M+1),D00(KK,0:N+1,0:M+1)

011

012	PARAMETER (NDIM=2)

013	INTEGER   ISTATUS(MPI_STATUS_SIZE), COMM2D,L_NBR, R_NBR, B_NBR, T_NBR, MY_CID, MY_COORD(NDIM),VECT_2D, VECT_3D

014	COMMON/BLKMPI/MYID, NPROC, ISTATUS, L_NBR, R_NBR, B_NBR, T_NBR,MY_CID, STRIDE2D, STRIDE3D,ISTART, ISTART2, IEND, IEND1, ISTARTM1, IENDP1,JSTART, JSTART2, JEND, JEND1, JSTARTM1, JENDP1, ISTARTG(0:NP),IENDG(0:NP),JSTARTG(0:NP),JENDG(0:NP)

015

016	CALL MPI_INIT (IERR)

017	CALL MPI_COMM_SIZE (MPI_COMM_WORLD, NPROC, IERR)

018	IF(NPROC.NE.NP) THEN

019	PRINT *,' NPROC NOT EQUAL TO ', NP,' PROGRAM WILL STOP'

020

STOP

021

ENDIF

022	CALL MPI_COMM_RANK (MPI_COMM_WORLD, MYID, IERR)

023	CALL NBR2D(COMM2D,MY_CID,MY_COORD,L_NBR,R_NBR,B_NBR,T_NBR,JP,IP)

024

025	CALL MPI_BARRIER (COMM2D,IERR)

026	CLOCK=MPI_WTIME()

027	CALL STARTEND (JP,1,NN,JSTARTG, JENDG, JCOUNTG)

028	CALL STARTEND (IP,1,MM,ISTARTG, IENDG, ICOUNTG)

029

ISTART=1

030

IEND=M

031

JSTART=1

032

JEND=N

033	!        for DO I=x,MM1 (MM-1)

034	!        for DO J=x,NN1 (NN-1)

035	IEND1=IEND

036	JEND1=JEND

037	IF( MY_COORD(2).EQ.IP-1) IEND1=IEND1-1

038	IF( MY_COORD(1).EQ.JP-1) JEND1=JEND1-1.

039	!        for DO I=2,x

040	!        for DO J=2,x

041

042	ISTART2=ISTART

043	JSTART2=JSTART

044	IF( MY_COORD(2).EQ.0) ISTART2=2

045	IF( MY_COORD(1).EQ.0) JSTART2=2

046

047	!        for ghost point

048	ISTARTM1=ISTART-1

049	IENDP1=IEND+1

050	JSTARTM1=JSTART-1

051	JENDP1=JEND+1

052	!     原始数据的产生

053	!DO 10 I=1,MM1

054	DO 10 I=1,IEND1

055	II=I+ISTARTG(MY_COORD(2))-1

056	!  DO 10 J=1,NN

057	DO 10 J=1,JEND

058	JJ=J+JSTARTG(MY_COORD(1))-1

059	DO 10 K=1,KK

060	U1(K,J,I)=1.D0/DFLOAT(II)+1.D0/DFLOAT(JJ)+1.D0/DFLOAT(K)

061	10  CONTINUE

062	!  DO 20 I=1,MM

063	DO 20 I=1,IEND

064	II=I+ISTARTG(MY_COORD(2))-1

065	!  DO 20 J=1,NN1

066	DO 20 J=1,JEND1

067	JJ=J+JSTARTG(MY_COORD(1))-1

068	DO 20 K=1,KK

069	V1(K,J,I)=2.D0/DFLOAT(II)+1.D0/DFLOAT(JJ)+1.D0/DFLOAT(K)

070	20  CONTINUE

071	!  DO 30 I=1,MM

072	DO 30 I=1,IEND

073	II=I+ISTARTG(MY_COORD(2))-1

074	!  DO 30 J=1,NN

075	DO 30 J=1,JEND

076	JJ=J+JSTARTG(MY_COORD(1))-1

077	PS1(J,I)=1.D0/DFLOAT(II)+1.D0/DFLOAT(JJ)

078	HXU(J,I)=2.D0/DFLOAT(II)+1.D0/DFLOAT(JJ)

079	HXV(J,I)=1.D0/DFLOAT(II)+2.D0/DFLOAT(JJ)

080	HMMX(J,I)=2.D0/DFLOAT(II)+1.D0/DFLOAT(JJ)

081	HMMY(J,I)=1.D0/DFLOAT(II)+2.D0/DFLOAT(JJ)

082	30 CONTINUE

083	DO 40 K=1,KK

084	AM7(K)=1.D0/DFLOAT(K)

085	DO 40 KA=1,KK

086	VECINV(KA,K)=1.D0/DFLOAT(KA)+1.D0/DFLOAT(K)

087	40  CONTINUE

088	!     开始计算

089

N2=N+2

090	N2KK=N2*KK

091	CALL MPI_TYPE_VECTOR (M, KK, N2KK, MPI_REAL8, IVECT_3D, IERR)

092	CALL MPI_TYPE_COMMIT (IVECT_3D, MPI_ERR)

093	CALL MPI_TYPE_VECTOR (M, 1, N2, MPI_REAL8, IVECT_2D, IERR)

094	CALL MPI_TYPE_COMMIT (IVECT_2D, IERR)

095	CALL MPI_BARRIER (COMM2D, IERR)

096

ITAG=10

097	CALL MPI_SENDRECV (U1(1,1,IEND ),    N2KK, MPI_REAL8, T_NBR, ITAG,U1(1,1,ISTARTM1), N2KK, MPI_REAL8, B_NBR, ITAG,COMM2D, ISTATUS, IERR)

098

ITAG=20

099	CALL MPI_SENDRECV(V1(1,JEND,1 ),    1, IVECT_3D, R_NBR, ITAG,V1(1,JSTARTM1,1), 1, IVECT_3D, L_NBR, ITAG,COMM2D, ISTATUS, IERR)

100

ITAG=30

101	CALL MPI_SENDRECV (PS1(1,ISTART), N, MPI_REAL8, B_NBR, ITAG,PS1(1,IENDP1), N, MPI_REAL8, T_NBR, ITAG,COMM2D, ISTATUS, IERR)

102

ITAG=40

103	CALL MPI_SENDRECV (PS1(JSTART,1), 1, IVECT_2D, L_NBR, ITAG,PS1(JENDP1,1), 1, IVECT_2D, R_NBR, ITAG,COMM2D, ISTATUS, IERR)

104	!  DO 210 I=1,MM

105	!  DO 210 J=1,NN

106	DO 210 I=ISTART,IEND

107	DO 210 J=JSTART,JEND

108	DO 210 K=1,KM

109	F1(K,J,I)=0.0D0

110	F2(K,J,I)=0.0D0

111	210  CONTINUE

112	!  DO 220 I=1,MM1

113	!  DO 220 J=2,NN1

114	DO 220 I=ISTART,IEND1

115	DO 220 J=JSTART2,JEND1

116	D7(J,I)=(PS1(J,I+1)+PS1(J,I))*0.5D0*HXU(J,I)

117	220  CONTINUE

118	!  DO 230 I=2,MM1

119	!  DO 230 J=1,NN1

120	DO 230 I=ISTART2,IEND1

121	DO 230 J=JSTART,JEND1

122	D8(J,I)=(PS1(J+1,I)+PS1(J,I))*0.5D0*HXV(J,I)

123	230  CONTINUE

124	CALL MPI_BARRIER(COMM2D, MPIERROR)

125

ITAG=50

126	CALL MPI_SENDRECV (D7(1,IEND),     N, MPI_REAL8, T_NBR, ITAG,D7(1,ISTARTM1), N, MPI_REAL8, B_NBR, ITAG,COMM2D, ISTATUS, IERR)

127

ITAG=60

128	CALL MPI_SENDRECV (D8(JEND,1),     1, IVECT_2D, R_NBR, ITAG,D8(JSTARTM1,1), 1, IVECT_2D, L_NBR, ITAG,COMM2D, ISTATUS, IERR)

129	!  DO 240 I=2,MM1

130	!  DO 240 J=2,NN1

131	DO 240 I=ISTART2,IEND1

132	DO 240 J=JSTART2,JEND1

133	DO 240 K=1,KK

134	D00(K,J,I)=(D7(J,I)*U1(K,J,I)-D7(J,I-1)*U1(K,J,I-1))*HMMX(J,I)+(D8(J,I)*V1(K,J,I)-D8(J-1,I)*V1(K,J-1,I))*HMMY(J,I)

135	240  CONTINUE

136	!  DO 260 I=2,MM1

137	DO 260 I=ISTART2,IEND1

138	DO 260 KA=1,KK

139	!  DO 260 J=2,NN1

140	DO 260 J=JSTART2,JEND1

141	DO 260 K=1,KM

142	F1(K,J,I)=F1(K,J,I)-VECINV(K,KA)*D00(KA,J,I)

143	260  CONTINUE

144	SUMF1=0.D0

145	SUMF2=0.D0

146	!  DO 270 I=2,MM1

147	DO 270 I=ISTART2,IEND1

148	!  DO 270 J=2,NN1

149	DO 270 J=JSTART2,JEND1

150	DO 270 K=1,KM

151	F2(K,J,I)=-AM7(K)*PS1(J,I)

152	SUMF1=SUMF1+F1(K,J,I)

153	SUMF2=SUMF2+F2(K,J,I)

154	270  CONTINUE

155	!     输出数据用来验证

156	CALL MPI_BARRIER (COMM2D,IERR)

157

IROOT=0

158	CALL MPI_REDUCE (SUMF1, GSUMF1, 1, MPI_REAL8, MPI_SUM, IROOT, COMM2D, IERR)

159	CALL MPI_REDUCE (SUMF2, GSUMF2, 1, MPI_REAL8, MPI_SUM, IROOT, COMM2D, IERR)

160	KOUNT=KM*(N+2)*(M+2)

161

ITAG=70

162	IF (MY_CID.NE.0) THEN

163	CALL MPI_SEND (F2, KOUNT, MPI_REAL8, IROOT, ITAG, COMM2D, IERR)

164

ELSE

165	CALL COPY1(MY_CID, F2, TT,ISTARTG,JSTARTG)

166	DO ISRC=1,NPROC-1

167	CALL MPI_RECV (F2, KOUNT, MPI_REAL8, ISRC, ITAG,COMM2D, ISTATUS, IERR)

168	CALL COPY1 (ISRC, F2, TT,ISTARTG,JSTARTG)

169

ENDDO

170

ENDIF

171	301  FORMAT(8E10.3)

172	IF(MY_CID.EQ.0) THEN

173	PRINT *,'SUMF1,SUMF2=', GSUMF1,GSUMF2

174	PRINT *,' F2(2,2,I),I=1, 160,5'

175	PRINT 301,(TT(2,2,I),I=1, 160,5)

176

ENDIF

177	CLOCK=MPI_WTIME() - CLOCK

178	PRINT *,' MY_CID, CLOCK TIME=', MY_CID,CLOCK

179	CALL MPI_FINALIZE (IERR)

180

STOP

181

END

182	SUBROUTINE NBR2D(COMM2D, MY_CID, MY_COORD, L_NBR, R_NBR,

183	&                    B_NBR, T_NBR, JP, IP)

184	INCLUDE   'mpif.h'

185	PARAMETER (NDIM=2)

186	INTEGER   COMM2D, MY_CID, MY_COORD(NDIM), L_NBR, R_NBR,

187	&           B_NBR, T_NBR, JP, IP

188	INTEGER   IPART(2), SIDEWAYS, UPDOWN, RIGHT, UP

189	LOGICAL   PERIODS(2), REORDER

190

!

191	IPART(1)=JP

192	IPART(2)=IP

193	PERIODS(1)=.FALSE.

194	PERIODS(2)=.FALSE.

195	REORDER=.TRUE.

196	SIDEWAYS=0

197

UPDOWN=1

198

RIGHT=1

199

UP=1

200	CALL MPI_CART_CREATE ( MPI_COMM_WORLD, NDIM,I PART, PERIODS,REORDER, COMM2d, MPI_ERR)

201	CALL MPI_COMM_RANK ( COMM2D, MY_CID, MPI_ERR)

202	CALL MPI_CART_COORDS( COMM2D, MY_CID, NDIM, MY_COORD, MPI_ERR)

203	CALL MPI_CART_SHIFT( COMM2D,SIDEWAYS,RIGHT,L_NBR,R_NBR,MPI_ERR)

204	CALL MPI_CART_SHIFT( COMM2D, UPDOWN, UP, B_NBR, T_NBR, MPI_ERR)

205	PRINT *,'MY_CID=',MY_CID,', COORD=(',MY_COORD(1),',',MY_COORD(2),')',', L_,R_,T_,B_NBR=', L_NBR,R_NBR,T_NBR,B_NBR

206

RETURN

207

END

208	SUBROUTINE COPY1(ISRC,FF,TT,ISTARTG,JSTARTG)

209	INCLUDE  'mpif.h'

210	!     Copy partitioned array FF to global array TT

211	PARAMETER  (KK=20,NN=120,MM=160, KM=3,MM1=MM-1,NN1=NN-1)

212	PARAMETER  (JP=2, IP=4, N=NN/JP, M=MM/IP, NP=IP*JP)

213	REAL*8       FF(KM,0:N+1,0:M+1),TT(KM,NN,MM),ISTARTG(0:NP),JSTARTG(0:NP)

214	IF(ISRC.LT.IP) THEN

215

JJ=0

216

II=ISRC

217

ELSE

218	JJ=ISRC/IP

219	II=ISRC-JJ*IP

220

ENDIF

221

DO I=1,M

222	IG=ISTARTG(II)+I-1

223

DO J=1,N

224	JG=JSTARTG(JJ)+J-1

225

DO K=1,KM

226	TT(K,JG,IG)=FF(K,J,I)

227

ENDDO

228

ENDDO

229

ENDDO

230

RETURN

231

END

232

233	SUBROUTINE STARTEND(NPROC,IS1,IS2,GSTART,GEND,GCOUNT)

234	INTEGER ID,NPROC,IS1,IS2,NP,GSTART(0:31),GEND(0:31),GCOUNT(0:31)

235

236	LENG=IS2-IS1+1

237	IBLOCK=LENG/NPROC

238

239	IR=LENG-IBLOCK*NPROC

240

241

242	DO I=0,NPROC-1

243

244	IF(I.LT.IR) THEN

245	GSTART(I)=IS1+I*(IBLOCK+1)

246	GEND(I)=GSTART(I)+IBLOCK

247

ELSE

248	GSTART(I)=IS1+I*IBLOCK+IR

249	GEND(I)=GSTART(I)+IBLOCK-1

250

ENDIF

251	IF(LENG.LT.1) THEN

252	GSTART(I)=1

253

GEND(I)=0

254

ENDIF

255	GCOUNT(I)=GEND(I)-GSTART(I)+1

256

ENDDO

257

END