laplace2d.f90 3.4 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192
  1. ! Copyright (c) 2012, NVIDIA CORPORATION. All rights reserved.
  2. !
  3. ! Redistribution and use in source and binary forms, with or without
  4. ! modification, are permitted provided that the following conditions
  5. ! are met:
  6. ! * Redistributions of source code must retain the above copyright
  7. ! notice, this list of conditions and the following disclaimer.
  8. ! * Redistributions in binary form must reproduce the above copyright
  9. ! notice, this list of conditions and the following disclaimer in the
  10. ! documentation and/or other materials provided with the distribution.
  11. ! * Neither the name of NVIDIA CORPORATION nor the names of its
  12. ! contributors may be used to endorse or promote products derived
  13. ! from this software without specific prior written permission.
  14. !
  15. ! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS ``AS IS'' AND ANY
  16. ! EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
  17. ! IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
  18. ! PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR
  19. ! CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
  20. ! EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
  21. ! PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
  22. ! PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY
  23. ! OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
  24. ! (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
  25. ! OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
  26. module laplace2d
  27. public :: initialize
  28. public :: calcNext
  29. public :: swap
  30. public :: dealloc
  31. contains
  32. subroutine initialize(A, Anew, m, n)
  33. integer, parameter :: fp_kind=kind(1.0d0)
  34. real(fp_kind),allocatable,intent(out) :: A(:,:)
  35. real(fp_kind),allocatable,intent(out) :: Anew(:,:)
  36. integer,intent(in) :: m, n
  37. allocate ( A(0:n-1,0:m-1), Anew(0:n-1,0:m-1) )
  38. A = 0.0_fp_kind
  39. Anew = 0.0_fp_kind
  40. A(0,:) = 1.0_fp_kind
  41. Anew(0,:) = 1.0_fp_kind
  42. end subroutine initialize
  43. function calcNext(A, Anew, m, n)
  44. integer, parameter :: fp_kind=kind(1.0d0)
  45. real(fp_kind),intent(inout) :: A(0:n-1,0:m-1)
  46. real(fp_kind),intent(inout) :: Anew(0:n-1,0:m-1)
  47. integer,intent(in) :: m, n
  48. integer :: i, j
  49. real(fp_kind) :: error
  50. error=0.0_fp_kind
  51. !$acc parallel loop reduction(max:error) copyin(A(:,:)) copy(Anew(:,:))
  52. do j=1,m-2
  53. do i=1,n-2
  54. Anew(i,j) = 0.25_fp_kind * ( A(i+1,j ) + A(i-1,j ) + &
  55. A(i ,j-1) + A(i ,j+1) )
  56. error = max( error, abs(Anew(i,j)-A(i,j)) )
  57. end do
  58. end do
  59. calcNext = error
  60. end function calcNext
  61. subroutine swap(A, Anew, m, n)
  62. integer, parameter :: fp_kind=kind(1.0d0)
  63. real(fp_kind),intent(out) :: A(0:n-1,0:m-1)
  64. real(fp_kind),intent(in) :: Anew(0:n-1,0:m-1)
  65. integer,intent(in) :: m, n
  66. integer :: i, j
  67. !$acc parallel loop copyin(Anew(:,:)) copyout(A(:,:))
  68. do j=1,m-2
  69. do i=1,n-2
  70. A(i,j) = Anew(i,j)
  71. end do
  72. end do
  73. end subroutine swap
  74. subroutine dealloc(A, Anew)
  75. integer, parameter :: fp_kind=kind(1.0d0)
  76. real(fp_kind),allocatable,intent(in) :: A
  77. real(fp_kind),allocatable,intent(in) :: Anew
  78. deallocate (A,Anew)
  79. end subroutine
  80. end module laplace2d