pde1.h90

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

      PROGRAM PDE1                                                       
!   ==================================================================
!   ===                                                            ===
!   ===           GENESIS Distributed Memory Benchmarks            ===
!   ===                                                            ===
!   ===   3-Dimensional Poisson Solver Using Red-Black Relaxation  ===
!   ===                      Subset HPF version                    ===
!   ===                                                            ===
!   ===     Original author:  Max Lemke (1989, PALLAS GmbH)        ===
!   ===              PALLAS GmbH                                   ===
!   ===              Hermulheimer Str. 10                          ===
!   ===              5040 Bruhl, GERMANY                           ===
!   ===     tel.:[phone]   e-mail:[e-mail]      ===
!   ===                                                            ===
!   ===          Subset HPF:  Vladimir Getov                       ===
!   ===                       (1993, University of Southampton)    ===
!   ===                                                            ===
!   ===          Last update: May 1993; Release: 2.2               ===
!   ===                                                            ===
!   ==================================================================
!                                                                       
!     FOR NUMERICAL VERIFICATION:                                       
!	 THE AVERAGE CONVERGENCE RATE SHOULD BE SOMEWHERE BETWEEN             
!	 0.7 AND 0.98                                                         
!                                                                       
!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
!                                                                       
!     THE TIMER (DOUBLE PRECISION IN SECONDS) IS CALLED IN MAIN PROGRAM.
!     THE MACHINE DEPENDENT TIMING ROUTINE HAS TO BE INCLUDED.          
!                                                                       
!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
!                                                                       
       IMPLICIT NONE                                                     
       INTEGER NX, NY, NZ, NPTS, NOP, NW1
       DOUBLE PRECISION H, RES, RES1, RES2, CONVR, RMFLOP, SEC1, SEC2    
!                                                                       
!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
!                                                                       
      INCLUDE 'proc.inc'                                                 
      INCLUDE 'pde1.inc'                                                 
!                                                                       
!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
!                                                                       
      PARAMETER (NX=2**N)
      PARAMETER (NY=NX)
      PARAMETER (NZ=NX)

      PARAMETER(NW1=11)                                                  
                                                                        
      DOUBLE PRECISION U(NX,NY,NZ),F(NX,NY,NZ)                           
      LOGICAL RED(NX,NY,NZ)                                              

!     .. Data Distribution ..                                           

      INTEGER I, J, K
                                                                        
!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                       
                                                                        
      H=1.0D0/(NX-1)                                                     
                                                                        
      OPEN(NW1,FILE='result')                                            
      CALL HEADER(NW1)                                                   
      WRITE(NW1,91000)                                                   
91000 FORMAT(' ***** 3D RED BLACK RELAXATION BENCHMARK ************* '/ &
     &    )                                                             
!                                                                       
        CALL INIT(U,F,RED,NX,NY,NZ,H)                                    
        RES1=RES(U,F,NX,NY,NZ,H)                                         
!----------------> TIMER IN SECONDS                                     
        CALL TIMER(SEC1)                                                 
        CALL RELAX(U,F,RED,NX,NY,NZ,H,NITER)                             
        CALL TIMER(SEC2)                                                 
!----------------> TIMER IN SECONDS
        RES2=RES(U,F,NX,NY,NZ,H)                                         
        CONVR=(RES2/RES1)**(0.1)                                         
        NPTS = (NX-2)*(NY-2)*(NZ-2)                                      
        WRITE(NW1,9100) NX-2, NY-2, NZ-2, NPTS, NITER, CONVR             
!                                                                       
        NOP = NPTS*8                                                     
        RMFLOP = (NOP/1000000.)/(SEC2-SEC1)*NITER                        
                                                                        
        WRITE(NW1,900) (SEC2-SEC1)/NITER,NOP, RMFLOP                     
        WRITE(NW1,'(////)')                                              
 9100 FORMAT (/' NUMBER OF INTERNAL POINTS PER DIRECTION = ', 3I12 /    &
     &        ' INTERNAL GRIDSIZE OF CUBIC  GRID =        ', I12/       &
     &        ' AVERAGE CONV. RATE (', I6, 'ITER.)  = ', D12.4/)        
  900  FORMAT(/' TIME FOR 1 RELAX (SEC.):', E15.8/                      &
     &           ' NUMBER OF OPERATIONS:   ',I15/                       &
     &           ' PERFORMANCE IN MFLOP/S: ',F15.5/)                    
!                                                                       
      CLOSE(NW1)                                                         
                                                                        
      STOP                                                               
      END                                           
!                                                                       
!                                                                       
      SUBROUTINE RELAX(U,F,RED,NX,NY,NZ,H,ITER)                          
!--------------------------------------------------------C              
!     3D RED BLACK RELAXATION STANDARD IMPLEMENTATION    C              
!--------------------------------------------------------C              
                                                                        
      IMPLICIT NONE                                                      
      INTEGER NX, NY, NZ, ITER, NREL                                     
      DOUBLE PRECISION H,HSQ,FACTOR                                      
      DOUBLE PRECISION U(NX,NY,NZ), F(NX,NY,NZ)                          
      LOGICAL RED(NX,NY,NZ)                                              
                                                                        
!     .. Data Distribution ..                                           
                                                                        
      INCLUDE 'proc.inc'                                                 

      INTEGER I, J, K

!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
                                                                        
      HSQ = H*H                                                          
      FACTOR = 1.0D0/6.0D0                                               
                                                                        
      DO NREL=1,ITER                                                     
                                                                        
!     .. Array Constructs ..                                            
                                                                        
        WHERE(RED(2:NX-1,2:NY-1,2:NZ-1))                                 
!