Progress in refactoring code and implementing unit tests

src/m_common/Thomas_Fermi_model.f90

@@ -38,10 +38,10 @@ module Thomas_Fermi_model
 
     function Thomas_Fermi_core_electron_number(atomic_number, r_c) result(num_core_electron)
 
-        real(8), intent(in) :: atomic_number, r_c
-        real(8) num_core_electron, num_val_electron
-        real(8) r_TF, x_TF, b, pi, rho_r, p_r
-        real(8) :: r = 0.0d0, r_min = 1.0d-3, r_max = 25.0d0, dr = 1.0d-3
+        real*8, intent(in) :: atomic_number, r_c
+        real*8 num_core_electron, num_val_electron
+        real*8 r_TF, x_TF, b, pi, rho_r, p_r
+        real*8 :: r = 0.0d0, r_min = 1.0d-3, r_max = 25.0d0, dr = 1.0d-3
 
         ! define constant
         pi = 3.1415926535d0
@@ -78,8 +78,8 @@ end function Thomas_Fermi_core_electron_number
 
     function Gross_Dreizler(x) result(f)
 
-        real(8), intent(in) :: x
-        real(8) f
+        real*8, intent(in) :: x
+        real*8 f
 
         f = 1.0d0/(1.0d0 + 1.4712d0*x - 0.4973d0*x**(3.0d0/2.0d0) + 0.3875d0*x**(2.0d0) + 0.002102d0*x**(3.0d0))
 

src/m_common/cell.f90

@@ -399,8 +399,11 @@ subroutine ApplyPBC(s, howmany)
     end subroutine ApplyPBC
 
     function map(x, cell_period)
-        real(8) :: x, cell_period
-        real(8) :: map
+        implicit none
+        ! argument variables
+        real*8, intent(in) :: x, cell_period
+        ! local variables
+        real*8 :: map
         if (cell_period .eq. 0.d0) then
             map = x
         else
@@ -409,6 +412,7 @@ function map(x, cell_period)
     end function map
 
     function dmap(x, cell_period)
+        implicit none
         real(8) :: x, cell_period
         real(8) :: dmap
         !   dmap=dcos(x/cell_period)
@@ -420,6 +424,7 @@ function dmap(x, cell_period)
     end function dmap
 
     function ddmap(x, cell_period)
+        implicit none
         real(8) :: x, cell_period
         real(8) :: ddmap
         if (cell_period .eq. 0.d0) then
@@ -430,7 +435,11 @@ function ddmap(x, cell_period)
     end function ddmap
 
     function map0(x)
-        real(8) :: x, xc, map0
+        implicit none
+        ! argument variables
+        real*8, intent(in) :: x
+        ! local variables
+        real*8 xc, map0
         integer p
         ! this function depend only on x and is such that f'=1 and f(1/2)=0
         select case (case_map)

src/m_common/rotate_tools.f90

@@ -13,15 +13,13 @@
 ! You should have received a copy of the GNU General Public License
 ! along with this program. If not, see <http://www.gnu.org/licenses/>.
 
-subroutine ruota_xyz(alpha, xrot, yrot, zrot, &
-        &    nion_1, rion_1, rion_2)
+subroutine ruota_xyz(alpha, xrot, yrot, zrot, nion_1, rion_1, rion_2)
     implicit none
-    real(8) u(3, 3)
-    real(8), dimension(:, :), allocatable :: emme
+    real*8 u(3, 3)
+    real*8, dimension(:, :), allocatable :: emme
     integer nion_1, i, j, ii
 
-    real(8) alpha, xrot, yrot, zrot, &
-            &            rion_1(3, nion_1), rion_2(3, nion_1)
+    real*8 alpha, xrot, yrot, zrot, rion_1(3, nion_1), rion_2(3, nion_1)
 
     call dscal(9, 0.d0, u(1, 1), 1)
     call make_u(alpha, xrot, yrot, zrot, u)
