pde1.h90

来自「shpf 1.9一个并行编译器」· H90 代码 · 共 256 行 · 第 1/2 页

!     RELAXATION OF THE RED POINTS                                      
!                                                                       
        U(2:NX-1,2:NY-1,2:NZ-1) =                                       &
     &              FACTOR*(HSQ*F(2:NX-1,2:NY-1,2:NZ-1)+                &
     &    U(1:NX-2,2:NY-1,2:NZ-1)+U(3:NX,2:NY-1,2:NZ-1)+                &
     &    U(2:NX-1,1:NY-2,2:NZ-1)+U(2:NX-1,3:NY,2:NZ-1)+                &
     &    U(2:NX-1,2:NY-1,1:NZ-2)+U(2:NX-1,2:NY-1,3:NZ))                
                                                                        
        ELSEWHERE                                                        
!                                                                       
!     RELAXATION OF THE BLACK POINTS                                    
!                                                                       
        U(2:NX-1,2:NY-1,2:NZ-1) =                                       &
     &              FACTOR*(HSQ*F(2:NX-1,2:NY-1,2:NZ-1)+                &
     &    U(1:NX-2,2:NY-1,2:NZ-1)+U(3:NX,2:NY-1,2:NZ-1)+                &
     &    U(2:NX-1,1:NY-2,2:NZ-1)+U(2:NX-1,3:NY,2:NZ-1)+                &
     &    U(2:NX-1,2:NY-1,1:NZ-2)+U(2:NX-1,2:NY-1,3:NZ))                
                                                                        
        END WHERE                                                        
                                                                        
      ENDDO                                                              
                                                                        
      END                                           
                                                                        
      DOUBLE PRECISION FUNCTION RES(U,F,NX,NY,NZ,H)                      
!                                                                       
!	COMPUTES THE MAXIMUM NORM OF THE DEFECT                               
!                                                                       
      IMPLICIT NONE                                                      
      INTEGER NX, NY, NZ                                                 
      DOUBLE PRECISION H, FAC                                            
      DOUBLE PRECISION U(NX,NY,NZ), F(NX,NY,NZ)                          
                                                                        
!     .. Data Distribution ..                                           
                                                                        
      INCLUDE 'proc.inc'                                                 

      INTEGER I, J, K

!HPF$ ALIGN U(I,J,K) WITH *F(I,J,K)                                   
!HPF$ DISTRIBUTE  F *(BLOCK,BLOCK,BLOCK) ONTO *FARM
                                                                        
!                                                                       
      FAC=1/(H*H)                                                        
                                                                        
      RES = MAXVAL(ABS(F(2:NX-1,2:NY-1,2:NZ-1)+                         &
     &      FAC*(-6.0*U(2:NX-1,2:NY-1,2:NZ-1)+                          &
     &      U(1:NX-2,2:NY-1,2:NZ-1)+U(3:NX,2:NY-1,2:NZ-1)+              &
     &      U(2:NX-1,1:NY-2,2:NZ-1)+U(2:NX-1,3:NY,2:NZ-1)+              &
     &      U(2:NX-1,2:NY-1,1:NZ-2)+U(2:NX-1,2:NY-1,3:NZ))))            
                                                                        
      END                                           
!                                                                       
!.......................................................................
!                                                                       
      SUBROUTINE INIT(U,F,RED,NX,NY,NZ,H)                                
                                                                        
      IMPLICIT NONE                                                      
      INTEGER NX, NY, NZ, I, J, K                                        
      DOUBLE PRECISION H, X, Y, Z, G                                     
      DOUBLE PRECISION U(NX,NY,NZ),F(NX,NY,NZ)                           
      LOGICAL RED(NX,NY,NZ)                                              
                                                                        
!     .. Data Distribution ..                                           
                                                                        
      INCLUDE 'proc.inc'                                                 

!HPF$ ALIGN U(I,J,K) WITH *RED(I,J,K)                                   
!HPF$ ALIGN F(I,J,K) WITH *RED(I,J,K)                                   
!HPF$ DISTRIBUTE RED *(BLOCK,BLOCK,BLOCK) ONTO *FARM
                                                                        
!     INITIALISATION OF BOUNDARY POINTS (X = 0.0 & 1.0)                 
      X = (NX-1) * H                                                     
      DO K = 1, NZ                                                       
          Z = (K-1) * H                                                  
          DO J = 1, NY                                                   
              Y = (J-1) * H                                              
              U(1,J,K) = G(0.0D0,Y,Z)                                    
              U(NX,J,K) = G(X,Y,Z)                                       
          ENDDO                                                          
      ENDDO                                                              
                                                                        
                                                                        
!     INITIALISATION OF BOUNDARY POINTS (Y = 0.0 & 1.0)                 
      Y = (NY-1) * H                                                     
      DO K = 1, NZ                                                       
          Z = (K-1) * H                                                  
          DO I = 1, NX                                                   
              X = (I-1) * H                                              
              U(I,1,K) = G(X,0.0D0,Z)                                    
              U(I,NY,K) = G(X,Y,Z)                                       
          ENDDO                                                          
      ENDDO                                                              
                                                                        
!     INITIALISATION OF BOUNDARY POINTS (Z = 0.0 & 1.0)                 
      Z = (NZ-1) * H                                                     
      DO J = 1, NY                                                       
          Y = (J-1) * H                                                  
          DO I = 1, NX                                                   
              X = (I-1) * H                                              
              U(I,J,1) = G(X,Y,0.0D0)                                    
              U(I,J,NZ) = G(X,Y,Z)                                       
          ENDDO                                                          
      ENDDO                                                              
                                                                        
!     INITIALISATION OF INNER POINTS                                    
                                                                        
      U(2:NX-1,2:NY-1,2:NZ-1) = 0.                                       
      F(2:NX-1,2:NY-1,2:NZ-1) = 6.                                       
!                                                                       
                                                                        
!     INITIALISATION OF THE RED-BLACK LOGICAL ARRAY                     
                                                                        
      RED(2:NX-1:2,2:NY-1,2:NZ-1) = .TRUE.                               
      RED(3:NX-1:2,2:NY-1,2:NZ-1) = .FALSE.                              
                                                                        
      END                                           
                                                                        
      DOUBLE PRECISION FUNCTION G(X, Y, Z)                               
!                                                                       
!    G IS THE BOUNDARY VALUE FUNCTION FROM THE POISSON EQUATION         
!                                                                       
      DOUBLE PRECISION X, Y, Z                                           
                                                                        
      G = X*X + Y*Y + Z*Z                                                
                                                                        
      END