Better leverage mathconstants module.

hfp · Apr 19, 2024 · c9bffc1 · c9bffc1
1 parent c9a98bc
commit c9bffc1
Show file tree

Hide file tree

Showing 8 changed files with 25 additions and 19 deletions.
diff --git a/src/aobasis/ai_onecenter.F b/src/aobasis/ai_onecenter.F
@@ -32,7 +32,8 @@ MODULE ai_onecenter
                                               fac,&
                                               gamma0,&
                                               gamma1,&
-                                              pi
+                                              pi,&
+                                              rootpi
 #include "../base/base_uses.f90"
 
    IMPLICIT NONE
@@ -74,7 +75,7 @@ SUBROUTINE sg_overlap(smat, l, pa, pb)
 
       CPASSERT(.NOT. (n > SIZE(smat, 1) .OR. m > SIZE(smat, 2)))
 
-      spi = SQRT(pi)/2.0_dp**(l + 2)*dfac(2*l + 1)
+      spi = rootpi/2.0_dp**(l + 2)*dfac(2*l + 1)
       el = REAL(l, dp) + 1.5_dp
 
       DO iq = 1, m
@@ -111,7 +112,7 @@ SUBROUTINE sg_kinetic(kmat, l, pa, pb)
 
       CPASSERT(.NOT. (n > SIZE(kmat, 1) .OR. m > SIZE(kmat, 2)))
 
-      spi = dfac(2*l + 3)*SQRT(pi)/2.0_dp**(l + 2)
+      spi = dfac(2*l + 3)*rootpi/2.0_dp**(l + 2)
       DO iq = 1, m
          DO ip = 1, n
             kmat(ip, iq) = spi*pa(ip)*pb(iq)/(pa(ip) + pb(iq))**(l + 2.5_dp)

diff --git a/src/atom_energy.F b/src/atom_energy.F
@@ -49,7 +49,8 @@ MODULE atom_energy
                                               dp
    USE mathconstants,                   ONLY: dfac,&
                                               gamma1,&
-                                              pi
+                                              pi,&
+                                              rootpi
    USE periodic_table,                  ONLY: nelem,&
                                               ptable
    USE physcon,                         ONLY: bohr
@@ -583,7 +584,7 @@ SUBROUTINE atom_response_basis(atom, delta, nder, iw)
          WRITE (iw, '(/,A,I0,A,I0,A)') "             Exponent     Coef.(Quickstep Normalization), first ", &
             n - nder, " valence ", nder, " response"
          expzet = 0.25_dp*REAL(2*l + 3, dp)
-         prefac = SQRT(SQRT(pi)/2._dp**(l + 2)*dfac(2*l + 1))
+         prefac = SQRT(rootpi/2._dp**(l + 2)*dfac(2*l + 1))
          DO i = 1, m
             zeta = (2._dp*atom%basis%am(i, l))**expzet
             WRITE (iw, '(4X,F20.10,4X,15ES20.6)') atom%basis%am(i, l), ((prefac*rbasis(i, k, l)/zeta), k=1, n)

diff --git a/src/atom_grb.F b/src/atom_grb.F
@@ -39,7 +39,7 @@ MODULE atom_grb
                                               dp
    USE lapack,                          ONLY: lapack_ssygv
    USE mathconstants,                   ONLY: dfac,&
-                                              pi
+                                              rootpi
    USE orbital_pointers,                ONLY: deallocate_orbital_pointers,&
                                               init_orbital_pointers
    USE orbital_transformation_matrices, ONLY: deallocate_spherical_harmonics,&
@@ -322,7 +322,7 @@ SUBROUTINE atom_grb_construction(atom_info, atom_section, iw)
 
          ! Quickstep normalization
          expzet = 0.25_dp*REAL(2*l + 3, dp)
