├── .gitattributes └── PoissonSolverMultigrid_good.f90 /.gitattributes: -------------------------------------------------------------------------------- 1 | # Auto detect text files and perform LF normalization 2 | * text=auto 3 | 4 | # Custom for Visual Studio 5 | *.cs diff=csharp 6 | 7 | # Standard to msysgit 8 | *.doc diff=astextplain 9 | *.DOC diff=astextplain 10 | *.docx diff=astextplain 11 | *.DOCX diff=astextplain 12 | *.dot diff=astextplain 13 | *.DOT diff=astextplain 14 | *.pdf diff=astextplain 15 | *.PDF diff=astextplain 16 | *.rtf diff=astextplain 17 | *.RTF diff=astextplain 18 | -------------------------------------------------------------------------------- /PoissonSolverMultigrid_good.f90: -------------------------------------------------------------------------------- 1 | MODULE LevelType 2 | TYPE :: LevelStruct 3 | INTEGER:: ndim 4 | INTEGER:: downsweep 5 | INTEGER:: upsweep 6 | INTEGER:: PlaneMaxDim 7 | INTEGER:: LineMaxDim 8 | INTEGER:: BuffElements 9 | REAL*8 :: dVol 10 | REAL*8,pointer::x(:) 11 | REAL*8,pointer::y(:) 12 | REAL*8,pointer::z(:) 13 | REAL*8,pointer::rhs(:,:,:) 14 | REAL*8,pointer::phi(:,:,:) 15 | 16 | REAL*8,pointer::eps(:,:,:,:) 17 | REAL*8,pointer::err(:,:,:) 18 | 19 | 20 | REAL*8,pointer::PlaneBuffRecv(:,:) 21 | REAL*8,pointer::LineBuffRecV(:,:,:) 22 | REAL*8,pointer::PointBuffRecV(:,:,:) 23 | 24 | INTEGER, pointer:: nElements(:) 25 | INTEGER, pointer:: nb(:) 26 | INTEGER, pointer:: X1(:) 27 | INTEGER, pointer:: X2(:) 28 | INTEGER, pointer:: Y1(:) 29 | INTEGER, pointer:: Y2(:) 30 | INTEGER, pointer:: Z1(:) 31 | INTEGER, pointer:: Z2(:) 32 | 33 | 34 | INTEGER, pointer:: RecV(:,:) 35 | INTEGER, pointer:: SenD(:,:) 36 | INTEGER, pointer:: PlanesSend(:,:) 37 | 38 | INTEGER, pointer:: X1Plane(:,:) 39 | INTEGER, pointer:: X2Plane(:,:) 40 | INTEGER, pointer:: Y1Plane(:,:) 41 | INTEGER, pointer:: Y2Plane(:,:) 42 | INTEGER, pointer:: Z1Plane(:,:) 43 | INTEGER, pointer:: Z2Plane(:,:) 44 | 45 | 46 | 47 | INTEGER, pointer:: RecV1(:,:,:) 48 | INTEGER, pointer:: SenD1(:,:,:) 49 | INTEGER, pointer:: LinesSend(:,:,:) 50 | 51 | 52 | INTEGER, pointer:: RecV2(:,:,:) 53 | INTEGER, pointer:: SenD2(:,:,:) 54 | INTEGER, pointer:: PointsSend(:,:,:) 55 | 56 | INTEGER, pointer:: X1Line(:,:,:) 57 | INTEGER, pointer:: X2Line(:,:,:) 58 | INTEGER, pointer:: Y1Line(:,:,:) 59 | INTEGER, pointer:: Y2Line(:,:,:) 60 | INTEGER, pointer:: Z1Line(:,:,:) 61 | INTEGER, pointer:: Z2Line(:,:,:) 62 | 63 | INTEGER, pointer:: XPoint(:,:,:) 64 | INTEGER, pointer:: YPoint(:,:,:) 65 | INTEGER, pointer:: ZPoint(:,:,:) 66 | 67 | END TYPE LevelStruct 68 | END Module LevelType 69 | 70 | PROGRAM POISSON_MGRID 71 | Use LevelType 72 | IMPLICIT NONE 73 | INCLUDE 'mpif.h' 74 | INTEGER MYID,TOTPS,IERR,stat(MPI_STATUS_SIZE),NCPUS 75 | 76 | !########## GAUSS UNITS IMPLIED ############ 77 | INTEGER I,J,K,L,M,P,NDIM,ITER,MAXITER,MAXDIM,Ip,Im,Jp,Jm,Kp,Km,NDIM2H,NDIM4H,NLEVELS,Jnow 78 | INTEGER :: ndim1,i1,j1,k1,PlaneMaxDim,NBb,II,JJ,KK,MM 79 | REAL*8 A2B,lamCoarse 80 | 81 | 82 | REAL*8 Xmin,Xmax,Ymin,Ymax,Zmin,Zmax,dhX,dhY,dhZ,summ_prev,summE,summEprev,summE1 83 | REAL*8 coeff,d_map,const,R(6),summ,Xoffset,Yoffset,Zoffset,Rpol,summRho,vol,dvol 84 | REAL*8, DIMENSION(:,:,:), ALLOCATABLE :: PHI,RHO 85 | REAL*8, DIMENSION(:,:,:), ALLOCATABLE :: Rk,Rkt,Rk1,Rkt1,Rkp1,Pk,PkT,Rtemp,Rk2H,PHI2H,RHO2H,Rk4H,PHI4H,Rtemp2H 86 | 87 | REAL*8, DIMENSION(:,:,:,:), ALLOCATABLE :: EPS 88 | REAL*8 summ_even,summ_odd,omega,coeff1,coeff2,delta,Pi,summHartree,summHartree1,Xtemp,Ytemp,lamN,Momega 89 | REAL*8 eps1,eps2,eps3,eps4,eps5,eps6,Ztemp,temp1,temp2,temp3,temp,alphaK,betaK,dVol2H,summRhoTemp 90 | REAL*8 lamN1,lamN2,summRes(1000) 91 | REAL t_start(2),t_stop(2),result 92 | REAL, DIMENSION(:), ALLOCATABLE :: X,Y,Z,Xmid,Ymid,Zmid,X2H,Y2H,Z2H 93 | PARAMETER(A2B=1./0.529177249) 94 | PARAMETER(NDIM=120) 95 | PARAMETER(NDIM2H=NDIM/2) 96 | PARAMETER(NDIM4H=NDIM2H/2) 97 | PARAMETER(Xoffset=4.) 98 | PARAMETER(Yoffset=12.) 99 | PARAMETER(Zoffset=5.) 100 | PARAMETER(Rpol=3.) 101 | PARAMETER(MAXITER=22242) 102 | 103 | 104 | 105 | TYPE (LevelStruct), DIMENSION(:), ALLOCATABLE ::Level 106 | 107 | 108 | 109 | 110 | 111 | open (UNIT=85, FILE='eps', STATUS='unknown') 112 | 113 | 114 | 115 | open (UNIT=86, FILE='contour', STATUS='unknown') 116 | open (UNIT=84, FILE='potential', STATUS='unknown') 117 | open (UNIT=83, FILE='field_magniture', STATUS='unknown') 118 | open (UNIT=101, FILE='field', STATUS='unknown') 119 | 120 | open (UNIT=103, FILE='ratioHelm_par.dat', STATUS='unknown') 121 | open (UNIT=104, FILE='residiual.dat', STATUS='unknown') 122 | 123 | 124 | Pi=4.*Atan(1.) 125 | 126 | 127 | call mpi_init( IERR) 128 | call MPI_COMM_RANK(MPI_COMM_WORLD,MYID,IERR) 129 | call MPI_COMM_SIZE(MPI_COMM_WORLD,NCPUS,IERR) 130 | 131 | 132 | ALLOCATE(EPS(6,NDIM,NDIM,NDIM)) 133 | ALLOCATE(RHO(NDIM,NDIM,NDIM)) 134 | ALLOCATE(PHI(NDIM,NDIM,NDIM)) 135 | 136 | 137 | 138 | ALLOCATE(X(NDIM)) 139 | ALLOCATE(Y(NDIM)) 140 | ALLOCATE(Z(NDIM)) 141 | 142 | 143 | 144 | 145 | 146 | lamN1=0.99 147 | lamN2=0.99 148 | lamCoarse=0.92 149 | 150 | !lamN1=0.993 151 | !lamN2=0.993 152 | !lamCoarse=0.92 153 | 154 | 155 | call GetNLevels(NDIM,nlevels) 156 | ! nlevels=2 157 | ! nlevels=3 158 | ALLOCATE(Level(nlevels)) 159 | 160 | ndim1=ndim 161 | DO i=nlevels,1,-1 162 | write(*,*) "NLEVELS=",nlevels,ndim1 163 | Level(i)%ndim=ndim1 164 | ALLOCATE(level(i)%x(ndim1)) 165 | ALLOCATE(level(i)%y(ndim1)) 166 | ALLOCATE(level(i)%z(ndim1)) 167 | ALLOCATE(level(i)%rhs(ndim1,ndim1,ndim1)) 168 | ALLOCATE(level(i)%err(ndim1,ndim1,ndim1)) 169 | ALLOCATE(level(i)%phi(ndim1,ndim1,ndim1)) 170 | ALLOCATE(level(i)%eps(6,ndim1,ndim1,ndim1)) 171 | ALLOCATE(level(i)%X1(NCPUS)) 172 | ALLOCATE(level(i)%X2(NCPUS)) 173 | ALLOCATE(level(i)%Y1(NCPUS)) 174 | ALLOCATE(level(i)%Y2(NCPUS)) 175 | ALLOCATE(level(i)%Z1(NCPUS)) 176 | ALLOCATE(level(i)%Z2(NCPUS)) 177 | ALLOCATE(level(i)%Nb(NCPUS)) 178 | ALLOCATE(level(i)%Nelements(NCPUS)) 179 | ALLOCATE(level(i)%RecV(NCPUS,6)) 180 | ALLOCATE(level(i)%SenD(NCPUS,6)) 181 | ALLOCATE(level(i)%PlanesSend(NCPUS,6)) 182 | ALLOCATE(level(i)%X1Plane(NCPUS,6)) 183 | ALLOCATE(level(i)%X2Plane(NCPUS,6)) 184 | ALLOCATE(level(i)%Y1Plane(NCPUS,6)) 185 | ALLOCATE(level(i)%Y2Plane(NCPUS,6)) 186 | ALLOCATE(level(i)%Z1Plane(NCPUS,6)) 187 | ALLOCATE(level(i)%Z2Plane(NCPUS,6)) 188 | ALLOCATE(level(i)%RecV1(NCPUS,6,4)) 189 | ALLOCATE(level(i)%SenD1(NCPUS,6,4)) 190 | ALLOCATE(level(i)%LinesSend(NCPUS,6,4)) 191 | ALLOCATE(level(i)%PointsSend(NCPUS,6,4)) 192 | ALLOCATE(level(i)%X1Line(4,NCPUS,6)) 193 | ALLOCATE(level(i)%X2Line(4,NCPUS,6)) 194 | ALLOCATE(level(i)%Y1Line(4,NCPUS,6)) 195 | ALLOCATE(level(i)%Y2Line(4,NCPUS,6)) 196 | ALLOCATE(level(i)%Z1Line(4,NCPUS,6)) 197 | ALLOCATE(level(i)%Z2Line(4,NCPUS,6)) 198 | ALLOCATE(level(i)%RecV2(NCPUS,6,4)) 199 | ALLOCATE(level(i)%SenD2(NCPUS,6,4)) 200 | ALLOCATE(level(i)%PointsSend(NCPUS,6,4)) 201 | ALLOCATE(level(i)%XPoint(4,NCPUS,6)) 202 | ALLOCATE(level(i)%YPoint(4,NCPUS,6)) 203 | ALLOCATE(level(i)%ZPoint(4,NCPUS,6)) 204 | level(i)%phi=0. 205 | level(i)%err=0. 206 | level(i)%rhs=0. 207 | level(i)%downsweep=3 208 | level(i)%upsweep=4 209 | ndim1=ndim1/2 210 | ENDDO 211 | 212 | 213 | call INITIALIZE(MYID,NCPUS,LEVEL(nlevels),LEVEL(nlevels),nlevels,nlevels) 214 | DO i=nlevels-1,1,-1 215 | call INITIALIZE(MYID,NCPUS,LEVEL(i),LEVEL(i+1),i,nlevels) 216 | ENDDO 217 | 218 | 219 | 220 | DO i=nlevels,1,-1 221 | call GetNelements(NCPUS,LEVEL(i)) 222 | ALLOCATE(level(i)%PlaneBuffRecV(level(i)%PlaneMaxDim+7,level(i)%NB(MYID+1))) 223 | ALLOCATE(level(i)%LineBuffRecV(level(i)%LineMaxDim+7,level(i)%NB(MYID+1),4)) 224 | ALLOCATE(level(i)%PointBuffRecV(5,level(i)%NB(MYID+1),4)) 225 | level(i)%BUFFElements=MAXVAL(level(i)%NElements) 226 | IF(MYID.eq.0) write(*,*) "PlaneMaxDim,levelN ", Level(i)%PlaneMaxDim,level(i)%BUFFELEMENTS,i 227 | ENDDO 228 | 229 | call ReadData(vol,LEVEL(nlevels)) 230 | 231 | DO i=nlevels-1,1,-1 232 | call propagateXYZ(LEVEL(I+1),LEVEL(I)) 233 | ENDDO 234 | 235 | 236 | DO i=nlevels,1,-1 237 | call fillEps(level(i),Xoffset,Yoffset,Zoffset) 238 | ENDDO 239 | 240 | 241 | 242 | summ=0. 243 | summ_prev=0. 244 | 245 | level(nlevels)%rhs(:,:,:)=level(nlevels)%rhs(:,:,:)*level(nlevels)%eps(2,:,:,:) 246 | level(nlevels)%phi=0. 247 | 248 | 249 | 250 | !DO I=1,NDIM 251 | ! DO J=1,NDIM 252 | ! DO K=1,NDIM 253 | ! IF(MYID.eq.0) write(84,*) level(nlevels)%rhs(i,j,k) 254 | !ENDDO 255 | !ENDDO 256 | !ENDDO 257 | 258 | 123 continue 259 | write(*,*) "**********************************" 260 | call etime (t_start,result) 261 | Jnow=0 262 | ! call MPI_BARRIER(MPI_COMM_WORLD,IERR) 263 | DO J=1,90 264 | call MPI_BARRIER(MPI_COMM_WORLD,IERR) 265 | call GaussSeidelSmoothSOR(LEVEL(nlevels),level(nlevels)%downsweep,Vol,1,1,lamN1,NCPUS,MYID,MPI_COMM_WORLD) 266 | call computeDefectpar(MYID,NCPUS,LeveL(nlevels),MPI_COMM_WORLD,summE,1) 267 | call MPI_ALLREDUCE(summE,summE1,1,MPI_DOUBLE_PRECISION,MPI_SUM,MPI_COMM_WORLD,IERR) 268 | summRes(J)=summE1 269 | IF(DSQRT(summRes(J)).le.1.d-5) goto 122 270 | IF(MYID.eq.0) write(*,*) DSQRT(summE1),J 271 | 272 | DO I=Nlevels-1,1,-1 273 | level(i)%phi=0. 274 | if(i.eq.1) then 275 | call restrictDefectpar(MYID,Level(i+1),Level(i),MPI_COMM_WORLD) 276 | call GaussSeidelSmoothSOR(LEVEL(i),22,Vol,0,1,lamCoarse,NCPUS,MYID,MPI_COMM_WORLD) 277 | else 278 | call restrictDefectpar(MYID,Level(i+1),Level(i),MPI_COMM_WORLD) 279 | call GaussSeidelSmoothSOR(LEVEL(i),LEVEL(i)%downsweep,Vol,1,1,lamN1,NCPUS,MYID,MPI_COMM_WORLD) 280 | call computeDefectpar(MYID,NCPUS,LeveL(i),MPI_COMM_WORLD,summE,0) 281 | endif 282 | ENDDO 283 | 284 | 285 | DO I=1,Nlevels-1 286 | call prolongateDefectpar(MYID,Level(i+1),Level(i),MPI_COMM_WORLD) 287 | call GaussSeidelSmoothSOR(LEVEL(i+1),LEVEL(i+1)%upsweep,Vol,0,1,lamN2,NCPUS,MYID,MPI_COMM_WORLD) 288 | ENDDO 289 | ENDDO 290 | 291 | 292 | 293 | 122 continue 294 | call etime (t_stop,result ) 295 | IF(MYID.eq.0) write(*,*) "Elapsed time", t_stop(1)-t_start(1),t_stop(2)-t_start(2) 296 | dhX=ABS(level(nlevels)%x(2)-level(nlevels)%x(1)) 297 | summ=0. 298 | DO K=LEVEL(nlevels)%Z1(MYID+1),LEVEL(nlevels)%Z2(MYID+1) 299 | DO J=LEVEL(nlevels)%Y1(MYID+1),LEVEL(nlevels)%Y2(MYID+1) 300 | DO I=LEVEL(nlevels)%X1(MYID+1),LEVEL(nlevels)%X2(MYID+1) 301 | summ=summ+level(nlevels)%phi(i,j,k)*level(nlevels)%eps(2,i,j,k)*level(nlevels)%rhs(i,j,k)/(4.*PI)*dhX*0.5 302 | ENDDO 303 | ENDDO 304 | ENDDO 305 | call MPI_ALLREDUCE(summ,summE,1,MPI_DOUBLE_PRECISION,MPI_SUM,MPI_COMM_WORLD,IERR) 306 | IF(MYID.eq.0) write(*,*) "Energy=",summE 307 | IF(MYID.eq.0) write(*,*) "I'm here" 308 | 309 | 310 | 311 | 312 | DEALLOCATE(EPS) 313 | DEALLOCATE(PHI) 314 | DEALLOCATE(X) 315 | DEALLOCATE(Y) 316 | DEALLOCATE(Z) 317 | DEALLOCATE(RHO) 318 | 319 | DO i=nlevels,1,-1 320 | 321 | 322 | DEALLOCATE(level(i)%x) 323 | DEALLOCATE(level(i)%y) 324 | DEALLOCATE(level(i)%z) 325 | DEALLOCATE(level(i)%rhs) 326 | DEALLOCATE(level(i)%err) 327 | DEALLOCATE(level(i)%phi) 328 | DEALLOCATE(level(i)%eps) 329 | 330 | 331 | DEALLOCATE(level(i)%X1) 332 | DEALLOCATE(level(i)%X2) 333 | DEALLOCATE(level(i)%Y1) 334 | DEALLOCATE(level(i)%Y2) 335 | DEALLOCATE(level(i)%Z1) 336 | DEALLOCATE(level(i)%Z2) 337 | 338 | DEALLOCATE(level(i)%Nb) 339 | DEALLOCATE(level(i)%Nelements) 340 | 341 | DEALLOCATE(level(i)%RecV) 342 | DEALLOCATE(level(i)%SenD) 343 | DEALLOCATE(level(i)%PlanesSend) 344 | 345 | DEALLOCATE(level(i)%X1Plane) 346 | DEALLOCATE(level(i)%X2Plane) 347 | DEALLOCATE(level(i)%Y1Plane) 348 | DEALLOCATE(level(i)%Y2Plane) 349 | DEALLOCATE(level(i)%Z1Plane) 350 | DEALLOCATE(level(i)%Z2Plane) 351 | 352 | 353 | DEALLOCATE(level(i)%RecV1) 354 | DEALLOCATE(level(i)%SenD1) 355 | DEALLOCATE(level(i)%LinesSend) 356 | 357 | DEALLOCATE(level(i)%X1Line) 358 | DEALLOCATE(level(i)%X2Line) 359 | DEALLOCATE(level(i)%Y1Line) 360 | DEALLOCATE(level(i)%Y2Line) 361 | DEALLOCATE(level(i)%Z1Line) 362 | DEALLOCATE(level(i)%Z2Line) 363 | 364 | 365 | DEALLOCATE(level(i)%RecV2) 366 | DEALLOCATE(level(i)%SenD2) 367 | DEALLOCATE(level(i)%PointsSend) 368 | 369 | DEALLOCATE(level(i)%XPoint) 370 | DEALLOCATE(level(i)%YPoint) 371 | DEALLOCATE(level(i)%ZPoint) 372 | 373 | 374 | 375 | 376 | DEALLOCATE(level(i)%PlaneBuffRecV) 377 | DEALLOCATE(level(i)%LineBuffRecV) 378 | DEALLOCATE(level(i)%PointBuffRecV) 379 | 380 | ENDDO 381 | DEALLOCATE(level) 382 | END PROGRAM POISSON_MGRID 383 | 384 | 385 | 386 | 387 | 388 | 389 | SUBROUTINE computeDefectpar(MYID,NCPUS,LeveL,COMM,summE,flag) 390 | Use LevelType 391 | IMPLICIT NONE 392 | INCLUDE 'mpif.h' 393 | INTEGER :: MYID,IERR,stat(MPI_STATUS_SIZE),COMM,JJ,II,KK,Df1,Df2,PNT,CNT,Df3 394 | INTEGER :: NCPUS,PlaneMaxDim,NBI,FLAG1,NN,FLAG2 395 | REAL*8 :: phiIm,phiIp,phiJm,phiJp,phiKm,phiKp,summE 396 | INTEGER :: CpuN 397 | INTEGER :: NDIM,ITER,MAXITER,I,J,K,IP,IM,JP,JM,KP,KM,P,NDIM2,CNT2,CNT1,flag,M,O,CNTTT 398 | 399 | REAL*8 :: SUMMHARTREE,EPS1,D_MAP,const,diag,offdiag,tmp 400 | TYPE (LevelStruct)::Level 401 | 402 | 403 | 404 | CpuN=MYID+1 405 | 406 | NDIM=LEVEL%NDIM 407 | 408 | 409 | ! call UpdateBoundary(MYID,Level,COMM,0) 410 | summE=0. 411 | IF(FLAG.eq.1) THEN 412 | DO K=LEVEL%Z1(CpuN),LEVEL%Z2(CpuN) 413 | DO J=LEVEL%Y1(CpuN),LEVEL%Y2(CpuN) 414 | DO I=LEVEL%X1(CpuN),LEVEL%X2(CpuN) 415 | ip=I+1 416 | im=I-1 417 | jp=J+1 418 | jm=J-1 419 | kp=K+1 420 | km=K-1 421 | IF(I.EQ.NDIM) ip=1 422 | IF(J.EQ.NDIM) jp=1 423 | IF(K.EQ.NDIM) kp=1 424 | IF(I.EQ.1) im=NDIM 425 | IF(J.EQ.1) jm=NDIM 426 | IF(K.EQ.1) km=NDIM 427 | 428 | phiIm=LEVEL%phi(im,j,k) 429 | phiIp=LEVEL%phi(ip,j,k) 430 | phiJm=LEVEL%phi(i,jm,k) 431 | phiJp=LEVEL%phi(i,jp,k) 432 | phiKm=LEVEL%phi(i,j,km) 433 | phiKp=LEVEL%phi(i,j,kp) 434 | eps1=LEVEL%eps(5,i,j,k) 435 | const=(6.+eps1) 436 | offdiag=-(phiIm+phiIp+phiJm+phiJp+phiKm+phiKp) 437 | diag=const*LEVEL%phi(i,j,k) 438 | tmp=LEVEL%rhs(I,J,K)-(diag+offdiag) 439 | summE=summE+tmp*tmp 440 | LEVEL%err(I,J,K)=tmp 441 | ENDDO 442 | ENDDO 443 | ENDDO 444 | 445 | ELSE 446 | DO K=LEVEL%Z1(CpuN),LEVEL%Z2(CpuN) 447 | DO J=LEVEL%Y1(CpuN),LEVEL%Y2(CpuN) 448 | DO I=LEVEL%X1(CpuN),LEVEL%X2(CpuN) 449 | ip=I+1 450 | im=I-1 451 | jp=J+1 452 | jm=J-1 453 | kp=K+1 454 | km=K-1 455 | IF(I.EQ.NDIM) ip=1 456 | IF(J.EQ.NDIM) jp=1 457 | IF(K.EQ.NDIM) kp=1 458 | IF(I.EQ.1) im=NDIM 459 | IF(J.EQ.1) jm=NDIM 460 | IF(K.EQ.1) km=NDIM 461 | phiIm=LEVEL%phi(im,j,k) 462 | phiIp=LEVEL%phi(ip,j,k) 463 | phiJm=LEVEL%phi(i,jm,k) 464 | phiJp=LEVEL%phi(i,jp,k) 465 | phiKm=LEVEL%phi(i,j,km) 466 | phiKp=LEVEL%phi(i,j,kp) 467 | eps1=LEVEL%eps(5,i,j,k) 468 | const=(6.+eps1) 469 | offdiag=-(phiIm+phiIp+phiJm+phiJp+phiKm+phiKp) 470 | diag=const*LEVEL%phi(i,j,k) 471 | LEVEL%err(I,J,K)=LEVEL%rhs(I,J,K)-(diag+offdiag) 472 | ENDDO 473 | ENDDO 474 | ENDDO 475 | ENDIF 476 | 477 | END SUBROUTINE computeDefectpar 478 | 479 | 480 | 481 | SUBROUTINE restrictDefectpar(MYID,Level,Level1,COMM) 482 | Use LevelType 483 | IMPLICIT NONE 484 | INCLUDE 'mpif.h' 485 | REAL*8 summE,summE1 486 | INTEGER NDIM,NDIM2H,I,J,K,Ih,Jh,Kh,Im,Jm,Km,Ip,Jp,Kp,MYID,CpuN,COMM 487 | REAL*8 temp,tmp1 488 | TYPE (LevelStruct)::Level,Level1 489 | 490 | NDIM=LEVEL%NDIM 491 | NDIM2H=LEVEL1%NDIM 492 | CpuN=MYID+1 493 | 494 | call UPDATE(MYID,LEVEL,COMM,1) 495 | call UpdateBoundary(MYID,Level,COMM,1) 496 | 497 | summE=0. 498 | temp=1./64. 499 | 500 | DO K=LEVEL1%Z1(CpuN),LEVEL1%Z2(CpuN) 501 | DO J=LEVEL1%Y1(CpuN),LEVEL1%Y2(CpuN) 502 | DO I=LEVEL1%X1(CpuN),LEVEL1%X2(CpuN) 503 | Ih=2*I-1 504 | Jh=2*J-1 505 | Kh=2*K-1 506 | Ip=MOD(Ih,NDIM)+1 507 | Im=Ih-1 508 | Jp=MOD(Jh,NDIM)+1 509 | Jm=Jh-1 510 | Kp=MOD(Kh,NDIM)+1 511 | Km=Kh-1 512 | IF(Ih.EQ.1) Im=NDIM 513 | IF(Jh.EQ.1) Jm=NDIM 514 | IF(Kh.EQ.1) Km=NDIM 515 | 516 | 517 | tmp1=(4.*LEVEL%ERR(Ih,Jh,Km)+2.*LEVEL%ERR(Im,Jh,Km)+2.*LEVEL%ERR(Ip,Jh,Km)+2.*LEVEL%ERR(Ih,Jm,Km)+2.*LEVEL%ERR(Ih,Jp,Km)+LEVEL%ERR(Im,Jp,Km)& 518 | &+LEVEL%ERR(Im,Jm,Km)+LEVEL%ERR(Ip,Jm,Km)+LEVEL%ERR(Ip,Jp,Km)) 519 | tmp1=(8.*LEVEL%ERR(Ih,Jh,Kh)+4.*LEVEL%ERR(Im,Jh,Kh)+4.*LEVEL%ERR(Ip,Jh,Kh)+4.*LEVEL%ERR(Ih,Jm,Kh)+4.*LEVEL%ERR(Ih,Jp,Kh)+2.*LEVEL%ERR(Im,Jp,Km)& 520 | & +2.*LEVEL%ERR(Im,Jm,Km)+2.*LEVEL%ERR(Ip,Jm,Km)+2.*LEVEL%ERR(Ip,Jp,Km))+tmp1 521 | 522 | tmp1=(4.*LEVEL%ERR(Ih,Jh,Kp)+2.*LEVEL%ERR(Im,Jh,Kp)+2.*LEVEL%ERR(Ip,Jh,Kp)+2.*LEVEL%ERR(Ih,Jm,Kp)+2.*LEVEL%ERR(Ih,Jp,Kp)+LEVEL%ERR(Im,Jp,Kp)& 523 | &+LEVEL%ERR(Im,Jm,Kp)+LEVEL%ERR(Ip,Jm,Kp)+LEVEL%ERR(Ip,Jp,Kp))+tmp1 524 | LEVEL1%RHS(I,J,K)=tmp1*temp 525 | !LEVEL1%RHS(I,J,K)=1. 526 | ENDDO 527 | ENDDO 528 | ENDDO 529 | 530 | 531 | END SUBROUTINE restrictDefectpar 532 | 533 | 534 | 535 | 536 | 537 | SUBROUTINE prolongateDefectpar(MYID,Level,Level1,COMM) 538 | Use LevelType 539 | 540 | IMPLICIT NONE 541 | INCLUDE 'mpif.h' 542 | INTEGER NDIM,NDIM2H,I1,J1,K1,Ih,Jh,Kh,Im,Jm,Km,Ip,Jp,Kp,I,J,K,MYID,CpuN,COMM 543 | 544 | TYPE (LevelStruct)::Level,Level1 545 | REAL*8 tmp1,tmp2,tmp3,tmp4,tmp5,tmp6,tmp7,tmp8,PhiIp,PhiJp,PhiKp,PhiIpJp,PhiIpKp,PhiJpKp 546 | REAL*8 Half,Fourth,Eighth 547 | CpuN=MYID+1 548 | 549 | NDIM2H=Level1%NDIM 550 | NDIM=Level%NDIM 551 | 552 | Half=1./2. 553 | Fourth=1./4. 554 | Eighth=1./8. 555 | DO K=LEVEL1%Z1(CpuN),LEVEL1%Z2(CpuN) 556 | DO J=LEVEL1%Y1(CpuN),LEVEL1%Y2(CpuN) 557 | DO I=LEVEL1%X1(CpuN),LEVEL1%X2(CpuN) 558 | 559 | Ih=2*I-1 560 | Jh=2*J-1 561 | Kh=2*K-1 562 | 563 | Ip=MOD(I,NDIM2H)+1 564 | 565 | Jp=MOD(J,NDIM2H)+1 566 | 567 | Kp=MOD(K,NDIM2H)+1 568 | 569 | PhiIp=LEVEL1%phi(Ip,J,K) 570 | PhiJp=LEVEL1%phi(I,Jp,K) 571 | PhiKp=LEVEL1%phi(I,J,Kp) 572 | PhiJpKp=LEVEL1%phi(I,Jp,Kp) 573 | PhiIpKp=LEVEL1%phi(Ip,J,Kp) 574 | PhiIpJp=LEVEL1%phi(Ip,Jp,K) 575 | tmp1=LEVEL1%phi(I,J,K) 576 | tmp2=Half*(tmp1+PhiIp) 577 | tmp3=Half*(tmp1+PhiJp) 578 | tmp4=Half*(tmp1+PhiKp) 579 | 580 | tmp5=Fourth*(tmp1+PhiKp+PhiJp+PhiJpKp) 581 | tmp6=Fourth*(tmp1+PhiIp+PhiJp+PhiIpJp) 582 | tmp7=Fourth*(tmp1+PhiIp+PhiKp+PhiIpKp) 583 | 584 | tmp8=Eighth*(tmp1+PhiIp+PhiJp+PhiKp+PhiIpJp+PhiIpKp+PhiJpKp+LEVEL1%phi(Ip,Jp,Kp)) 585 | 586 | 587 | LEVEL%phi(Ih,Jh,Kh)=LEVEL%phi(Ih,Jh,Kh)+tmp1 588 | LEVEL%phi(Ih+1,Jh,Kh)=LEVEL%phi(Ih+1,Jh,Kh)+tmp2 589 | LEVEL%phi(Ih,Jh+1,Kh)=LEVEL%phi(Ih,Jh+1,Kh)+tmp3 590 | LEVEL%phi(Ih,Jh,Kh+1)=LEVEL%phi(Ih,Jh,Kh+1)+tmp4 591 | 592 | LEVEL%phi(Ih,Jh+1,Kh+1)=LEVEL%phi(Ih,Jh+1,Kh+1)+tmp5 593 | LEVEL%phi(Ih+1,Jh+1,Kh)=LEVEL%phi(Ih+1,Jh+1,Kh)+tmp6 594 | LEVEL%phi(Ih+1,Jh,Kh+1)=LEVEL%phi(Ih+1,Jh,Kh+1)+tmp7 595 | 596 | LEVEL%phi(Ih+1,Jh+1,Kh+1)=LEVEL%phi(Ih+1,Jh+1,Kh+1)+tmp8 597 | 598 | ENDDO 599 | ENDDO 600 | ENDDO 601 | 602 | 603 | END SUBROUTINE prolongateDefectpar 604 | 605 | 606 | 607 | 608 | 609 | 610 | 611 | 612 | SUBROUTINE GaussSeidelSmoothSOR(LEVEL,MAXITER,Vol,flag,flag1,lamN,NCPUS,MYID,COMM) 613 | Use LevelType 614 | IMPLICIT NONE 615 | INCLUDE 'mpif.h' 616 | INTEGER MYID,IERR,stat(MPI_STATUS_SIZE),COMM,JJ,II,KK,Df1,Df2,PNT,CNT,Df3 617 | INTEGER NCPUS,PlaneMaxDim,NBI,FLAG1,NN,FLAG2 618 | REAL*8 :: phiIm,phiIp,phiJm,phiJp,phiKm,phiKp,summE 619 | INTEGER:: XrecV(7,6),CpuN,Nelements(NCPUS),firstTimeflagX,firstTimeflagY,firstTimeflagZ,X1s,X2s,Y1s,Y2s,Z1s,Z2s 620 | INTEGER NDIM,ITER,MAXITER,I,J,K,IP,IM,JP,JM,KP,KM,P,NDIM2,CNT2,CNT1,flag,M,O,CNTTT 621 | REAL*8 SUMMHARTREE,EPS1,EPS2,EPS3,EPS4,EPS5,EPS6,D_MAP,summ,summ_prev,error 622 | REAL*8 Vol,coeff2,omega,coeff1,summ1,IND(7),lamN,Momega,summHRecv,summRecV,summE1 623 | INTEGER,SAVE:: FirstTime=1 624 | LOGICAL FlagRB 625 | TYPE (LevelStruct)::Level 626 | 627 | NDIM=LEVEL%NDIM 628 | omega=2./(1.+SQRT(1.-lamN)) 629 | Momega=1.-omega 630 | CpuN=MYID+1 631 | summRecV=0. 632 | summHRecV=0. 633 | 634 | summE=0. 635 | DO K=LEVEL%Z1(CpuN),LEVEL%Z2(CpuN) 636 | DO J=LEVEL%Y1(CpuN),LEVEL%Y2(CpuN) 637 | DO I=LEVEL%X1(CpuN),LEVEL%X2(CpuN) 638 | summE=summE+abs(LEVEL%rhs(i,j,k)) 639 | ENDDO 640 | ENDDO 641 | ENDDO 642 | 643 | call MPI_ALLREDUCE(summE,summE1,1,MPI_DOUBLE_PRECISION,MPI_SUM,COMM,IERR) 644 | IF(MYID.eq.0) write(*,*) "SMOTRI=ABS(PHI)=",summE1 645 | 646 | DO ITER=1,MAXITER 647 | ! call MPI_BARRIER(COMM,IERR) 648 | call UPDATE(MYID,LEVEL,COMM,0) 649 | summHartree=0. 650 | summ_prev=summRecV 651 | summ=0. 652 | FlagRB=.TRUE. 653 | call ITERATE(LEVEL,FlagRB,lamN,MYID,COMM,0) 654 | FlagRB=.FALSE. 655 | call MPI_BARRIER(COMM,IERR) 656 | call UPDATE(MYID,LEVEL,COMM,0) 657 | call ITERATE(LEVEL,FlagRB,lamN,MYID,COMM,0) 658 | DO K=LEVEL%Z1(CpuN),LEVEL%Z2(CpuN) 659 | DO J=LEVEL%Y1(CpuN),LEVEL%Y2(CpuN) 660 | DO I=LEVEL%X1(CpuN),LEVEL%X2(CpuN) 661 | coeff2=LEVEL%phi(i,j,k) 662 | summ=abs(LEVEL%phi(i,j,k))+summ 663 | summHartree=summHartree+coeff2*LEVEL%eps(2,i,j,k) 664 | ENDDO 665 | ENDDO 666 | ENDDO 667 | 668 | summHartree=summHartree*LEVEL%dVol 669 | summHartree=summHartree/Vol 670 | 671 | call MPI_ALLREDUCE(summHartree,summHRecv,1,MPI_DOUBLE_PRECISION,MPI_SUM,COMM,IERR) 672 | call MPI_ALLREDUCE(summ,summRecv,1,MPI_DOUBLE_PRECISION,MPI_SUM,COMM,IERR) 673 | 674 | 675 | IF(MYID.eq.0) write(*,*) "summHreCv=",summHRecV,LEVEL%dVol,Vol 676 | 677 | IF(FLAG1.eq.1) THEN 678 | DO K=LEVEL%Z1(CpuN),LEVEL%Z2(CpuN) 679 | DO J=LEVEL%Y1(CpuN),LEVEL%Y2(CpuN) 680 | DO I=LEVEL%X1(CpuN),LEVEL%X2(CpuN) 681 | LEVEL%PHI(I,J,K)=LEVEL%PHI(I,J,K)*LEVEL%eps(2,I,J,K) 682 | LEVEL%PHI(I,J,K)=LEVEL%PHI(I,J,K)-summHRecV 683 | LEVEL%PHI(I,J,K)=LEVEL%PHI(I,J,K)/LEVEL%eps(2,I,J,K) 684 | ENDDO 685 | ENDDO 686 | ENDDO 687 | 688 | ENDIF 689 | 690 | 691 | IF(MYID.eq.0) then 692 | IF(flag.eq.1) WRITE(*,*) "Error",ABS(summRecV-summ_prev)/summRecV*100,ITER 693 | ENDIF 694 | 695 | ENDDO 696 | 697 | 698 | call UPDATE(MYID,LEVEL,COMM,0) 699 | call UpdateBoundary(MYID,Level,COMM,0) 700 | 701 | 702 | END SUBROUTINE GaussSeidelSmoothSOR 703 | 704 | 705 | 706 | 707 | 708 | 709 | SUBROUTINE GetNLevels(NDIM,nlevels) 710 | IMPLICIT NONE 711 | INTEGER I,J,K,NDIM,nlevels,NDIM1 712 | nlevels=1 713 | 714 | 715 | NDIM1=NDIM 716 | DO WHILE(1.GT.0) 717 | IF(MOD(NDIM1,2).EQ.0.AND.NDIM1/2.GE.10) THEN 718 | ! IF(MOD(NDIM,2).EQ.0.AND.NDIM.GE.8) THEN 719 | ! IF(MOD(NDIM,2).EQ.0) THEN 720 | nlevels=nlevels+1 721 | NDIM1=NDIM1/2 722 | ELSE 723 | goto 122 724 | ENDIF 725 | 726 | ENDDO 727 | 122 continue 728 | END SUBROUTINE GetNLevels 729 | 730 | 731 | SUBROUTINE ReadData(vol,LEVEL) 732 | USE levelType 733 | IMPLICIT NONE 734 | INTEGER I,J,K 735 | REAL*8 summRho 736 | REAL*8 Xtemp,Ytemp,Ztemp,A2B,dhX,dhY,dhZ,Xmin,Ymin,Zmin,Xmax,Ymax,Zmax,dVol,Pi,vol 737 | TYPE (LevelStruct)::Level 738 | 739 | 740 | 741 | open (UNIT=82, FILE='sim_rho_r.dat', STATUS='OLD') 742 | !open (UNIT=102, FILE='hartree.dat', STATUS='OLD') 743 | 744 | 745 | 746 | write(*,*) LEVEL%ndim 747 | !pause 748 | A2B=1./0.529177249 749 | Pi=4.*Atan(1.d0) 750 | summRho=0. 751 | DO K=1,LEVEL%NDIM 752 | DO J=1,LEVEL%NDIM 753 | DO I=1,LEVEL%NDIM 754 | READ(82,*) LEVEL%X(I),LEVEL%Y(J),LEVEL%Z(K),LEVEL%RHS(i,j,k) 755 | summRho=summRho+LEVEL%RHS(i,j,k) 756 | ! READ(102,*) Xtemp,Ytemp,Ztemp,vHartree(I,J,K) 757 | ENDDO 758 | ENDDO 759 | ENDDO 760 | 761 | 762 | 763 | 764 | LEVEL%X=LEVEL%X*A2B 765 | LEVEL%Y=LEVEL%Y*A2B 766 | LEVEL%Z=LEVEL%Z*A2B 767 | write(*,*) LEVEL%X(1),LEVEL%X(LEVEL%NDIM-1) 768 | write(*,*) LEVEL%X(1),LEVEL%X(LEVEL%NDIM-1) 769 | 770 | dhX=ABS(LEVEL%X(2)-LEVEL%X(1)) 771 | dhY=ABS(LEVEL%Y(2)-LEVEL%Y(1)) 772 | dhZ=ABS(LEVEL%Z(2)-LEVEL%Z(1)) 773 | 774 | 775 | Xmin=MINVAL(LEVEL%X) 776 | Ymin=MINVAL(LEVEL%Y) 777 | Zmin=MINVAL(LEVEL%Z) 778 | Xmax=MAXVAL(LEVEL%X) 779 | Ymax=MAXVAL(LEVEL%Y) 780 | Zmax=MAXVAL(LEVEL%Z) 781 | 782 | 783 | LEVEL%dvol=dhX*dhY*dhZ 784 | vol=(Xmax-Xmin+dhX)*(Ymax-Ymin+dhY)*(Zmax-Zmin+dhZ) 785 | 786 | 787 | 788 | write(*,*) "vol,dvol =",vol,LEVEL%dVol,dhX 789 | write(*,*) "SumRho before =",summRho*dVol 790 | 791 | write(*,*) "X(0), X(NDIM) =",LEVEL%X(1)/A2B, LEVEL%X(LEVEL%NDIM)/A2B 792 | 793 | LEVEL%RHS=LEVEL%RHS-summRho/Vol*LEVEL%dVol 794 | 795 | 796 | LEVEL%RHS=LEVEL%RHS*4.*Pi*dhX*dhX 797 | 798 | summRho=0. 799 | 800 | 801 | 802 | DO K=1,LEVEL%NDIM 803 | DO J=1,LEVEL%NDIM 804 | DO I=1,LEVEL%NDIM 805 | summRho=summRho+LEVEL%RHS(i,j,k)*LEVEL%dVol 806 | ENDDO 807 | ENDDO 808 | ENDDO 809 | 810 | 811 | write(*,*) "SumRho after =",summRho*LEVEL%dVol 812 | write(*,*) Xmin,Ymin,Zmin 813 | write(*,*) Xmax,Ymax,Zmax 814 | 815 | close (82) 816 | close (102) 817 | 818 | 819 | 820 | END SUBROUTINE ReadData 821 | 822 | 823 | 824 | 825 | !SUBROUTINE propagateXYZ(Xb,Yb,Zb,X,Y,Z,NDIMb,NDIM) 826 | SUBROUTINE propagateXYZ(LEVEL1,LEVEL) 827 | USE levelType 828 | IMPLICIT NONE 829 | INTEGER I,Ism 830 | TYPE (LevelStruct)::LEVEL,LEVEL1 831 | 832 | 833 | DO I=1,LEVEL%NDIM 834 | LEVEL%X(I)=LEVEL1%X(2*I-1) 835 | LEVEL%Y(I)=LEVEL1%Y(2*I-1) 836 | LEVEL%Z(I)=LEVEL1%Z(2*I-1) 837 | ENDDO 838 | 839 | 840 | END SUBROUTINE propagateXYZ 841 | 842 | 843 | SUBROUTINE fillEps(LEVEL,Xoffset,Yoffset,Zoffset) 844 | Use LevelType 845 | IMPLICIT NONE 846 | INTEGER I,J,K,M,NDIM,Ip,Im,Jp,Jm,Kp,Km,P 847 | REAL*8 Xoffset,Yoffset,Zoffset 848 | REAL*8 R(6),dhX,dhY,dhZ,b,v,a1,a2,a3,a,d12,d32,temp1,temp2,temp,F 849 | TYPE (LevelStruct)::LEVEL 850 | 851 | NDIM=LEVEL%NDIM 852 | !dhX=ABS(LEVEL%X(2)-LEVEL%X(1)) 853 | !dhY=ABS(LEVEL%Y(2)-LEVEL%Y(1)) 854 | !dhZ=ABS(LEVEL%Z(2)-LEVEL%Z(1)) 855 | b=12. 856 | v=0.8 857 | a=1. 858 | DO K=1,NDIM 859 | DO J=1,NDIM 860 | DO I=1,NDIM 861 | R(1)=SQRT((LEVEL%X(I)-Xoffset)**2.+(LEVEL%Y(J)-Yoffset)**2.+(LEVEL%Z(K)-Zoffset)**2.) 862 | ip=MOD(I,NDIM)+1 863 | im=I-1 864 | jp=MOD(J,NDIM)+1 865 | jm=J-1 866 | kp=MOD(K,NDIM)+1 867 | km=K-1 868 | IF(I.EQ.1) im=NDIM 869 | IF(J.EQ.1) jm=NDIM 870 | IF(K.EQ.1) km=NDIM 871 | 872 | ! LEVEL%EPS(1,I,J,K)=a+b*DExp(-v*(R(1))**2.) 873 | LEVEL%EPS(1,I,J,K)=1. 874 | LEVEL%EPS(2,I,J,K)=LEVEL%EPS(1,I,J,K)**(-0.5D0) 875 | LEVEL%EPS(3,I,J,K)=LEVEL%EPS(1,I,J,K)**(0.5D0) 876 | ENDDO 877 | ENDDO 878 | ENDDO 879 | 880 | 881 | DO K=1,NDIM 882 | DO J=1,NDIM 883 | DO I=1,NDIM 884 | R(1)=SQRT((LEVEL%X(I)-Xoffset)**2.+(LEVEL%Y(J)-Yoffset)**2.+(LEVEL%Z(K)-Zoffset)**2.) 885 | ip=MOD(I,NDIM)+1 886 | im=I-1 887 | jp=MOD(J,NDIM)+1 888 | jm=J-1 889 | kp=MOD(K,NDIM)+1 890 | km=K-1 891 | IF(I.EQ.1) im=NDIM 892 | IF(J.EQ.1) jm=NDIM 893 | IF(K.EQ.1) km=NDIM 894 | LEVEL%EPS(4,I,J,K)=LEVEL%EPS(3,Ip,J,K)+LEVEL%EPS(3,Im,J,K)+LEVEL%EPS(3,I,Jp,K)+LEVEL%EPS(3,I,Jm,K)+LEVEL%EPS(3,I,J,Kp)+& 895 | & LEVEL%EPS(3,I,J,Km)-6.*LEVEL%EPS(3,I,J,K) 896 | LEVEL%EPS(5,I,J,K)=LEVEL%EPS(4,I,J,K)*LEVEL%EPS(2,I,J,K) 897 | ENDDO 898 | ENDDO 899 | ENDDO 900 | 901 | END SUBROUTINE fillEps 902 | 903 | 904 | 905 | 906 | 907 | 908 | SUBROUTINE INITIALIZE(MYID,NCPUS,LEVEL,Level1,levelN,nlevels) 909 | USE LevelType 910 | IMPLICIT NONE 911 | INTEGER NDIM,NDIM3,NSUB,NCPUS,MYID,NDIV,CNT,I,J,K,CNT1(3),MULT,X_int,Y_int,Z_int,Nx,Ny,Nz,NSUB1,P,INCX,INCY,INCZ,MODX,MODY,MODZ 912 | INTEGER levelN,nlevels,KK 913 | INTEGER, DIMENSION(:), ALLOCATABLE ::NDIM_MAX,NDIM_MAX_LINE 914 | TYPE (LevelStruct)::Level,Level1 915 | 916 | 917 | NDIM=LEVEL%NDIM 918 | 919 | 920 | NDIM3=NDIM*NDIM*NDIM 921 | NSUB=NDIM3/NCPUS 922 | 923 | NDIV=INT(NCPUS**(1./3.))+1 924 | 925 | !NDIV=NCPUS-1 926 | 927 | NSUB1=NCPUS 928 | CNT=0 929 | 121 continue 930 | DO I=NDIV,1,-1 931 | IF(MOD(NSUB1,I).EQ.0) THEN 932 | NSUB1=NSUB1/I 933 | CNT=CNT+1 934 | CNT1(CNT)=I 935 | goto 122 936 | ENDIF 937 | ENDDO 938 | 939 | 122 continue 940 | IF(CNT.eq.2) THEN 941 | goto 123 942 | ELSE 943 | goto 121 944 | ENDIF 945 | 946 | 123 continue 947 | CNT=CNT+1 948 | CNT1(CNT)=NSUB1 949 | MULT=1 950 | ! IF(MYID.eq.0) WRITE(*,*) "######################################" 951 | 952 | 953 | 954 | call SSORT(CNT1,3) 955 | 956 | 957 | 958 | IF(MYID.eq.0) THEN 959 | WRITE(*,*) "######################################" 960 | WRITE(*,*) CNT1(1),CNT1(2),CNT1(3),NDIM 961 | ENDIF 962 | 963 | DO I=1,CNT 964 | MULT=MULT*CNT1(I) 965 | ENDDO 966 | 967 | 968 | CNT=0 969 | DO K=1,CNT1(3) 970 | DO J=1,CNT1(2) 971 | DO I=1,CNT1(1) 972 | CNT=CNT+1 973 | LEVEL%X1(CNT)=NDIM/CNT1(1)*(I-1)+1 974 | LEVEL%X2(CNT)=NDIM/CNT1(1)*I 975 | LEVEL%Y1(CNT)=NDIM/CNT1(2)*(J-1)+1 976 | LEVEL%Y2(CNT)=NDIM/CNT1(2)*J 977 | LEVEL%Z1(CNT)=NDIM/CNT1(3)*(K-1)+1 978 | LEVEL%Z2(CNT)=NDIM/CNT1(3)*K 979 | 980 | IF(I.eq.CNT1(1)) THEN 981 | LEVEL%X2(CNT)=NDIM 982 | ENDIF 983 | 984 | IF(J.eq.CNT1(2)) THEN 985 | LEVEL%Y2(CNT)=NDIM 986 | ENDIF 987 | 988 | IF(K.eq.CNT1(3)) THEN 989 | LEVEL%Z2(CNT)=NDIM 990 | ENDIF 991 | 992 | IF(levelN.le.nlevels-1) THEN 993 | LEVEL%X1(CNT)=(LEVEL1%X1(CNT)+1)/2 994 | LEVEL%Y1(CNT)=(LEVEL1%Y1(CNT)+1)/2 995 | LEVEL%Z1(CNT)=(LEVEL1%Z1(CNT)+1)/2 996 | LEVEL%X2(CNT)=(LEVEL1%X2(CNT)+1)/2 997 | LEVEL%Y2(CNT)=(LEVEL1%Y2(CNT)+1)/2 998 | LEVEL%Z2(CNT)=(LEVEL1%Z2(CNT)+1)/2 999 | 1000 | DO KK=1,CNT-1 1001 | IF(CNT.gt.1.and.(LEVEL%X1(CNT).eq.LEVEL%X2(KK))) THEN 1002 | ! LEVEL%X1(CNT)=LEVEL%X1(CNT)+1 1003 | ENDIF 1004 | 1005 | IF(CNT.gt.1.and.(LEVEL%Y1(CNT).eq.LEVEL%Y2(KK))) THEN 1006 | ! LEVEL%Y1(CNT)= LEVEL%Y1(CNT)+1 1007 | ENDIF 1008 | IF(CNT.gt.1.and.(LEVEL%Z1(CNT).eq.LEVEL%Z2(KK))) THEN 1009 | ! LEVEL%Z1(CNT)= LEVEL%Z1(CNT)+1 1010 | ENDIF 1011 | ENDDO 1012 | 1013 | IF(I.eq.CNT1(1)) THEN 1014 | LEVEL%X2(CNT)=NDIM 1015 | ENDIF 1016 | 1017 | IF(J.eq.CNT1(2)) THEN 1018 | LEVEL%Y2(CNT)=NDIM 1019 | ENDIF 1020 | 1021 | IF(K.eq.CNT1(3)) THEN 1022 | LEVEL%Z2(CNT)=NDIM 1023 | ENDIF 1024 | 1025 | ENDIF 1026 | 1027 | 1028 | IF(MYID.EQ.0) THEN 1029 | WRITE(*,'(A1,I3,A1,I3,A1,A5,A1,I3,A1,I3,A1,A5,A1,I3,A1,I3,A1,I3)') "(",LEVEL%X1(CNT),",",LEVEL%X2(CNT),")"," ","(",LEVEL%Y1(CNT),",",LEVEL%Y2(CNT)& 1030 | ,")"," ","(",LEVEL%Z1(CNT),",",LEVEL%Z2(CNT),")",CNT 1031 | ENDIF 1032 | 1033 | 1034 | ENDDO 1035 | ENDDO 1036 | ENDDO 1037 | 1038 | LEVEL%Nb=0 1039 | DO I=1,NCPUS 1040 | X_int=LEVEL%X1(I)-1 1041 | IF(LEVEL%X1(I).EQ.1) X_int=NDIM 1042 | DO J=1,NCPUS 1043 | IF((X_int.GE.LEVEL%X1(J)).AND.(X_int.LE.LEVEL%X2(J)).AND.(LEVEL%Y1(I).EQ.LEVEL%Y1(J)).AND.(LEVEL%Y2(I).EQ.LEVEL%Y2(J))& 1044 | &.AND.(LEVEL%Z1(I).EQ.LEVEL%Z1(J)).AND.(LEVEL%Z2(I).EQ.LEVEL%Z2(J)).AND.(I.NE.J)) THEN 1045 | LEVEL%NB(I)=LEVEL%NB(I)+1 1046 | LEVEL%RecV(I,LEVEL%NB(I))=J 1047 | LEVEL%X1Plane(I,LEVEL%NB(I))=X_int 1048 | LEVEL%X2Plane(I,LEVEL%NB(I))=X_int 1049 | LEVEL%Y1Plane(I,LEVEL%NB(I))=LEVEL%Y1(I) 1050 | LEVEL%Y2Plane(I,LEVEL%NB(I))=LEVEL%Y2(I) 1051 | LEVEL%Z1Plane(I,LEVEL%NB(I))=LEVEL%Z1(I) 1052 | LEVEL%Z2Plane(I,LEVEL%NB(I))=LEVEL%Z2(I) 1053 | ENDIF 1054 | ENDDO 1055 | X_int=LEVEL%X2(I)+1 1056 | IF(LEVEL%X2(I).EQ.NDIM) X_int=1 1057 | DO J=1,NCPUS 1058 | IF((X_int.GE.LEVEL%X1(J)).AND.(X_int.LE.LEVEL%X2(J)).AND.(LEVEL%Y1(I).EQ.LEVEL%Y1(J)).AND.(LEVEL%Y2(I).EQ.LEVEL%Y2(J))& 1059 | &.AND.(LEVEL%Z1(I).EQ.LEVEL%Z1(J)).AND.(LEVEL%Z2(I).EQ.LEVEL%Z2(J)).AND.(I.NE.J)) THEN 1060 | LEVEL%NB(I)=LEVEL%NB(I)+1 1061 | LEVEL%RecV(I,LEVEL%NB(I))=J 1062 | LEVEL%X1Plane(I,LEVEL%NB(I))=X_int 1063 | LEVEL%X2Plane(I,LEVEL%NB(I))=X_int 1064 | LEVEL%Y1Plane(I,LEVEL%NB(I))=LEVEL%Y1(I) 1065 | LEVEL%Y2Plane(I,LEVEL%NB(I))=LEVEL%Y2(I) 1066 | LEVEL%Z1Plane(I,LEVEL%NB(I))=LEVEL%Z1(I) 1067 | LEVEL%Z2Plane(I,LEVEL%NB(I))=LEVEL%Z2(I) 1068 | 1069 | ENDIF 1070 | ENDDO 1071 | 1072 | Y_int=LEVEL%Y1(I)-1 1073 | IF(LEVEL%Y1(I).EQ.1) Y_int=NDIM 1074 | DO J=1,NCPUS 1075 | IF((Y_int.GE.LEVEL%Y1(J)).AND.(Y_int.LE.LEVEL%Y2(J)).AND.(LEVEL%X1(I).EQ.LEVEL%X1(J)).AND.(LEVEL%X2(I).EQ.LEVEL%X2(J))& 1076 | & .AND.(LEVEL%Z1(I).EQ.LEVEL%Z1(J)).AND.(LEVEL%Z2(I).EQ.LEVEL%Z2(J)).AND.(I.NE.J)) THEN 1077 | LEVEL%NB(I)=LEVEL%NB(I)+1 1078 | LEVEL%RecV(I,LEVEL%NB(I))=J 1079 | LEVEL%X1Plane(I,LEVEL%NB(I))=LEVEL%X1(I) 1080 | LEVEL%X2Plane(I,LEVEL%NB(I))=LEVEL%X2(I) 1081 | LEVEL%Y1Plane(I,LEVEL%NB(I))=Y_int 1082 | LEVEL%Y2Plane(I,LEVEL%NB(I))=Y_int 1083 | LEVEL%Z1Plane(I,LEVEL%NB(I))=LEVEL%Z1(I) 1084 | LEVEL%Z2Plane(I,LEVEL%NB(I))=LEVEL%Z2(I) 1085 | ENDIF 1086 | ENDDO 1087 | Y_int=LEVEL%Y2(I)+1 1088 | IF(LEVEL%Y2(I).EQ.NDIM) Y_int=1 1089 | DO J=1,NCPUS 1090 | IF((Y_int.GE.LEVEL%Y1(J)).AND.(Y_int.LE.LEVEL%Y2(J)).AND.(LEVEL%X1(I).EQ.LEVEL%X1(J)).AND.(LEVEL%X2(I).EQ.LEVEL%X2(J)).AND.(LEVEL%Z1(I).EQ.LEVEL%Z1(J))& 1091 | &.AND.(LEVEL%Z2(I).EQ.LEVEL%Z2(J)).AND.(I.NE.J)) THEN 1092 | LEVEL%NB(I)=LEVEL%NB(I)+1 1093 | LEVEL%RecV(I,LEVEL%NB(I))=J 1094 | LEVEL%X1Plane(I,LEVEL%NB(I))=LEVEL%X1(I) 1095 | LEVEL%X2Plane(I,LEVEL%NB(I))=LEVEL%X2(I) 1096 | LEVEL%Y1Plane(I,LEVEL%NB(I))=Y_int 1097 | LEVEL%Y2Plane(I,LEVEL%NB(I))=Y_int 1098 | LEVEL%Z1Plane(I,LEVEL%NB(I))=LEVEL%Z1(I) 1099 | LEVEL%Z2Plane(I,LEVEL%NB(I))=LEVEL%Z2(I) 1100 | ENDIF 1101 | ENDDO 1102 | 1103 | 1104 | Z_int=LEVEL%Z1(I)-1 1105 | IF(LEVEL%Z1(I).EQ.1) Z_int=NDIM 1106 | DO J=1,NCPUS 1107 | IF((Z_int.GE.LEVEL%Z1(J)).AND.(Z_int.LE.LEVEL%Z2(J)).AND.(LEVEL%Y1(I).EQ.LEVEL%Y1(J)).AND.(LEVEL%Y2(I).EQ.LEVEL%Y2(J)).AND.(LEVEL%X1(I).EQ.LEVEL%X1(J))& 1108 | &.AND.(LEVEL%X2(I).EQ.LEVEL%X2(J)).AND.(I.NE.J)) THEN 1109 | LEVEL%NB(I)=LEVEL%NB(I)+1 1110 | LEVEL%RecV(I,LEVEL%NB(I))=J 1111 | LEVEL%X1Plane(I,LEVEL%NB(I))=LEVEL%X1(I) 1112 | LEVEL%X2Plane(I,LEVEL%NB(I))=LEVEL%X2(I) 1113 | LEVEL%Y1Plane(I,LEVEL%NB(I))=LEVEL%Y1(I) 1114 | LEVEL%Y2Plane(I,LEVEL%NB(I))=LEVEL%Y2(I) 1115 | LEVEL%Z1Plane(I,LEVEL%NB(I))=Z_int 1116 | LEVEL%Z2Plane(I,LEVEL%NB(I))=Z_int 1117 | ENDIF 1118 | ENDDO 1119 | 1120 | Z_int=LEVEL%Z2(I)+1 1121 | IF(LEVEL%Z2(I).EQ.NDIM) Z_int=1 1122 | DO J=1,NCPUS 1123 | IF((Z_int.GE.LEVEL%Z1(J)).AND.(Z_int.LE.LEVEL%Z2(J)).AND.(LEVEL%Y1(I).EQ.LEVEL%Y1(J)).AND.(LEVEL%Y2(I).EQ.LEVEL%Y2(J)).AND.(LEVEL%X1(I).EQ.LEVEL%X1(J))& 1124 | &.AND.(LEVEL%X2(I).EQ.LEVEL%X2(J)).AND.(I.NE.J)) THEN 1125 | LEVEL%NB(I)=LEVEL%NB(I)+1 1126 | LEVEL%RecV(I,LEVEL%NB(I))=J 1127 | LEVEL%X1Plane(I,LEVEL%NB(I))=LEVEL%X1(I) 1128 | LEVEL%X2Plane(I,LEVEL%NB(I))=LEVEL%X2(I) 1129 | LEVEL%Y1Plane(I,LEVEL%NB(I))=LEVEL%Y1(I) 1130 | LEVEL%Y2Plane(I,LEVEL%NB(I))=LEVEL%Y2(I) 1131 | LEVEL%Z1Plane(I,LEVEL%NB(I))=Z_int 1132 | LEVEL%Z2Plane(I,LEVEL%NB(I))=Z_int 1133 | ENDIF 1134 | ENDDO 1135 | 1136 | ENDDO 1137 | 1138 | 1139 | 1140 | DO I=1,NCPUS 1141 | DO K=1,NCPUS 1142 | DO J=1,LEVEL%NB(K) 1143 | IF(LEVEL%RecV(K,J).eq.I) THEN 1144 | LEVEL%SenD(I,J)=K 1145 | LEVEL%PlanesSend(I,J)=J 1146 | ENDIF 1147 | ENDDO 1148 | ENDDO 1149 | ENDDO 1150 | 1151 | 1152 | 1153 | DO I=1,NCPUS 1154 | DO J=1,LEVEL%NB(I) 1155 | IF((J.eq.1).or.(J.eq.2)) then 1156 | DO P=1,4 1157 | LEVEL%X1Line(P,I,J)=LEVEL%X1Plane(I,J) 1158 | LEVEL%X2Line(P,I,J)=LEVEL%X2Plane(I,J) 1159 | IF(P.eq.1) then 1160 | LEVEL%Y1Line(P,I,J)=LEVEL%Y1Plane(I,J)-1 1161 | LEVEL%Y2Line(P,I,J)=LEVEL%Y1Plane(I,J)-1 1162 | LEVEL%Z1Line(P,I,J)=LEVEL%Z1Plane(I,J) 1163 | LEVEL%Z2Line(P,I,J)=LEVEL%Z2Plane(I,J) 1164 | IF(LEVEL%Y1Plane(I,J).eq.1) then 1165 | LEVEL%Y1Line(P,I,J)=NDIM 1166 | LEVEL%Y2Line(P,I,J)=NDIM 1167 | endif 1168 | endif 1169 | 1170 | IF(P.eq.2) then 1171 | LEVEL%Y1Line(P,I,J)=LEVEL%Y2Plane(I,J)+1 1172 | LEVEL%Y2Line(P,I,J)=LEVEL%Y2Plane(I,J)+1 1173 | LEVEL%Z1Line(P,I,J)=LEVEL%Z1Plane(I,J) 1174 | LEVEL%Z2Line(P,I,J)=LEVEL%Z2Plane(I,J) 1175 | IF(LEVEL%Y2Plane(I,J).eq.NDIM) then 1176 | LEVEL%Y1Line(P,I,J)=1 1177 | LEVEL%Y2Line(P,I,J)=1 1178 | endif 1179 | endif 1180 | 1181 | IF(P.eq.3) then 1182 | LEVEL%Y1Line(P,I,J)=LEVEL%Y1Plane(I,J) 1183 | LEVEL%Y2Line(P,I,J)=LEVEL%Y2Plane(I,J) 1184 | LEVEL%Z1Line(P,I,J)=LEVEL%Z1Plane(I,J)-1 1185 | LEVEL%Z2Line(P,I,J)=LEVEL%Z1Plane(I,J)-1 1186 | IF(LEVEL%Z1Plane(I,J).eq.1) then 1187 | LEVEL%Z1Line(P,I,J)=NDIM 1188 | LEVEL%Z2Line(P,I,J)=NDIM 1189 | endif 1190 | endif 1191 | 1192 | IF(P.eq.4) then 1193 | LEVEL%Y1Line(P,I,J)=LEVEL%Y1Plane(I,J) 1194 | LEVEL%Y2Line(P,I,J)=LEVEL%Y2Plane(I,J) 1195 | LEVEL%Z1Line(P,I,J)=LEVEL%Z2Plane(I,J)+1 1196 | LEVEL%Z2Line(P,I,J)=LEVEL%Z2Plane(I,J)+1 1197 | IF(LEVEL%Z2Plane(I,J).eq.NDIM) then 1198 | LEVEL%Z1Line(P,I,J)=1 1199 | LEVEL%Z2Line(P,I,J)=1 1200 | endif 1201 | endif 1202 | 1203 | ENDDO 1204 | endif 1205 | 1206 | 1207 | 1208 | 1209 | IF((J.eq.3).or.J.eq.4) then 1210 | DO P=1,4 1211 | LEVEL%Y1Line(P,I,J)=LEVEL%Y1Plane(I,J) 1212 | LEVEL%Y2Line(P,I,J)=LEVEL%Y2Plane(I,J) 1213 | IF(P.eq.1) then 1214 | LEVEL%X1Line(P,I,J)=LEVEL%X1Plane(I,J)-1 1215 | LEVEL%X2Line(P,I,J)=LEVEL%X1Plane(I,J)-1 1216 | LEVEL%Z1Line(P,I,J)=LEVEL%Z1Plane(I,J) 1217 | LEVEL%Z2Line(P,I,J)=LEVEL%Z2Plane(I,J) 1218 | IF(LEVEL%X1Plane(I,J).eq.1) then 1219 | LEVEL%X1Line(P,I,J)=NDIM 1220 | LEVEL%X2Line(P,I,J)=NDIM 1221 | endif 1222 | endif 1223 | 1224 | IF(P.eq.2) then 1225 | LEVEL%X1Line(P,I,J)=LEVEL%X2Plane(I,J)+1 1226 | LEVEL%X2Line(P,I,J)=LEVEL%X2Plane(I,J)+1 1227 | LEVEL%Z1Line(P,I,J)=LEVEL%Z1Plane(I,J) 1228 | LEVEL%Z2Line(P,I,J)=LEVEL%Z2Plane(I,J) 1229 | IF(LEVEL%X2Plane(I,J).eq.NDIM) then 1230 | LEVEL%X1Line(P,I,J)=1 1231 | LEVEL%X2Line(P,I,J)=1 1232 | endif 1233 | endif 1234 | 1235 | IF(P.eq.3) then 1236 | LEVEL%X1Line(P,I,J)=LEVEL%X1Plane(I,J) 1237 | LEVEL%X2Line(P,I,J)=LEVEL%X2Plane(I,J) 1238 | LEVEL%Z1Line(P,I,J)=LEVEL%Z1Plane(I,J)-1 1239 | LEVEL%Z2Line(P,I,J)=LEVEL%Z1Plane(I,J)-1 1240 | IF(LEVEL%Z1Plane(I,J).eq.1) then 1241 | LEVEL%Z1Line(P,I,J)=NDIM 1242 | LEVEL%Z2Line(P,I,J)=NDIM 1243 | endif 1244 | endif 1245 | 1246 | IF(P.eq.4) then 1247 | LEVEL%X1Line(P,I,J)=LEVEL%X1Plane(I,J) 1248 | LEVEL%X2Line(P,I,J)=LEVEL%X2Plane(I,J) 1249 | LEVEL%Z1Line(P,I,J)=LEVEL%Z2Plane(I,J)+1 1250 | LEVEL%Z2Line(P,I,J)=LEVEL%Z2Plane(I,J)+1 1251 | IF(LEVEL%Z2Plane(I,J).eq.NDIM) then 1252 | LEVEL%Z1Line(P,I,J)=1 1253 | LEVEL%Z2Line(P,I,J)=1 1254 | endif 1255 | endif 1256 | 1257 | ENDDO 1258 | endif 1259 | 1260 | 1261 | IF((J.eq.5).or.J.eq.6) then 1262 | 1263 | DO P=1,4 1264 | LEVEL%Z1Line(P,I,J)=LEVEL%Z1Plane(I,J) 1265 | LEVEL%Z2Line(P,I,J)=LEVEL%Z2Plane(I,J) 1266 | IF(P.eq.1) then 1267 | LEVEL%X1Line(P,I,J)=LEVEL%X1Plane(I,J)-1 1268 | LEVEL%X2Line(P,I,J)=LEVEL%X1Plane(I,J)-1 1269 | LEVEL%Y1Line(P,I,J)=LEVEL%Y1Plane(I,J) 1270 | LEVEL%Y2Line(P,I,J)=LEVEL%Y2Plane(I,J) 1271 | IF(LEVEL%X1Plane(I,J).eq.1) then 1272 | LEVEL%X1Line(P,I,J)=NDIM 1273 | LEVEL%X2Line(P,I,J)=NDIM 1274 | endif 1275 | endif 1276 | 1277 | IF(P.eq.2) then 1278 | LEVEL%X1Line(P,I,J)=LEVEL%X2Plane(I,J)+1 1279 | LEVEL%X2Line(P,I,J)=LEVEL%X2Plane(I,J)+1 1280 | LEVEL%Y1Line(P,I,J)=LEVEL%Y1Plane(I,J) 1281 | LEVEL%Y2Line(P,I,J)=LEVEL%Y2Plane(I,J) 1282 | IF(LEVEL%X2Plane(I,J).eq.NDIM) then 1283 | LEVEL%X1Line(P,I,J)=1 1284 | LEVEL%X2Line(P,I,J)=1 1285 | endif 1286 | endif 1287 | 1288 | IF(P.eq.3) then 1289 | LEVEL%X1Line(P,I,J)=LEVEL%X1Plane(I,J) 1290 | LEVEL%X2Line(P,I,J)=LEVEL%X2Plane(I,J) 1291 | LEVEL%Y1Line(P,I,J)=LEVEL%Y1Plane(I,J)-1 1292 | LEVEL%Y2Line(P,I,J)=LEVEL%Y1Plane(I,J)-1 1293 | IF(LEVEL%Y1Plane(I,J).eq.1) then 1294 | LEVEL%Y1Line(P,I,J)=NDIM 1295 | LEVEL%Y2Line(P,I,J)=NDIM 1296 | endif 1297 | endif 1298 | 1299 | IF(P.eq.4) then 1300 | LEVEL%X1Line(P,I,J)=LEVEL%X1Plane(I,J) 1301 | LEVEL%X2Line(P,I,J)=LEVEL%X2Plane(I,J) 1302 | LEVEL%Y1Line(P,I,J)=LEVEL%Y2Plane(I,J)+1 1303 | LEVEL%Y2Line(P,I,J)=LEVEL%Y2Plane(I,J)+1 1304 | IF(LEVEL%Y2Plane(I,J).eq.NDIM) then 1305 | LEVEL%Y1Line(P,I,J)=1 1306 | LEVEL%Y2Line(P,I,J)=1 1307 | endif 1308 | endif 1309 | 1310 | ENDDO 1311 | endif 1312 | ! IF(MYID.eq.0.and.NDIM.eq.120.and.J.eq.5) write(*,*) "Z1%%,Z2= ",LEVEL%Z1Line(3,2,5),LEVEL%Z2Line(3,2,5),P,I,J 1313 | 1314 | 1315 | ENDDO 1316 | ENDDO 1317 | 1318 | 1319 | DO I=1,NCPUS 1320 | DO J=1,LEVEL%NB(I) 1321 | IF((J.eq.1).or.(J.eq.2)) then 1322 | DO P=1,4 1323 | LEVEL%XPoint(P,I,J)=LEVEL%X1Line(P,I,J) 1324 | IF(P.eq.1) then 1325 | LEVEL%YPoint(P,I,J)=LEVEL%Y1(I)-1 1326 | LEVEL%ZPoint(P,I,J)=LEVEL%Z1(I)-1 1327 | IF(LEVEL%Y1(I).eq.1) then 1328 | LEVEL%YPoint(P,I,J)=NDIM 1329 | endif 1330 | IF(LEVEL%Z1(I).eq.1) then 1331 | LEVEL%ZPoint(P,I,J)=NDIM 1332 | endif 1333 | ENDIF 1334 | 1335 | IF(P.eq.2) then 1336 | LEVEL%YPoint(P,I,J)=LEVEL%Y2(I)+1 1337 | LEVEL%ZPoint(P,I,J)=LEVEL%Z1(I)-1 1338 | IF(LEVEL%Y2(I).eq.NDIM) then 1339 | LEVEL%YPoint(P,I,J)=1 1340 | endif 1341 | IF(LEVEL%Z1(I).eq.1) then 1342 | LEVEL%ZPoint(P,I,J)=NDIM 1343 | endif 1344 | ENDIF 1345 | 1346 | 1347 | IF(P.eq.3) then 1348 | LEVEL%YPoint(P,I,J)=LEVEL%Y1(I)-1 1349 | LEVEL%ZPoint(P,I,J)=LEVEL%Z2(I)+1 1350 | IF(LEVEL%Y1(I).eq.1) then 1351 | LEVEL%YPoint(P,I,J)=NDIM 1352 | endif 1353 | IF(LEVEL%Z2(I).eq.NDIM) then 1354 | LEVEL%ZPoint(P,I,J)=1 1355 | endif 1356 | ENDIF 1357 | 1358 | IF(P.eq.4) then 1359 | LEVEL%YPoint(P,I,J)=LEVEL%Y2(I)+1 1360 | LEVEL%ZPoint(P,I,J)=LEVEL%Z2(I)+1 1361 | IF(LEVEL%Y2(I).eq.NDIM) then 1362 | LEVEL%YPoint(P,I,J)=1 1363 | endif 1364 | IF(LEVEL%Z2(I).eq.NDIM) then 1365 | LEVEL%ZPoint(P,I,J)=1 1366 | endif 1367 | ENDIF 1368 | ENDDO 1369 | ENDIF 1370 | 1371 | 1372 | IF((J.eq.3).or.(J.eq.4)) then 1373 | DO P=1,4 1374 | LEVEL%YPoint(P,I,J)=LEVEL%Y1Line(P,I,J) 1375 | IF(P.eq.1) then 1376 | LEVEL%XPoint(P,I,J)=LEVEL%X1(I)-1 1377 | LEVEL%ZPoint(P,I,J)=LEVEL%Z1(I)-1 1378 | IF(LEVEL%X1(I).eq.1) then 1379 | LEVEL%XPoint(P,I,J)=NDIM 1380 | endif 1381 | IF(LEVEL%Z1(I).eq.1) then 1382 | LEVEL%ZPoint(P,I,J)=NDIM 1383 | endif 1384 | ENDIF 1385 | 1386 | IF(P.eq.2) then 1387 | LEVEL%XPoint(P,I,J)=LEVEL%X2(I)+1 1388 | LEVEL%ZPoint(P,I,J)=LEVEL%Z1(I)-1 1389 | IF(LEVEL%X2(I).eq.NDIM) then 1390 | LEVEL%XPoint(P,I,J)=1 1391 | endif 1392 | IF(LEVEL%Z1(I).eq.1) then 1393 | LEVEL%ZPoint(P,I,J)=NDIM 1394 | endif 1395 | ENDIF 1396 | 1397 | 1398 | IF(P.eq.3) then 1399 | LEVEL%XPoint(P,I,J)=LEVEL%X1(I)-1 1400 | LEVEL%ZPoint(P,I,J)=LEVEL%Z2(I)+1 1401 | IF(LEVEL%X1(I).eq.1) then 1402 | LEVEL%XPoint(P,I,J)=NDIM 1403 | endif 1404 | IF(LEVEL%Z2(I).eq.NDIM) then 1405 | LEVEL%ZPoint(P,I,J)=1 1406 | endif 1407 | ENDIF 1408 | 1409 | IF(P.eq.4) then 1410 | LEVEL%XPoint(P,I,J)=LEVEL%X2(I)+1 1411 | LEVEL%ZPoint(P,I,J)=LEVEL%Z2(I)+1 1412 | IF(LEVEL%X2(I).eq.NDIM) then 1413 | LEVEL%XPoint(P,I,J)=1 1414 | endif 1415 | IF(LEVEL%Z2(I).eq.NDIM) then 1416 | LEVEL%ZPoint(P,I,J)=1 1417 | endif 1418 | ENDIF 1419 | ENDDO 1420 | ENDIF 1421 | 1422 | 1423 | IF((J.eq.5).or.(J.eq.6)) then 1424 | DO P=1,4 1425 | LEVEL%ZPoint(P,I,J)=LEVEL%Z1Line(P,I,J) 1426 | IF(P.eq.1) then 1427 | LEVEL%XPoint(P,I,J)=LEVEL%X1(I)-1 1428 | LEVEL%YPoint(P,I,J)=LEVEL%Y1(I)-1 1429 | IF(LEVEL%Y1(I).eq.1) then 1430 | LEVEL%YPoint(P,I,J)=NDIM 1431 | endif 1432 | IF(LEVEL%X1(I).eq.1) then 1433 | LEVEL%XPoint(P,I,J)=NDIM 1434 | endif 1435 | ENDIF 1436 | 1437 | IF(P.eq.2) then 1438 | LEVEL%XPoint(P,I,J)=LEVEL%X1(I)-1 1439 | LEVEL%YPoint(P,I,J)=LEVEL%Y2(I)+1 1440 | 1441 | IF(LEVEL%Y2(I).eq.NDIM) then 1442 | LEVEL%YPoint(P,I,J)=1 1443 | endif 1444 | IF(LEVEL%X1(I).eq.1) then 1445 | LEVEL%XPoint(P,I,J)=NDIM 1446 | endif 1447 | ENDIF 1448 | 1449 | 1450 | IF(P.eq.3) then 1451 | LEVEL%XPoint(P,I,J)=LEVEL%X2(I)+1 1452 | LEVEL%YPoint(P,I,J)=LEVEL%Y1(I)-1 1453 | IF(LEVEL%Y1(I).eq.1) then 1454 | LEVEL%YPoint(P,I,J)=NDIM 1455 | endif 1456 | IF(LEVEL%X2(I).eq.NDIM) then 1457 | LEVEL%XPoint(P,I,J)=1 1458 | endif 1459 | ENDIF 1460 | 1461 | IF(P.eq.4) then 1462 | LEVEL%XPoint(P,I,J)=LEVEL%X2(I)+1 1463 | LEVEL%YPoint(P,I,J)=LEVEL%Y2(I)+1 1464 | IF(LEVEL%Y2(I).eq.NDIM) then 1465 | LEVEL%YPoint(P,I,J)=1 1466 | endif 1467 | IF(LEVEL%X2(I).eq.NDIM) then 1468 | LEVEL%XPoint(P,I,J)=1 1469 | endif 1470 | ENDIF 1471 | ENDDO 1472 | ENDIF 1473 | 1474 | ENDDO 1475 | ENDDO 1476 | 1477 | 1478 | 1479 | !pause 1480 | IF(MYID.eq.0) THEN 1481 | DO I=1,NCPUS 1482 | write(*,*) "## LINES LINES LINES LINES LINES LINES ##" 1483 | 1484 | DO J=1,LEVEL%NB(I) 1485 | DO P=1,4 1486 | IF(MYID.eq.0) then 1487 | WRITE(*,'(A1,I3,A1,I3,A1,A5,A1,I3,A1,I3,A1,A5,A1,I3,A1,I3,A1,I3)') "(",LEVEL%X1Line(P,I,J),",",LEVEL%X2Line(P,I,J),")"," ","(",& 1488 | & LEVEL%Y1Line(P,I,J),",",LEVEL%Y2Line(P,I,J),")"," ","(",LEVEL%Z1Line(P,I,J),",",LEVEL%Z2Line(P,I,J),")",I 1489 | ENDIF 1490 | 1491 | ENDDO 1492 | WRITE(*,*) "************" 1493 | ENDDO 1494 | ENDDO 1495 | 1496 | ENDIF 1497 | 1498 | 1499 | DO I=1,NCPUS 1500 | DO K=1,NCPUS 1501 | DO J=1,LEVEL%NB(I) 1502 | DO P=1,4 1503 | IF((LEVEL%X1Line(P,I,J).GE.LEVEL%X1(K)).AND.(LEVEL%X2Line(P,I,J).LE.LEVEL%X2(K)).AND.(LEVEL%Y1Line(P,I,J).GE.LEVEL%Y1(K))& 1504 | &.AND.(LEVEL%Y2Line(P,I,J).LE.LEVEL%Y2(K)).AND.(LEVEL%Z1Line(P,I,J).GE.LEVEL%Z1(K)).AND.(LEVEL%Z2Line(P,I,J).LE.LEVEL%Z2(K)).AND.(I.NE.K)) then 1505 | LEVEL%RecV1(I,J,P)=K 1506 | endif 1507 | ENDDO 1508 | ENDDO 1509 | ENDDO 1510 | ENDDO 1511 | 1512 | 1513 | 1514 | 1515 | 1516 | DO I=1,NCPUS 1517 | DO K=1,NCPUS 1518 | DO J=1,LEVEL%NB(I) 1519 | DO P=1,4 1520 | IF((LEVEL%XPoint(P,I,J).GE.LEVEL%X1(K)).AND.(LEVEL%XPoint(P,I,J).LE.LEVEL%X2(K)).AND.(LEVEL%YPoint(P,I,J).GE.LEVEL%Y1(K))& 1521 | &.AND.(LEVEL%YPoint(P,I,J).LE.LEVEL%Y2(K)).AND.(LEVEL%ZPoint(P,I,J).GE.LEVEL%Z1(K)).AND.(LEVEL%ZPoint(P,I,J).LE.LEVEL%Z2(K)).AND.(I.NE.K)) then 1522 | LEVEL%RecV2(I,J,P)=K 1523 | endif 1524 | ENDDO 1525 | ENDDO 1526 | ENDDO 1527 | ENDDO 1528 | 1529 | 1530 | 1531 | 1532 | 1533 | 1534 | 1535 | LEVEL%SenD1=0 1536 | DO I=1,NCPUS 1537 | DO K=1,NCPUS 1538 | DO J=1,LEVEL%NB(I) 1539 | DO P=1,4 1540 | IF(LEVEL%RecV1(K,J,P).eq.I) THEN 1541 | LEVEL%SenD1(I,J,P)=K 1542 | LEVEL%LinesSend(I,J,P)=P 1543 | ENDIF 1544 | ENDDO 1545 | ENDDO 1546 | ENDDO 1547 | ENDDO 1548 | 1549 | 1550 | 1551 | LEVEL%SenD2=0 1552 | DO I=1,NCPUS 1553 | DO K=1,NCPUS 1554 | DO J=1,LEVEL%NB(I) 1555 | DO P=1,4 1556 | IF(LEVEL%RecV2(K,J,P).eq.I) THEN 1557 | LEVEL%SenD2(I,J,P)=K 1558 | LEVEL%PointsSend(I,J,P)=P 1559 | ENDIF 1560 | ENDDO 1561 | ENDDO 1562 | ENDDO 1563 | ENDDO 1564 | 1565 | 1566 | 1567 | 1568 | Allocate(NDIM_MAX(MAXVAL(LEVEL%NB)*NCPUS)) 1569 | NDIM_MAX=0 1570 | CNT=0 1571 | DO I=1,NCPUS 1572 | DO J=1,LEVEL%NB(I) 1573 | Nx=INT(ABS(LEVEL%X1Plane(I,J)-LEVEL%X2Plane(I,J)))+1 1574 | Ny=INT(ABS(LEVEL%Y1Plane(I,J)-LEVEL%Y2Plane(I,J)))+1 1575 | Nz=INT(ABS(LEVEL%Z1Plane(I,J)-LEVEL%Z2Plane(I,J)))+1 1576 | CNT=CNT+1 1577 | NDIM_MAX(CNT)=Nx*Ny*Nz 1578 | ENDDO 1579 | ENDDO 1580 | 1581 | LEVEL%PlaneMaxDim=MAXVAL(NDIM_MAX) 1582 | LEVEL%RECV=LEVEL%RECV-1 1583 | LEVEL%SEND=LEVEL%SEND-1 1584 | 1585 | Allocate(NDIM_MAX_LINE(MAXVAL(LEVEL%NB)*4*NCPUS)) 1586 | NDIM_MAX_LINE=0 1587 | CNT=0 1588 | DO I=1,NCPUS 1589 | DO J=1,LEVEL%NB(I) 1590 | DO P=1,4 1591 | Nx=INT(ABS(LEVEL%X1Line(P,I,J)-LEVEL%X2Line(P,I,J)))+1 1592 | Ny=INT(ABS(LEVEL%Y1Line(P,I,J)-LEVEL%Y2Line(P,I,J)))+1 1593 | Nz=INT(ABS(LEVEL%Z1Line(P,I,J)-LEVEL%Z2Line(P,I,J)))+1 1594 | CNT=CNT+1 1595 | NDIM_MAX_LINE(CNT)=Nx*Ny*Nz 1596 | ENDDO 1597 | ENDDO 1598 | ENDDO 1599 | 1600 | 1601 | LEVEL%RECV1=LEVEL%RECV1-1 1602 | LEVEL%SEND1=LEVEL%SEND1-1 1603 | LEVEL%LineMaxDim=MAXVAL(NDIM_MAX_LINE) 1604 | 1605 | 1606 | LEVEL%RECV2=LEVEL%RECV2-1 1607 | LEVEL%SEND2=LEVEL%SEND2-1 1608 | 1609 | IF(MYID.eq.0) write(*,*) "PLANE_LINE_DIM=",LEVEL%LineMaxDIM 1610 | 1611 | DEAllocate(NDIM_MAX) 1612 | DEAllocate(NDIM_MAX_LINE) 1613 | END SUBROUTINE INITIALIZE 1614 | 1615 | SUBROUTINE GetNelements(NCPUS,LEVEL) 1616 | USE LevelType 1617 | INTEGER I,J,K,Nx,Ny,Nz 1618 | TYPE (LevelStruct)::Level 1619 | 1620 | DO I=1,NCPUS 1621 | Nx=INT(ABS(LEVEL%X2(I)-LEVEL%X1(I)))+1 1622 | Ny=INT(ABS(LEVEL%Y2(I)-LEVEL%Y1(I)))+1 1623 | Nz=INT(ABS(LEVEL%Z2(I)-LEVEL%Z1(I)))+1 1624 | LEVEL%NElements(I)=Nx*Ny*Nz 1625 | ENDDO 1626 | 1627 | 1628 | 1629 | END SUBROUTINE GetNelements 1630 | 1631 | 1632 | 1633 | SUBROUTINE UPDATE(MYID,LEVEL,COMM,FLAG1) 1634 | USE LevelType 1635 | IMPLICIT NONE 1636 | INCLUDE 'mpif.h' 1637 | TYPE (LevelStruct)::Level 1638 | INTEGER :: MYID,TOTPS,IERR,stat(MPI_STATUS_SIZE),COMM,JJ,II,KK,P 1639 | INTEGER :: NDIM,I,J,K,NCPUS,CNT,FLAG,FLAG1 1640 | REAL*8::PlaneBuffSend(LEVEL%PlaneMaxDim+7,LEVEL%NB(MYID+1)) 1641 | REAL*8::PlaneBuffSendLines(LEVEL%LineMaxDim+7,LEVEL%NB(MYID+1),4) 1642 | REAL*8::PlaneBuffSendPoints(5,LEVEL%NB(MYID+1),4) 1643 | 1644 | I=MYID+1 1645 | PlaneBuffSend=0. 1646 | LEVEL%PlaneBuffRecv=0. 1647 | DO J=1,LEVEL%NB(I) 1648 | PlaneBuffSend(1,J)=DBLE(LEVEL%PlanesSend(I,J)) 1649 | PlaneBuffSend(2,J)=DBLE(LEVEL%X1Plane(LEVEL%SenD(I,J)+1,LEVEL%PlanesSend(I,J))) 1650 | PlaneBuffSend(3,J)=DBLE(LEVEL%X2Plane(LEVEL%SenD(I,J)+1,LEVEL%PlanesSend(I,J))) 1651 | PlaneBuffSend(4,J)=DBLE(LEVEL%Y1Plane(LEVEL%SenD(I,J)+1,LEVEL%PlanesSend(I,J))) 1652 | PlaneBuffSend(5,J)=DBLE(LEVEL%Y2Plane(LEVEL%SenD(I,J)+1,LEVEL%PlanesSend(I,J))) 1653 | PlaneBuffSend(6,J)=DBLE(LEVEL%Z1Plane(LEVEL%SenD(I,J)+1,LEVEL%PlanesSend(I,J))) 1654 | PlaneBuffSend(7,J)=DBLE(LEVEL%Z2Plane(LEVEL%SenD(I,J)+1,LEVEL%PlanesSend(I,J))) 1655 | ! DO P1 1656 | 1657 | ENDDO 1658 | 1659 | 1660 | 1661 | DO J=1,LEVEL%NB(I) 1662 | CNT=7 1663 | DO KK=INT(PlaneBuffSend(6,J)),INT(PlaneBuffSend(7,J)) 1664 | DO JJ=INT(PlaneBuffSend(4,J)),INT(PlaneBuffSend(5,J)) 1665 | DO II=INT(PlaneBuffSend(2,J)),INT(PlaneBuffSend(3,J)) 1666 | CNT=CNT+1 1667 | IF(FLAG1.eq.0) PlaneBuffSend(CNT,J)=LEVEL%PHI(II,JJ,KK) 1668 | IF(FLAG1.eq.1) PlaneBuffSend(CNT,J)=LEVEL%ERR(II,JJ,KK) 1669 | ENDDO 1670 | ENDDO 1671 | ENDDO 1672 | ENDDO 1673 | 1674 | 1675 | 1676 | DO J=1,LEVEL%NB(I) 1677 | call MPI_SendRecv(PlaneBuffSend(:,J),LEVEL%PlaneMaxDim+7,MPI_DOUBLE_PRECISION,LEVEL%SEND(I,J),MPI_ANY_TAG,LEVEL%PlaneBuffRecv(:,J),& 1678 | & LEVEL%PlaneMaxDim+7,MPI_DOUBLE_PRECISION,LEVEL%RECV(I,J),MPI_ANY_TAG,COMM,stat,ierr) 1679 | ENDDO 1680 | 1681 | 1682 | 1683 | PlaneBuffSendLines=0. 1684 | LEVEL%LineBuffRecV=0. 1685 | DO P=1,4 1686 | DO J=1,LEVEL%NB(I) 1687 | PlaneBuffSendLines(1,J,P)=DBLE(LEVEL%LinesSend(I,J,P)) 1688 | PlaneBuffSendLines(2,J,P)=DBLE(LEVEL%X1Line(P,LEVEL%SenD1(I,J,P)+1,LEVEL%PlanesSend(I,J))) 1689 | PlaneBuffSendLines(3,J,P)=DBLE(LEVEL%X2Line(P,LEVEL%SenD1(I,J,P)+1,LEVEL%PlanesSend(I,J))) 1690 | PlaneBuffSendLines(4,J,P)=DBLE(LEVEL%Y1Line(P,LEVEL%SenD1(I,J,P)+1,LEVEL%PlanesSend(I,J))) 1691 | PlaneBuffSendLines(5,J,P)=DBLE(LEVEL%Y2Line(P,LEVEL%SenD1(I,J,P)+1,LEVEL%PlanesSend(I,J))) 1692 | PlaneBuffSendLines(6,J,P)=DBLE(LEVEL%Z1Line(P,LEVEL%SenD1(I,J,P)+1,LEVEL%PlanesSend(I,J))) 1693 | PlaneBuffSendLines(7,J,P)=DBLE(LEVEL%Z2Line(P,LEVEL%SenD1(I,J,P)+1,LEVEL%PlanesSend(I,J))) 1694 | ENDDO 1695 | ENDDO 1696 | 1697 | 1698 | 1699 | DO P=1,4 1700 | DO J=1,LEVEL%NB(I) 1701 | CNT=7 1702 | DO KK=INT(PlaneBuffSendLines(6,J,P)),INT(PlaneBuffSendLines(7,J,P)) 1703 | DO JJ=INT(PlaneBuffSendLines(4,J,P)),INT(PlaneBuffSendLines(5,J,P)) 1704 | DO II=INT(PlaneBuffSendLines(2,J,P)),INT(PlaneBuffSendLines(3,J,P)) 1705 | CNT=CNT+1 1706 | IF(FLAG1.eq.0) PlaneBuffSendLines(CNT,J,P)=LEVEL%PHI(II,JJ,KK) 1707 | IF(FLAG1.eq.1) PlaneBuffSendLines(CNT,J,P)=LEVEL%ERR(II,JJ,KK) 1708 | ENDDO 1709 | ENDDO 1710 | ENDDO 1711 | ENDDO 1712 | ENDDO 1713 | 1714 | DO P=1,4 1715 | DO J=1,LEVEL%NB(I) 1716 | call MPI_SendRecv(PlaneBuffSendLines(:,J,P),LEVEL%LineMaxDim+7,MPI_DOUBLE_PRECISION,LEVEL%SEND1(I,J,P),MPI_ANY_TAG,LEVEL%LineBuffRecV(:,J,P),& 1717 | & LEVEL%LineMaxDim+7,MPI_DOUBLE_PRECISION,LEVEL%RECV1(I,J,P),MPI_ANY_TAG,COMM,stat,ierr) 1718 | ENDDO 1719 | ENDDO 1720 | 1721 | 1722 | 1723 | 1724 | PlaneBuffSendPoints=0. 1725 | LEVEL%PointBuffRecV=0. 1726 | DO P=1,4 1727 | DO J=1,LEVEL%NB(I) 1728 | PlaneBuffSendPoints(1,J,P)=DBLE(LEVEL%PointsSend(I,J,P)) 1729 | PlaneBuffSendPoints(2,J,P)=DBLE(LEVEL%XPoint(P,LEVEL%SenD2(I,J,P)+1,LEVEL%PlanesSend(I,J))) 1730 | PlaneBuffSendPoints(3,J,P)=DBLE(LEVEL%YPoint(P,LEVEL%SenD2(I,J,P)+1,LEVEL%PlanesSend(I,J))) 1731 | PlaneBuffSendPoints(4,J,P)=DBLE(LEVEL%ZPoint(P,LEVEL%SenD2(I,J,P)+1,LEVEL%PlanesSend(I,J))) 1732 | ENDDO 1733 | ENDDO 1734 | 1735 | 1736 | 1737 | DO P=1,4 1738 | DO J=1,LEVEL%NB(I) 1739 | KK=INT(PlaneBuffSendPoints(4,J,P)) 1740 | JJ=INT(PlaneBuffSendPoints(3,J,P)) 1741 | II=INT(PlaneBuffSendPoints(2,J,P)) 1742 | IF(FLAG1.eq.0) PlaneBuffSendPoints(5,J,P)=LEVEL%PHI(II,JJ,KK) 1743 | IF(FLAG1.eq.1) PlaneBuffSendPoints(5,J,P)=LEVEL%ERR(II,JJ,KK) 1744 | 1745 | ENDDO 1746 | ENDDO 1747 | 1748 | DO P=1,4 1749 | DO J=1,LEVEL%NB(I) 1750 | call MPI_SendRecv(PlaneBuffSendPoints(:,J,P),5,MPI_DOUBLE_PRECISION,LEVEL%SEND2(I,J,P),MPI_ANY_TAG,LEVEL%PointBuffRecV(:,J,P),& 1751 | & 5,MPI_DOUBLE_PRECISION,LEVEL%RECV2(I,J,P),MPI_ANY_TAG,COMM,stat,ierr) 1752 | ENDDO 1753 | ENDDO 1754 | 1755 | 1756 | END SUBROUTINE UPDATE 1757 | 1758 | 1759 | SUBROUTINE SSORT (X, N) 1760 | IMPLICIT NONE 1761 | INTEGER N 1762 | INTEGER X(N) 1763 | INTEGER TEMP 1764 | INTEGER I, J 1765 | 1766 | DO I=1,N-1 1767 | DO J=I,N-1 1768 | IF(X(I).LT.X(J+1)) THEN 1769 | TEMP=X(I) 1770 | X(I)=X(J+1) 1771 | X(J+1)=TEMP 1772 | ENDIF 1773 | ENDDO 1774 | ENDDO 1775 | END SUBROUTINE SSORT 1776 | 1777 | 1778 | SUBROUTINE ITERATE(LEVEL,flag,lamN,MYID,COMM,FLAG1) 1779 | USE LevelType 1780 | IMPLICIT NONE 1781 | INCLUDE 'mpif.h' 1782 | INTEGER MYID,IERR,stat(MPI_STATUS_SIZE),COMM,JJ,II,KK,Df1,Df2,PNT,CNT,Df3,PlaneMaxDim 1783 | INTEGER NBI,FLAG1,NN 1784 | REAL*8 :: phiIm,phiIp,phiJm,phiJp,phiKm,phiKp 1785 | INTEGER:: CpuN 1786 | INTEGER NDIM,ITER,MAXITER,I,J,K,IP,IM,JP,JM,KP,KM,P,NDIM2,CNT2,CNT1,M,O,CNTTT 1787 | REAL*8 SUMMHARTREE,EPS1,EPS2,EPS3,EPS4,EPS5,EPS6,D_MAP,s8umm,summ_prev,error 1788 | REAL*8 coeff2,omega,coeff1,summ1,IND(7),lamN,Momega 1789 | LOGICAL TEST,FLAG 1790 | TYPE (LevelStruct)::Level 1791 | 1792 | omega=2./(1.+SQRT(1.-lamN)) 1793 | Momega=1.-omega 1794 | 1795 | 1796 | 1797 | NDIM=LEVEL%NDIM 1798 | call UpdateBoundary(MYID,Level,COMM,FLAG1) 1799 | CpuN=MYID+1 1800 | DO K=LEVEL%Z1(CpuN),LEVEL%Z2(CpuN) 1801 | DO J=LEVEL%Y1(CpuN),LEVEL%Y2(CpuN) 1802 | DO I=LEVEL%X1(CpuN),LEVEL%X2(CpuN) 1803 | TEST=MOD((I+J+K),2).EQ.0 1804 | IF(TEST.EQ.FLAG) THEN 1805 | ip=I+1 1806 | im=I-1 1807 | jp=J+1 1808 | jm=J-1 1809 | kp=K+1 1810 | km=K-1 1811 | 1812 | 1813 | IF(I.EQ.NDIM) ip=1 1814 | IF(J.EQ.NDIM) jp=1 1815 | IF(K.EQ.NDIM) kp=1 1816 | IF(I.EQ.1) im=NDIM 1817 | IF(J.EQ.1) jm=NDIM 1818 | IF(K.EQ.1) km=NDIM 1819 | 1820 | phiIm=LEVEL%phi(im,j,k) 1821 | phiIp=LEVEL%phi(ip,j,k) 1822 | phiJm=LEVEL%phi(i,jm,k) 1823 | phiJp=LEVEL%phi(i,jp,k) 1824 | phiKm=LEVEL%phi(i,j,km) 1825 | phiKp=LEVEL%phi(i,j,kp) 1826 | eps1=LEVEL%eps(5,i,j,k) 1827 | 1828 | d_map=1./(6.+eps1) 1829 | coeff1=LEVEL%phi(i,j,k) 1830 | coeff2=(phiIm+phiIp+phiJm+phiJp+phiKm+phiKp)*d_map 1831 | coeff2=coeff2*omega+Momega*coeff1+omega*LEVEL%rhs(i,j,k)*d_map 1832 | LEVEL%phi(i,j,k)=coeff2 1833 | 1834 | ENDIF 1835 | ENDDO 1836 | ENDDO 1837 | ENDDO 1838 | 1839 | END SUBROUTINE ITERATE 1840 | 1841 | 1842 | SUBROUTINE UpdateBoundary(MYID,LeveL,COMM,FLAG1) 1843 | USE LevelType 1844 | IMPLICIT NONE 1845 | INCLUDE 'mpif.h' 1846 | INTEGER MYID,IERR,stat(MPI_STATUS_SIZE),COMM,JJ,II,KK,Df1,Df2,PNT,CNT,Df3 1847 | INTEGER NBI,FLAG1,NN 1848 | INTEGER::X1,X2,Y1,Y2,Z1,Z2,L 1849 | REAL*8 :: phiIm,phiIp,phiJm,phiJp,phiKm,phiKp 1850 | INTEGER:: CpuN 1851 | INTEGER NDIM,ITER,MAXITER,I,J,K,IP,IM,JP,JM,KP,KM,P,NDIM2,CNT2,CNT1,M,O,CNTTT 1852 | REAL*8 SUMMHARTREE,EPS1,EPS2,EPS3,EPS4,EPS5,EPS6,D_MAP,summ,summ_prev,error 1853 | REAL*8 coeff2,omega,coeff1,summ1,IND(7),lamN,Momega 1854 | TYPE (LevelStruct)::Level 1855 | 1856 | NDIM=LEVEL%NDIM 1857 | CpuN=MYID+1 1858 | 1859 | DO P=1,LEVEL%NB(CpuN) 1860 | DO K=INT(LEVEL%PlaneBuffRecV(6,P)),INT(LEVEL%PlaneBuffRecV(7,P)) 1861 | DO J=INT(LEVEL%PlaneBuffRecV(4,P)),INT(LEVEL%PlaneBuffRecV(5,P)) 1862 | DO I=INT(LEVEL%PlaneBuffRecV(2,P)),INT(LEVEL%PlaneBuffRecV(3,P)) 1863 | 1864 | IF(INT(LEVEL%PlaneBuffRecv(1,P)).eq.1) then 1865 | Df1=ABS(INT(LEVEL%PlaneBuffRecV(4,P))-INT(LEVEL%PlaneBuffRecV(5,P)))+1 1866 | PNT=(J-INT(LEVEL%PlaneBuffRecV(4,P)))+Df1*(K-INT(LEVEL%PlaneBuffRecV(6,P)))+8 1867 | phiIm=LEVEL%PlaneBuffRecV(PNT,1) 1868 | IF(FLAG1.eq.0) LEVEL%phi(i,j,k)=phiIm 1869 | IF(FLAG1.eq.1) LEVEL%err(i,j,k)=phiIm 1870 | ENDIF 1871 | 1872 | IF(INT(LEVEL%PlaneBuffRecv(1,P)).eq.2) then 1873 | Df1=ABS(INT(LEVEL%PlaneBuffRecV(4,P))-INT(LEVEL%PlaneBuffRecV(5,P)))+1 1874 | PNT=(J-INT(LEVEL%PlaneBuffRecV(4,P)))+Df1*(K-INT(LEVEL%PlaneBuffRecV(6,P)))+8 1875 | phiIp=LEVEL%PlaneBuffRecV(PNT,2) 1876 | IF(FLAG1.eq.0) LEVEL%phi(i,j,k)=phiIp 1877 | IF(FLAG1.eq.1) LEVEL%err(i,j,k)=phiIp 1878 | ENDIF 1879 | 1880 | IF(INT(LEVEL%PlaneBuffRecv(1,P)).eq.3) then 1881 | Df3=ABS(INT(LEVEL%PlaneBuffRecV(2,P))-INT(LEVEL%PlaneBuffRecV(3,P)))+1 1882 | PNT=(I-INT(LEVEL%PlaneBuffRecV(2,P)))+Df3*(K-INT(LEVEL%PlaneBuffRecV(6,P)))+8 1883 | phiJm=LEVEL%PlaneBuffRecV(PNT,3) 1884 | IF(FLAG1.eq.0) LEVEL%phi(i,j,k)=phiJm 1885 | IF(FLAG1.eq.1) LEVEL%err(i,j,k)=phiJm 1886 | ENDIF 1887 | 1888 | IF(INT(LEVEL%PlaneBuffRecv(1,P)).eq.4) then 1889 | Df3=ABS(INT(LEVEL%PlaneBuffRecV(2,P))-INT(LEVEL%PlaneBuffRecV(3,P)))+1 1890 | PNT=(I-INT(LEVEL%PlaneBuffRecV(2,P)))+Df3*(K-INT(LEVEL%PlaneBuffRecV(6,P)))+8 1891 | phiJp=LEVEL%PlaneBuffRecV(PNT,4) 1892 | IF(FLAG1.eq.0) LEVEL%phi(i,j,k)=phiJp 1893 | IF(FLAG1.eq.1) LEVEL%err(i,j,k)=phiJp 1894 | ENDIF 1895 | 1896 | IF(INT(LEVEL%PlaneBuffRecv(1,P)).eq.5) then 1897 | Df3=ABS(INT(LEVEL%PlaneBuffRecV(2,P))-INT(LEVEL%PlaneBuffRecV(3,P)))+1 1898 | PNT=(I-INT(LEVEL%PlaneBuffRecV(2,P)))+Df3*(J-INT(LEVEL%PlaneBuffRecV(4,P)))+8 1899 | phiKm=LEVEL%PlaneBuffRecV(PNT,5) 1900 | IF(FLAG1.eq.0) LEVEL%phi(i,j,k)=phiKm 1901 | IF(FLAG1.eq.1) LEVEL%err(i,j,k)=phiKm 1902 | ENDIF 1903 | 1904 | IF(INT(LEVEL%PlaneBuffRecv(1,P)).eq.6) then 1905 | Df3=ABS(INT(LEVEL%PlaneBuffRecV(2,P))-INT(LEVEL%PlaneBuffRecV(3,P)))+1 1906 | PNT=(I-INT(LEVEL%PlaneBuffRecV(2,P)))+Df3*(J-INT(LEVEL%PlaneBuffRecV(4,P)))+8 1907 | phiKp=LEVEL%PlaneBuffRecV(PNT,6) 1908 | IF(FLAG1.eq.0) LEVEL%phi(i,j,k)=phiKp 1909 | IF(FLAG1.eq.1) LEVEL%err(i,j,k)=phiKp 1910 | ENDIF 1911 | ENDDO 1912 | ENDDO 1913 | ENDDO 1914 | ENDDO 1915 | 1916 | DO J=1,LEVEL%NB(CpuN) 1917 | DO P=1,4 1918 | CNT=7 1919 | KK=INT(LEVEL%PointBuffRecV(4,J,P)) 1920 | JJ=INT(LEVEL%PointBuffRecV(3,J,P)) 1921 | II=INT(LEVEL%PointBuffRecV(2,J,P)) 1922 | IF(FLAG1.eq.0) LEVEL%phi(II,JJ,KK)=LEVEL%PointBuffRecV(5,J,P) 1923 | IF(FLAG1.eq.1) LEVEL%err(II,JJ,KK)=LEVEL%PointBuffRecV(5,J,P) 1924 | DO KK=INT(LEVEL%LineBuffRecV(6,J,P)),INT(LEVEL%LineBuffRecV(7,J,P)) 1925 | DO JJ=INT(LEVEL%LineBuffRecV(4,J,P)),INT(LEVEL%LineBuffRecV(5,J,P)) 1926 | DO II=INT(LEVEL%LineBuffRecV(2,J,P)),INT(LEVEL%LineBuffRecV(3,J,P)) 1927 | CNT=CNT+1 1928 | IF(FLAG1.eq.0) LEVEL%phi(II,JJ,KK)=LEVEL%LineBuffRecV(CNT,J,P) 1929 | IF(FLAG1.eq.1) LEVEL%err(II,JJ,KK)=LEVEL%LineBuffRecV(CNT,J,P) 1930 | ENDDO 1931 | ENDDO 1932 | ENDDO 1933 | ENDDO 1934 | ENDDO 1935 | 1936 | END SUBROUTINE UpdateBoundary 1937 | --------------------------------------------------------------------------------