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