-         prefac = SQRT(SQRT(pi)/2._dp**(l + 2)*dfac(2*l + 1))
+         prefac = SQRT(rootpi/2._dp**(l + 2)*dfac(2*l + 1))
          DO i = 1, m
             zeta = (2._dp*atom%basis%am(i, l))**expzet
             qbasis(i, 1:n, l) = rbasis(i, 1:n, l)*prefac/zeta
@@ -630,7 +630,7 @@ SUBROUTINE atom_grb_construction(atom_info, atom_section, iw)
       ! Quickstep normalization polarization basis
       DO l = 0, 7
          expzet = 0.25_dp*REAL(2*l + 3, dp)
-         prefac = SQRT(SQRT(pi)/2._dp**(l + 2)*dfac(2*l + 1))
+         prefac = SQRT(rootpi/2._dp**(l + 2)*dfac(2*l + 1))
          DO i = 1, num_pol
             zeta = (2._dp*alp(i))**expzet
             pbasis(i, 1:num_pol, l) = pbasis(i, 1:num_pol, l)*prefac/zeta
@@ -639,7 +639,7 @@ SUBROUTINE atom_grb_construction(atom_info, atom_section, iw)
       ! Quickstep normalization extended basis
       DO l = 0, lmat
          expzet = 0.25_dp*REAL(2*l + 3, dp)
-         prefac = SQRT(SQRT(pi)/2._dp**(l + 2)*dfac(2*l + 1))
+         prefac = SQRT(rootpi/2._dp**(l + 2)*dfac(2*l + 1))
          DO i = 1, next_prim(l)
             zeta = (2._dp*ale(i))**expzet
             ebasis(i, 1:next_bas(l), l) = ebasis(i, 1:next_bas(l), l)*prefac/zeta

diff --git a/src/atom_output.F b/src/atom_output.F
@@ -30,7 +30,8 @@ MODULE atom_output
    USE kinds,                           ONLY: default_string_length,&
                                               dp
    USE mathconstants,                   ONLY: dfac,&
-                                              pi
+                                              pi,&
+                                              rootpi
    USE periodic_table,                  ONLY: ptable
    USE physcon,                         ONLY: evolt
    USE xc_derivatives,                  ONLY: xc_functional_get_info
@@ -472,7 +473,7 @@ SUBROUTINE atom_print_basis_file(atom_basis, wfn)
                      WRITE (iw, '(T3,A,I3)') "L Quantum Number:", l
                      ! Quickstep normalization
                      expzet = 0.25_dp*REAL(2*l + 3, dp)
-                     prefac = SQRT(SQRT(pi)/2._dp**(l + 2)*dfac(2*l + 1))
+                     prefac = SQRT(rootpi/2._dp**(l + 2)*dfac(2*l + 1))
                      DO i = 1, atom_basis%nbas(l)
                         zeta = (2._dp*atom_basis%am(i, l))**expzet
                         WRITE (iw, '(T5,F14.8,2x,6F12.8)') atom_basis%am(i, l), wfn(i, 1:im, l)*prefac/zeta

