Actual source code: ex5fs.F

  1: !
  2: ! "$Id: ex5fs.F,v 1.8 2001/08/07 03:04:16 balay Exp $";
  3: !

  5: ! ---------------------------------------------------------------------
  6: !
  7: !  Fortran version of the user function based on shared memory
  8: !  this routine is called only by MPI process 0 in the computation
  9: !  but uses threads to run the loops in parallel.

 11: !
 12: !  Input Parameter:
 13: !  x - global array containing input values
 14: !
 15: !  Output Parameters:
 16: !  f - global array containing output values
 17: !  ierr - error code
 18: !
 19: !  Notes:
 20: !  This routine uses standard Fortran-style computations over a 2-dim array.
 21: !
 22:       subroutine ApplicationFunctionFortran(lambda,mx,my,x,f,ierr)

 24:       implicit none

 26:  #include include/finclude/petsc.h
 27:       integer  ierr,mx,my

 29: !  Input/output variables:
 30:       PetscScalar   x(mx,my),f(mx,my),lambda


 33: !  Local variables:
 34:       PetscScalar   two,one,hx,hy,hxdhy,hydhx,sc
 35:       PetscScalar   u,uxx,uyy
 36:       integer  i,j

 38:       one    = 1.0
 39:       two    = 2.0
 40:       hx     = one/dble(mx-1)
 41:       hy     = one/dble(my-1)
 42:       sc     = hx*hy*lambda
 43:       hxdhy  = hx/hy
 44:       hydhx  = hy/hx

 46: !  Compute function over the entire grid

 48:       do 20 j=1,my
 49:          do 10 i=1,mx
 50:             if (i .eq. 1 .or. j .eq. 1                                  &
 51:      &             .or. i .eq. mx .or. j .eq. my) then
 52:                f(i,j) = x(i,j)
 53:             else
 54:                u = x(i,j)
 55:                uxx = hydhx * (two*u                                     &
 56:      &                - x(i-1,j) - x(i+1,j))
 57:                uyy = hxdhy * (two*u - x(i,j-1) - x(i,j+1))
 58:                f(i,j) = uxx + uyy - sc*exp(u)
 59:             endif
 60:  10      continue
 61:  20   continue

 63:       return
 64:       end