Actual source code: ex5fs.F

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

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

 21:       implicit none

 23:  #include finclude/petscsys.h
 24:       integer  ierr,mx,my

 26: !  Input/output variables:
 27:       PetscScalar   x(mx,my),f(mx,my),lambda


 30: !  Local variables:
 31:       PetscScalar   two,one,hx,hy,hxdhy,hydhx,sc
 32:       PetscScalar   u,uxx,uyy
 33:       integer  i,j

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

 43: !  Compute function over the entire grid

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

 60:       return
 61:       end