diff --git a/src/atom_types.F b/src/atom_types.F
@@ -2374,7 +2374,7 @@ SUBROUTINE read_basis_set(element_symbol, basis, basis_set_name, basis_set_file,
       ! Normalization
       DO j = 0, lmat
          expzet = 0.25_dp*REAL(2*j + 3, dp)
-         prefac = SQRT(SQRT(pi)/2._dp**(j + 2)*dfac(2*j + 1))
+         prefac = SQRT(rootpi/2._dp**(j + 2)*dfac(2*j + 1))
          DO ipgf = 1, basis%nprim(j)
             DO ii = 1, basis%nbas(j)
                gcca = basis%cm(ipgf, ii, j)

diff --git a/src/lri_environment_init.F b/src/lri_environment_init.F
@@ -33,7 +33,8 @@ MODULE lri_environment_init
                                               lri_env_create,&
                                               lri_environment_type
    USE mathconstants,                   ONLY: fac,&
-                                              pi
+                                              pi,&
+                                              rootpi
    USE mathlib,                         ONLY: invert_matrix
    USE qs_environment_types,            ONLY: get_qs_env,&
                                               qs_environment_type
@@ -474,7 +475,7 @@ SUBROUTINE basis_norm_radial(basis, norm)
          DO ishell = 1, basis%nshell(iset)
             l = basis%l(ishell, iset)
             expa = 0.5_dp*REAL(2*l + 3, dp)
-            ppl = fac(2*l + 2)*SQRT(pi)/2._dp**REAL(2*l + 3, dp)/fac(l + 1)
+            ppl = fac(2*l + 2)*rootpi/2._dp**REAL(2*l + 3, dp)/fac(l + 1)
             DO isgf = basis%first_sgf(ishell, iset), basis%last_sgf(ishell, iset)
                DO ipgf = 1, basis%npgf(iset)
                   cci = basis%gcc(ipgf, ishell, iset)
@@ -561,7 +562,7 @@ SUBROUTINE basis_ovlp(basis, ovlp, norm)
                   IF (li == lj) THEN
                      l = li
                      expa = 0.5_dp*REAL(2*l + 3, dp)
-                     ppl = fac(2*l + 2)*SQRT(pi)/2._dp**REAL(2*l + 3, dp)/fac(l + 1)
+                     ppl = fac(2*l + 2)*rootpi/2._dp**REAL(2*l + 3, dp)/fac(l + 1)
                      DO isgf = basis%first_sgf(ishell, iset), basis%last_sgf(ishell, iset)
                         m_i = basis%m(isgf)
                         DO jsgf = basis%first_sgf(jshell, jset), basis%last_sgf(jshell, jset)

diff --git a/src/qs_dispersion_nonloc.F b/src/qs_dispersion_nonloc.F
@@ -29,7 +29,8 @@ MODULE qs_dispersion_nonloc
                                               xc_vdw_fun_nonloc
    USE kinds,                           ONLY: default_string_length,&
                                               dp
-   USE mathconstants,                   ONLY: pi
+   USE mathconstants,                   ONLY: pi,&
+                                              rootpi
    USE message_passing,                 ONLY: mp_para_env_type
    USE pw_grid_types,                   ONLY: HALFSPACE,&
                                               pw_grid_type
@@ -211,7 +212,7 @@ SUBROUTINE calculate_dispersion_nonloc(vxc_rho, rho_r, rho_g, edispersion, &
       beta = 0.03125_dp*(3.0_dp/(b_value**2.0_dp))**0.75_dp
       nspin = SIZE(rho_r)
 
-      const = 1.0_dp/(3.0_dp*SQRT(pi)*b_value**1.5_dp)/(pi**0.75_dp)
+      const = 1.0_dp/(3.0_dp*rootpi*b_value**1.5_dp)/(pi**0.75_dp)
 
       ! temporary arrays for FFT
       CALL pw_pool%create_pw(tmp_g)

diff --git a/src/xc/xc_xpbe_hole_t_c_lr.F b/src/xc/xc_xpbe_hole_t_c_lr.F
@@ -19,7 +19,8 @@ MODULE xc_xpbe_hole_t_c_lr
                                               section_vals_val_get
    USE kinds,                           ONLY: dp
    USE mathconstants,                   ONLY: euler,&
-                                              pi
+                                              pi,&
+                                              rootpi
    USE xc_derivative_desc,              ONLY: deriv_norm_drho,&
                                               deriv_norm_drhoa,&
                                               deriv_norm_drhob,&
@@ -537,7 +538,7 @@ ELEMENTAL SUBROUTINE xpbe_hole_t_c_lr_lda_calc_1(e_0, e_rho, e_ndrho, &
          t61 = D**2
          t64 = D*t21
          t65 = t34*B
-         t69 = SQRT(pi)
+         t69 = rootpi
          t71 = F1*t21
          t73 = t71*t34 + F2
          t77 = C*(1 + t73*t12*t13)