Atomlist class (#25)

- introduce atomlist class
- wraps usually used atomic lists
- allows for direct use with list io
- add unit test for all functionalities
- introduced atomlist for user data readin
- replaced IO for lists with atom list class
- replaced wbo fragment printout with atom list based IO

TESTSUITE/assertion.f90

@@ -1,9 +1,13 @@
 module assertion
 
    interface assert_eq
+      module procedure :: assert_eq_char
       module procedure :: assert_eq_int16
       module procedure :: assert_eq_int32
       module procedure :: assert_eq_int64
+      module procedure :: assert_eq_int16_array
+      module procedure :: assert_eq_int32_array
+      module procedure :: assert_eq_int64_array
    end interface assert_eq
 
    interface assert_close
@@ -28,6 +32,17 @@ subroutine assert(bool)
    endif
 end subroutine assert
 
+subroutine assert_eq_char(val1,val2)
+   use iso_fortran_env, istderr => error_unit
+   character(len=*),intent(in) :: val1,val2
+
+   if (val1 /= val2) then
+      write(istderr,'("assertion:",1x,a," == ",a,1x,"FAILED")') &
+         val1,val2
+      afail = afail+1
+   endif
+end subroutine assert_eq_char
+
 subroutine assert_eq_int16(val1,val2)
    use iso_fortran_env, istderr => error_unit
    integer(int16),intent(in) :: val1,val2
@@ -61,6 +76,66 @@ subroutine assert_eq_int64(val1,val2)
    endif
 end subroutine assert_eq_int64
 
+subroutine assert_eq_int16_array(val1,val2)
+   use iso_fortran_env, istderr => error_unit
+   integer(int16),intent(in) :: val1(:),val2(:)
+   integer :: i
+
+   if (size(val1) .ne. size(val2)) then
+      write(istderr,'("shape missmatch:",1x,i0," == ",i0,1x,"FAILED")') &
+         val1,val2
+      afail = afail+1
+   endif
+   if (any(val1 /= val2)) then
+      do i = 1, size(val1)
+         if (val1(i) /= val2(i)) &
+         write(istderr,'("assertion:",1x,g21.14," == ",g21.14,1x,"FAILED at ",i0)')&
+            val1(i),val2(i),i
+      enddo
+      afail = afail+1
+   endif
+end subroutine assert_eq_int16_array
+
+subroutine assert_eq_int32_array(val1,val2)
+   use iso_fortran_env, istderr => error_unit
+   integer(int32),intent(in) :: val1(:),val2(:)
+   integer :: i
+
+   if (size(val1) .ne. size(val2)) then
+      write(istderr,'("shape missmatch:",1x,i0," == ",i0,1x,"FAILED")') &
+         val1,val2
+      afail = afail+1
+   endif
+   if (any(val1 /= val2)) then
+      do i = 1, size(val1)
+         if (val1(i) /= val2(i)) &
+         write(istderr,'("assertion:",1x,g21.14," == ",g21.14,1x,"FAILED at ",i0)')&
+            val1(i),val2(i),i
+      enddo
+      afail = afail+1
+   endif
+end subroutine assert_eq_int32_array
+
+subroutine assert_eq_int64_array(val1,val2)
+   use iso_fortran_env, istderr => error_unit
+   integer(int64),intent(in) :: val1(:),val2(:)
+   integer :: i
+
+   if (size(val1) .ne. size(val2)) then
+      write(istderr,'("shape missmatch:",1x,i0," == ",i0,1x,"FAILED")') &
+         val1,val2
+      afail = afail+1
+   endif
+   if (any(val1 /= val2)) then
+      do i = 1, size(val1)
+         if (val1(i) /= val2(i)) &
+         write(istderr,'("assertion:",1x,g21.14," == ",g21.14,1x,"FAILED at ",i0)')&
+            val1(i),val2(i),i
+      enddo
+      afail = afail+1
+   endif
+end subroutine assert_eq_int64_array
+
 subroutine assert_close_real64(val1,val2,thr)
    use iso_fortran_env, istderr => error_unit
    real(real64),intent(in) :: val1,val2,thr

TESTSUITE/tbdef_atomlist.f90

@@ -0,0 +1,71 @@
+subroutine test_atomlist
+   use iso_fortran_env
+   use assertion
+   use tbdef_atomlist
+   implicit none
+   type(tb_atomlist) :: atl
+   character(len=:), allocatable :: string
+   integer, allocatable :: list(:)
+   integer, parameter :: atoms(*) = [3,1,1,5,8,1,1,2,5]
+   logical, parameter :: lpar(*) = [.true., .false., .true., .true., .true., &
+      &                             .false., .false., .true., .false.]
+   integer, parameter :: ipar(*) = [1, 3, 4, 5, 8]
+   character(len=*), parameter :: cpar = '1,3-5,8'
+
+   write(error_unit,'(a)') " * Testing defaults"
+   call assert(atl%get_truth() .eqv. .true.)
+   call atl%switch_truth
+   call assert(atl%get_truth() .eqv. .false.)
+   call assert_eq(size(atl), 0)
+   write(error_unit,'("-> Done:",1x,i0,1x,"fails")') afail
+
+   write(error_unit,'(a)') " * Testing constructors"
+   atl = tb_atomlist(list=lpar, truth=.true.)
+   call assert_eq(size(atl), 9)
+   call assert_eq(len(atl), 5)
+
+   atl = tb_atomlist(list=lpar, truth=.false.)
+   call assert_eq(size(atl), 9)
+   call assert_eq(len(atl), 4)
+
+   atl = tb_atomlist(list=ipar, truth=.true.)
+   call assert_eq(size(atl), 8)
+   call assert_eq(len(atl), 5)
+   call atl%to_list(list)
+   call assert_eq(list, ipar)
+
+   atl = tb_atomlist(list=cpar, truth=.false.)
+   call assert_eq(size(atl), 8)
+   call assert_eq(len(atl), 5)
+   call atl%to_string(string)
+   call assert_eq(string, cpar)
+   write(error_unit,'("-> Done:",1x,i0,1x,"fails")') afail
+   call atl%new
+
+   write(error_unit,'(a)') " * Testing data manipulation"
+   call atl%new(lpar)
+   call atl%resize(9)
+   call atl%switch_truth
+   call atl%to_string(string)
+   call assert_eq(string, '2,6-7,9')
+   call atl%gather(atoms, list)
+   call assert_eq(list, [1,1,1,5])
+   call assert_eq(size(list), len(atl))
+   call atl%new
+
+   atl = tb_atomlist(list=lpar, truth=.false., delimiter=' ', skip=':')
+   call atl%to_string(string)
+   call assert_eq(string, '2 6:7 9')
+   call atl%switch_truth
+   write(string, *) atl
+   call assert_eq(string, '1 3:5 8')
+   call atl%to_list(list)
+   call atl%switch_truth
+   call atl%add(list)
+   call assert_eq(len(atl), size(atl))
+   call atl%to_string(string)
+   call assert_eq(string, '1:9')
+   write(error_unit,'("-> Done:",1x,i0,1x,"fails")') afail
+
+   call terminate(afail)
+end subroutine test_atomlist

TESTSUITE/tests_peeq.f90

@@ -107,6 +107,10 @@ program peeq_tester
       case('0d'); call test_wigner_seitz_0d
       case('3d'); call test_wigner_seitz_3d
       end select
+   case('tbdef_atomlist')
+      select case(sec)
+      case('list'); call test_atomlist
+      end select
    case('symmetry')
       select case(sec)
       case('water');  call test_symmetry_water

meson.build

@@ -135,6 +135,7 @@ xtb_srcs += 'xtb/tbdef_pcem.f90'
 xtb_srcs += 'xtb/tbdef_wsc.f90'
 xtb_srcs += 'xtb/tbdef_options.f90'
 xtb_srcs += 'xtb/tbdef_calculator.f90'
+xtb_srcs += 'xtb/tbdef_atomlist.f90'
 
 # global data
 xtb_srcs += 'xtb/gfn0param.f90'
@@ -331,6 +332,7 @@ xtb_test += 'TESTSUITE/gfn0.f90'
 xtb_test += 'TESTSUITE/peeq.f90'
 xtb_test += 'TESTSUITE/symmetry.f90'
 xtb_test += 'TESTSUITE/thermo.f90'
+xtb_test += 'TESTSUITE/tbdef_atomlist.f90'
 
 incdir = include_directories('include')
 
@@ -427,6 +429,8 @@ test('Geometry Reader: coord 0D',xtb_test,args: ['geometry_reader','coord_0d'])
 test('Geometry Reader: Xmol  0D',xtb_test,args: ['geometry_reader','xmol_0d'])
 test('Geometry Reader: POSCAR',  xtb_test,args: ['geometry_reader','poscar_3d'])
 
+test('IO: atom list', xtb_test, args: ['tbdef_atomlist', 'list'])
+
 test('PBC tools: convert',xtb_test,args: ['pbc_tools','convert'])
 test('PBC tools: cutoff', xtb_test,args: ['pbc_tools','cutoff'])