examples/smpi/NAS/LU/l2norm.f

   1
   2 c---------------------------------------------------------------------
   3 c---------------------------------------------------------------------
   4       subroutine l2norm ( ldx, ldy, ldz,
   5      >                    nx0, ny0, nz0,
   6      >                    ist, iend,
   7      >                    jst, jend,
   8      >                    v, sum )
   9 c---------------------------------------------------------------------
  10 c---------------------------------------------------------------------
  11
  12 c---------------------------------------------------------------------
  13 c   to compute the l2-norm of vector v.
  14 c---------------------------------------------------------------------
  15
  16       implicit none
  17
  18       include 'mpinpb.h'
  19
  20 c---------------------------------------------------------------------
  21 c  input parameters
  22 c---------------------------------------------------------------------
  23       integer ldx, ldy, ldz
  24       integer nx0, ny0, nz0
  25       integer ist, iend
  26       integer jst, jend
  27       double precision  v(5,-1:ldx+2,-1:ldy+2,*), sum(5)
  28
  29 c---------------------------------------------------------------------
  30 c  local variables
  31 c---------------------------------------------------------------------
  32       integer i, j, k, m
  33       double precision  dummy(5)
  34
  35       integer IERROR
  36
  37
  38       do m = 1, 5
  39          dummy(m) = 0.0d+00
  40       end do
  41
  42       do k = 2, nz0-1
  43          do j = jst, jend
  44             do i = ist, iend
  45                do m = 1, 5
  46                   dummy(m) = dummy(m) + v(m,i,j,k) * v(m,i,j,k)
  47                end do
  48             end do
  49          end do
  50       end do
  51
  52 c---------------------------------------------------------------------
  53 c   compute the global sum of individual contributions to dot product.
  54 c---------------------------------------------------------------------
  55       call MPI_ALLREDUCE( dummy,
  56      >                    sum,
  57      >                    5,
  58      >                    dp_type,
  59      >                    MPI_SUM,
  60      >                    MPI_COMM_WORLD,
  61      >                    IERROR )
  62
  63       do m = 1, 5
  64          sum(m) = sqrt ( sum(m) / ( (nx0-2)*(ny0-2)*(nz0-2) ) )
  65       end do
  66
  67       return
  68       end