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