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 include/finclude/petsc.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