@@ -43,19 +41,20 @@ subroutine ruota_xyz(alpha, xrot, yrot, zrot, &
 
 end subroutine ruota_xyz
 
-subroutine ruota_molec(ipc, alpha, xrot, yrot, zrot, iesupr_1&
-        &, dupr_1, ioptorb_1, nparam_1, nshell_1, ioptorb, nshell, nelorb, dupr_2)
+subroutine ruota_molec(ipc, alpha, xrot, yrot, zrot, iesupr_1, &
+                    &  dupr_1, ioptorb_1, nparam_1, nshell_1, &
+                    &  ioptorb, nshell, nelorb, dupr_2)
     use constants, only: zzero, zone
     implicit none
     integer nshell_1, indpar, nelorb, nshell, shift, i, j, ii, iesupr_1, ipc
     integer ioptorb(nshell), ioptorb_1(nshell_1), nparam_1(nshell_1)
 
-    real(8) alpha, xrot, yrot, zrot
-    real(8) dupr_1(ipc*iesupr_1)
-    real(8) dupr_2(ipc*iesupr_1)
+    real*8 alpha, xrot, yrot, zrot
+    real*8 dupr_1(ipc*iesupr_1)
+    real*8 dupr_2(ipc*iesupr_1)
 
-    real(8) u(3, 3), emmed(5, 5), emmef(7, 7), emmeg(9, 9)
-    real(8), dimension(:, :), allocatable :: emme
+    real*8 u(3, 3), emmed(5, 5), emmef(7, 7), emmeg(9, 9)
+    real*8, dimension(:, :), allocatable :: emme
 
     allocate (emme(nelorb, nelorb))
 
@@ -93,8 +92,9 @@ subroutine ruota_molec(ipc, alpha, xrot, yrot, zrot, iesupr_1&
 end subroutine ruota_molec
 
 subroutine ruota_lambda(ipc, ipf, alpha, xrot, yrot, zrot, &
-        &           ix_1, iy_1, detmat_1, nnozero_1, occ_1, nelcol, &
-        &           ioptorb_1, nshell_1, nnozero_2, ix_2, iy_2, detmat_2, symmagp)
+                    &   ix_1, iy_1, detmat_1, nnozero_1, occ_1, nelcol, &
+                    &   ioptorb_1, nshell_1, nnozero_2, ix_2, iy_2, detmat_2, &
+                    &   symmagp)
     use allio, only: yes_hermite
     use constants, only: zone, zzero
     !         INPUT
@@ -112,15 +112,15 @@ subroutine ruota_lambda(ipc, ipf, alpha, xrot, yrot, zrot, &
     integer nshell_1, nelcol, neldiff, &
             &            ioptorb_1(nshell_1)
 
-    real(8) alpha, xrot, yrot, zrot
+    real*8 alpha, xrot, yrot, zrot
     integer ix_1(nnozero_1), iy_1(nnozero_1)
-    real(8) detmat_1(*)
+    real*8 detmat_1(*)
     integer ix_2(*), iy_2(*)
-    real(8) detmat_2(*)
+    real*8 detmat_2(*)
 
     integer i, j, ii
-    real(8) u(3, 3), emmed(5, 5), emmef(7, 7), emmeg(9, 9)
-    real(8), dimension(:, :), allocatable :: emme, lwork, lambda
+    real*8 u(3, 3), emmed(5, 5), emmef(7, 7), emmeg(9, 9)
+    real*8, dimension(:, :), allocatable :: emme, lwork, lambda
     logical symmagp
 
     allocate (lambda(ipc*occ_1, nelcol), &

src/m_common/save_jall_fn.f90

@@ -25,11 +25,12 @@ subroutine save_jall(yesfn, jastrowall_ee, winvjbar, winvjbarsz, winvj, psip)
     use allio, only: nel, nelup, neldo, indt, indt4j, nelorbj, nelorbjh, iessz
 
     implicit none
-    ! input
-    real(8), intent(inout) :: jastrowall_ee(nelup + neldo, nelup + neldo, 0:indt4j), psip(nel, nel)
-    real(8), intent(in) :: winvj(max(nelorbjh, 1), 0:indt4j, *), winvjbar(*), winvjbarsz(*)
+    ! argument variables
+    real*8, intent(inout) :: jastrowall_ee(nelup + neldo, nelup + neldo, 0:indt4j), psip(nel, nel)
+    real*8, intent(in) :: winvj(max(nelorbjh, 1), 0:indt4j, *), winvjbar(*), winvjbarsz(*)
+
+    ! local variables
     integer :: nelused
-    ! local
     integer :: i, k, nelorbj5
     logical yesfn
 

src/m_common/scalevect.f90

@@ -16,8 +16,11 @@
 subroutine scalevect(n, cellfat, vect)
     use cell, only: map
     implicit none
-    integer n, i
-    real*8 cellfat(3), vect(3*n)
+    integer, intent(in) :: n
+    real*8, intent(in) :: cellfat(3)
+    real*8, intent(inout) :: vect(3*n)
+
+    integer i
 !$omp parallel do default(shared) private(i)
     do i = 1, 3*n, 3
         vect(i) = map(vect(i), cellfat(1))

src/m_common/slaterorb.f90

@@ -16,7 +16,7 @@
 function slaterorb(ioptorb)
     use constants, only: iflagerr
     implicit none
-    integer ioptorb
+    integer, intent(in) :: ioptorb
     logical slaterorb
     select case (ioptorb)
         !     case(34,10,12,28,57,80) !  Slater s

src/m_common/sub_comm.f90

@@ -20,14 +20,18 @@ module sub_comm
         integer comm, parent
         logical yesin
     end type
+
 contains
+
     subroutine mpi_sub_comm_create(parent_comm, new_size, child, ierror)
         implicit none
 #ifdef PARALLEL
         include 'mpif.h'
 #endif
-        integer parent_comm, new_size, ierror
-        type(mpi_sub_comm) :: child
+        integer, intent(in) :: parent_comm
+        integer, intent(inout) :: new_size
+        integer, intent(inout) :: ierror ! intent(out)?
+        type(mpi_sub_comm), intent(inout) :: child
 
         integer orig_group, sub_group, i
         integer, dimension(:), allocatable :: ranks
@@ -74,8 +78,8 @@ end subroutine mpi_sub_comm_create
 
     subroutine mpi_sub_comm_free(child, ierror)
         implicit none
-        integer ierror
-        type(mpi_sub_comm) :: child
+        integer, intent(inout) :: ierror ! intent(out)?
+        type(mpi_sub_comm), intent(inout) :: child
 #ifdef PARALLEL
         include 'mpif.h'
 

src/m_common/symmetrize_agp.f90

@@ -18,15 +18,21 @@ subroutine symmetrizeagp(nnozero_c, nozero_c, jbradet, jbradetn, dsw&
         &, symmagp, yes_hermite)
     use constants, only: ipc, ipf, deps
     use cell, only: cellscale, phase2pi
-    use allio, only: rank, rion, yes_crystal, real_agp, molyes&
-            &, pfaffup, kiontot
+    use allio, only: rank, rion, yes_crystal, real_agp, molyes, pfaffup, kiontot
     implicit none
-    integer nnozero_c, iessw0, iesswt, ii, jj, kk, ind, ix, iy&
-            &, nelorb_c, nelcol_c, indc, iessw, nelorb_at, iyr, ierr, ndim
-    integer nozero_c(*), itouch(*), jbradet(*), jbradetn(*)
-    real*8 dsw(*), dsw0, detmat_c(ipc*nelorb_c*nelcol_c), scale_c(*)
-    real*8 dswc(2), riondiff(3), cosphihalf, sinphihalf, cost, detr, deti
-    logical symmagp, yes_hermite
+
+    ! argument variables
+    integer, intent(in) :: nnozero_c, iessw0, nelorb_c, nelcol_c, nelorb_at, &
+                        &  nozero_c(*), jbradet(*), jbradetn(*)
+    integer, intent(inout) :: itouch(*)
+    real*8, intent(inout) :: dsw(*)
+    real*8, intent(inout) :: detmat_c(ipc*nelorb_c*nelcol_c), scale_c(*)
+    logical, intent(in) :: symmagp, yes_hermite
+
+    ! local variables
+    integer ii, jj, kk, ind, indc, iessw, iesswt, ix, iy, iyr, ierr, ndim
+    real*8 dsw0, dswc(2), riondiff(3), cosphihalf, sinphihalf, cost, detr, deti
+
     !     Input detmat_c output detmat_c symmetrized
     do ii = 1, nnozero_c
         scale_c(ipc*(ii - 1) + 1:ipc*ii) = detmat_c(ipc*(nozero_c(ii) - 1) + 1:ipc*nozero_c(ii))

src/m_common/types.f90

@@ -35,13 +35,13 @@ module types
     ! ex. for Jastrow I have:
     ! vj,vju,winvj,jasmat,jasmat_sz,jasmat_c,jasmatsz_c
     type wf_factor
-        real(8), allocatable :: twobody_par(:)
-        real(8), allocatable :: exps(:)
-        real(8), allocatable :: bas_mat(:)
-        real(8), allocatable :: exp_mat(:)
-        real(8), allocatable :: exp_mat_sz(:)
-        real(8), allocatable :: exp_mat_c(:)
-        real(8), allocatable :: exp_mat_sz_c(:)
+        real*8, allocatable :: twobody_par(:)
+        real*8, allocatable :: exps(:)
+        real*8, allocatable :: bas_mat(:)
+        real*8, allocatable :: exp_mat(:)
+        real*8, allocatable :: exp_mat_sz(:)
+        real*8, allocatable :: exp_mat_c(:)
+        real*8, allocatable :: exp_mat_sz_c(:)
     end type
 
 end module types

src/m_common/update_jastrowall.f90

@@ -18,8 +18,14 @@
 ! -----------------------------------------
 subroutine upjastrowall(nel, jastrowall, psip)
     implicit none
-    integer j, k, nel
-    real*8 psip(nel, *), jastrowall(nel, *)
+
+    ! argument variables
+    integer, intent(in) :: nel
+    real*8, intent(in) :: psip(nel, *)
+    real*8, intent(inout) :: jastrowall(nel, *)
+
+    ! local variables
+    integer j, k
 
     do j = 1, nel
         do k = 1, nel
@@ -31,8 +37,14 @@ end subroutine upjastrowall
 
 subroutine upjastrowall_sz(nel, nelup, jastrowall, psip)
     implicit none
-    integer j, k, nel, nelup
-    real*8 psip(nel, *), jastrowall(nel, *)
+
+    ! argument variables
+    integer, intent(in) :: nel, nelup
+    real*8, intent(in) :: psip(nel, *)
+    real*8, intent(inout) :: jastrowall(nel, *)
+
+    ! local variables
+    integer j, k
 
     do j = 1, nelup
         do k = 1, nelup
@@ -59,8 +71,14 @@ end subroutine upjastrowall_sz
 ! -----------------------------------------
 subroutine upjastrowallfat(nel, jastrowall, psipmu)
     implicit none
-    integer nel, i, j
-    real*8 jastrowall(nel, *), psipmu(nel, *)
+
+    ! argument variables
+    integer, intent(in) :: nel
+    real*8, intent(in) :: psipmu(nel, *)
+    real*8, intent(inout) :: jastrowall(nel, *)
+
+    ! local variables
+    integer i, j
 
     do i = 1, nel
         do j = 1, nel
@@ -73,8 +91,14 @@ end subroutine upjastrowallfat
 
 subroutine upjastrowallfat_sz(nel, nelup, jastrowall, psipmu)
     implicit none
-    integer nel, nelup, i, j
-    real*8 jastrowall(nel, *), psipmu(nel, *)
+
+    ! argument variables
+    integer, intent(in) :: nel, nelup
+    real*8, intent(in) :: psipmu(nel, *)
+    real*8, intent(inout) :: jastrowall(nel, *)
+
+    ! local variables
+    integer i, j
 
     do i = 1, nelup
         do j = 1, nelup
@@ -103,8 +127,14 @@ end subroutine upjastrowallfat_sz
 ! ------------------------------------------
 subroutine upjastrowallpsi(nel, jastrowall, psip)
     implicit none
-    integer j, k, nel
-    real*8 psip(nel, *), jastrowall(nel, *)
+
+    ! argument variables
+    integer, intent(in) :: nel
+    real*8, intent(in) :: psip(nel, *)
+    real*8, intent(inout) :: jastrowall(nel, *)
+
+    ! local variables
+    integer j, k
 
     do j = 1, nel
         do k = 1, nel
@@ -117,8 +147,14 @@ end subroutine upjastrowallpsi
 
 subroutine upjastrowallpsi_sz(nel, nelup, jastrowall, psip)
     implicit none
-    integer j, k, nel, nelup
-    real*8 psip(nel, *), jastrowall(nel, *)
+
+    ! argument variables
+    integer, intent(in) :: nel, nelup
+    real*8, intent(in) :: psip(nel, *)
+    real*8, intent(inout) :: jastrowall(nel, *)
+
+    ! local variables
+    integer j, k
 
     do j = 1, nelup
         do k = j + 1, nelup