examples/smpi/NAS/LU/error.f

   1 c---------------------------------------------------------------------
   2 c---------------------------------------------------------------------
   3
   4       subroutine error
   5
   6 c---------------------------------------------------------------------
   7 c---------------------------------------------------------------------
   8
   9 c---------------------------------------------------------------------
  10 c
  11 c   compute the solution error
  12 c
  13 c---------------------------------------------------------------------
  14
  15       implicit none
  16
  17       include 'mpinpb.h'
  18       include 'applu.incl'
  19
  20 c---------------------------------------------------------------------
  21 c  local variables
  22 c---------------------------------------------------------------------
  23       integer i, j, k, m
  24       integer iglob, jglob
  25       double precision  tmp
  26       double precision  u000ijk(5), dummy(5)
  27
  28       integer IERROR
  29
  30
  31       do m = 1, 5
  32          errnm(m) = 0.0d+00
  33          dummy(m) = 0.0d+00
  34       end do
  35
  36       do k = 2, nz-1
  37          do j = jst, jend
  38             jglob = jpt + j
  39             do i = ist, iend
  40                iglob = ipt + i
  41                call exact( iglob, jglob, k, u000ijk )
  42                do m = 1, 5
  43                   tmp = ( u000ijk(m) - u(m,i,j,k) )
  44                   dummy(m) = dummy(m) + tmp ** 2
  45                end do
  46             end do
  47          end do
  48       end do
  49
  50 c---------------------------------------------------------------------
  51 c   compute the global sum of individual contributions to dot product.
  52 c---------------------------------------------------------------------
  53       call MPI_ALLREDUCE( dummy,
  54      >                    errnm,
  55      >                    5,
  56      >                    dp_type,
  57      >                    MPI_SUM,
  58      >                    MPI_COMM_WORLD,
  59      >                    IERROR )
  60
  61       do m = 1, 5
  62          errnm(m) = sqrt ( errnm(m) / ( (nx0-2)*(ny0-2)*(nz0-2) ) )
  63       end do
  64
  65 c      if (id.eq.0) then
  66 c        write (*,1002) ( errnm(m), m = 1, 5 )
  67 c      end if
  68
  69  1002 format (1x/1x,'RMS-norm of error in soln. to ',
  70      > 'first pde  = ',1pe12.5/,
  71      > 1x,'RMS-norm of error in soln. to ',
  72      > 'second pde = ',1pe12.5/,
  73      > 1x,'RMS-norm of error in soln. to ',
  74      > 'third pde  = ',1pe12.5/,
  75      > 1x,'RMS-norm of error in soln. to ',
  76      > 'fourth pde = ',1pe12.5/,
  77      > 1x,'RMS-norm of error in soln. to ',
  78      > 'fifth pde  = ',1pe12.5)
  79
  80       return
  81       end