summaryrefslogtreecommitdiff
path: root/gcc/testsuite/gfortran.dg/graphite/run-id-2.f90
diff options
context:
space:
mode:
authorupstream source tree <ports@midipix.org>2015-03-15 20:14:05 -0400
committerupstream source tree <ports@midipix.org>2015-03-15 20:14:05 -0400
commit554fd8c5195424bdbcabf5de30fdc183aba391bd (patch)
tree976dc5ab7fddf506dadce60ae936f43f58787092 /gcc/testsuite/gfortran.dg/graphite/run-id-2.f90
downloadcbb-gcc-4.6.4-554fd8c5195424bdbcabf5de30fdc183aba391bd.tar.bz2
cbb-gcc-4.6.4-554fd8c5195424bdbcabf5de30fdc183aba391bd.tar.xz
obtained gcc-4.6.4.tar.bz2 from upstream website;upstream
verified gcc-4.6.4.tar.bz2.sig; imported gcc-4.6.4 source tree from verified upstream tarball. downloading a git-generated archive based on the 'upstream' tag should provide you with a source tree that is binary identical to the one extracted from the above tarball. if you have obtained the source via the command 'git clone', however, do note that line-endings of files in your working directory might differ from line-endings of the respective files in the upstream repository.
Diffstat (limited to 'gcc/testsuite/gfortran.dg/graphite/run-id-2.f90')
-rw-r--r--gcc/testsuite/gfortran.dg/graphite/run-id-2.f9066
1 files changed, 66 insertions, 0 deletions
diff --git a/gcc/testsuite/gfortran.dg/graphite/run-id-2.f90 b/gcc/testsuite/gfortran.dg/graphite/run-id-2.f90
new file mode 100644
index 000000000..c4fa1d061
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/graphite/run-id-2.f90
@@ -0,0 +1,66 @@
+ IMPLICIT NONE
+ INTEGER, PARAMETER :: dp=KIND(0.0D0)
+ REAL(KIND=dp) :: res
+
+ res=exp_radius_very_extended( 0 , 1 , 0 , 1, &
+ (/0.0D0,0.0D0,0.0D0/),&
+ (/1.0D0,0.0D0,0.0D0/),&
+ (/1.0D0,0.0D0,0.0D0/),&
+ 1.0D0,1.0D0,1.0D0,1.0D0)
+ if (res.ne.1.0d0) call abort()
+
+CONTAINS
+
+ FUNCTION exp_radius_very_extended(la_min,la_max,lb_min,lb_max,ra,rb,rp,&
+ zetp,eps,prefactor,cutoff) RESULT(radius)
+
+ INTEGER, INTENT(IN) :: la_min, la_max, lb_min, lb_max
+ REAL(KIND=dp), INTENT(IN) :: ra(3), rb(3), rp(3), zetp, &
+ eps, prefactor, cutoff
+ REAL(KIND=dp) :: radius
+
+ INTEGER :: i, ico, j, jco, la(3), lb(3), &
+ lxa, lxb, lya, lyb, lza, lzb
+ REAL(KIND=dp) :: bini, binj, coef(0:20), &
+ epsin_local, polycoef(0:60), &
+ prefactor_local, rad_a, &
+ rad_b, s1, s2
+
+ epsin_local=1.0E-2_dp
+
+ prefactor_local=prefactor*MAX(1.0_dp,cutoff)
+ rad_a=SQRT(SUM((ra-rp)**2))
+ rad_b=SQRT(SUM((rb-rp)**2))
+
+ polycoef(0:la_max+lb_max)=0.0_dp
+ DO lxa=0,la_max
+ DO lxb=0,lb_max
+ coef(0:la_max+lb_max)=0.0_dp
+ bini=1.0_dp
+ s1=1.0_dp
+ DO i=0,lxa
+ binj=1.0_dp
+ s2=1.0_dp
+ DO j=0,lxb
+ coef(lxa+lxb-i-j)=coef(lxa+lxb-i-j) + bini*binj*s1*s2
+ binj=(binj*(lxb-j))/(j+1)
+ s2=s2*(rad_b)
+ ENDDO
+ bini=(bini*(lxa-i))/(i+1)
+ s1=s1*(rad_a)
+ ENDDO
+ DO i=0,lxa+lxb
+ polycoef(i)=MAX(polycoef(i),coef(i))
+ ENDDO
+ ENDDO
+ ENDDO
+
+ polycoef(0:la_max+lb_max)=polycoef(0:la_max+lb_max)*prefactor_local
+ radius=0.0_dp
+ DO i=0,la_max+lb_max
+ radius=MAX(radius,polycoef(i)**(i+1))
+ ENDDO
+
+ END FUNCTION exp_radius_very_extended
+
+END