1! { dg-do compile }
2! { dg-require-effective-target vect_float }
3! { dg-require-visibility "" }
4
5module solv_cap
6
7  implicit none
8
9  public  :: init_solve
10
11  integer, parameter, public :: dp = 4
12
13  real(kind=dp), private :: Pi, Mu0, c0, eps0
14  logical,       private :: UseFFT, UsePreco
15  real(kind=dp), private :: D1, D2
16  integer,       private, save :: Ng1=0, Ng2=0
17  integer,       private, pointer,     dimension(:,:)  :: Grid
18  real(kind=dp), private, allocatable, dimension(:,:)  :: G
19
20contains
21
22  subroutine init_solve(Grid_in, GrSize1, GrSize2, UseFFT_in, UsePreco_in)
23    integer, intent(in), target, dimension(:,:) :: Grid_in
24    real(kind=dp), intent(in)  :: GrSize1, GrSize2
25    logical,       intent(in)  :: UseFFT_in, UsePreco_in
26    integer                    :: i, j
27
28    Pi = acos(-1.0_dp)
29    Mu0 = 4e-7_dp * Pi
30    c0 = 299792458
31    eps0 = 1 / (Mu0 * c0**2)
32
33    UseFFT = UseFFT_in
34    UsePreco = UsePreco_in
35
36    if(Ng1 /= 0 .and. allocated(G) ) then
37      deallocate( G )
38    end if
39
40    Grid => Grid_in
41    Ng1 = size(Grid, 1)
42    Ng2 = size(Grid, 2)
43    D1 = GrSize1/Ng1
44    D2 = GrSize2/Ng2
45
46    allocate( G(0:Ng1,0:Ng2) )
47
48    write(unit=*, fmt=*) "Calculating G"
49    do i=0,Ng1
50      do j=0,Ng2
51        G(j,i) = Ginteg( -D1/2,-D2/2, D1/2,D2/2, i*D1,j*D2 )
52      end do
53    end do
54
55    if(UseFFT) then
56      write(unit=*, fmt=*) "Transforming G"
57      call FourirG(G,1)
58    end if
59
60    return
61
62
63  contains
64  function Ginteg(xq1,yq1, xq2,yq2, xp,yp)  result(G)
65    real(kind=dp), intent(in) :: xq1,yq1, xq2,yq2, xp,yp
66    real(kind=dp)             :: G
67    real(kind=dp)             :: x1,x2,y1,y2,t
68    x1 = xq1-xp
69    x2 = xq2-xp
70    y1 = yq1-yp
71    y2 = yq2-yp
72
73    if (x1+x2 < 0) then
74      t = -x1
75      x1 = -x2
76      x2 = t
77    end if
78    if (y1+y2 < 0) then
79      t = -y1
80      y1 = -y2
81      y2 = t
82    end if
83
84    G = (x2*y2)-(x1*y2)-(x2*y1)+(x1*y1)
85
86    return
87  end function Ginteg
88
89  end subroutine init_solve
90
91end module solv_cap
92
93
94! { dg-final { scan-tree-dump-times "vectorized 1 loops" 1 "vect" { target vect_intfloat_cvt } } }
95