Some maintenance, fix unit tests

src/optimize/optimize_maths.f90

@@ -113,8 +113,8 @@ recursive subroutine detrotra_qsort(a,first,last,ind)
         i = i+1
         j = j-1
       end do
-      if (first < i-1) call qsort(a,first,i-1,ind)
-      if (j+1 < last) call qsort(a,j+1,last,ind)
+      if (first < i-1) call detrotra_qsort(a,first,i-1,ind)
+      if (j+1 < last) call detrotra_qsort(a,j+1,last,ind)
     end subroutine detrotra_qsort
   end subroutine detrotra8
 

src/sorting/canonical.f90

@@ -21,6 +21,7 @@ module canonical_mod
   use strucrd
   use adjacency
   use geo
+  use utilities, only: nth_prime
   implicit none
   private
 
@@ -672,43 +673,6 @@ subroutine add_h_ranks(self,mol)
   end subroutine add_h_ranks
 
 !========================================================================================!
-!========================================================================================!
-
-  function nth_prime(x) result(prime)
-    implicit none
-    integer,intent(in) :: x
-    integer :: prime
-    integer :: c,num,i
-    logical :: is_prime
-    integer,parameter :: prime_numbers(100) = (/2,3,5,7,11,13,17,19,23,29, &
-    & 31,37,41,43,47,53,59,61,67,71,73,79,83,89,97,101,103,107,109, &
-    & 113,127,131,137,139,149,151,157,163,167,173,179,181,191,193,197, &
-    & 199,211,223,227,229,233,239,241,251,257,263,269,271,277,281,283, &
-    & 293,307,311,313,317,331,337,347,349,353,359,367,373,379,383,389, &
-    & 397,401,409,419,421,431,433,439,443,449,457,461,463,467,479,487, &
-    & 491,499,503,509,521,523,541/)
-    if (x <= 100) then
-      prime = prime_numbers(x)
-      return
-    end if
-    c = 0
-    num = 1
-    do while (c < x)
-      num = num+1
-      is_prime = .true.
-      do i = 2,int(sqrt(real(num)))
-        if (mod(num,i) == 0) then
-          is_prime = .false.
-          exit
-        end if
-      end do
-      if (is_prime) then
-        c = c+1
-      end if
-    end do
-    prime = num
-  end function nth_prime
-
 !========================================================================================!
 
   subroutine debugprint(can,mol)

src/sorting/cregen.f90

@@ -646,6 +646,7 @@ subroutine discardbroken(ch,env,topocheck,nat,nall,at,xyz,comments,newnall)
   use crest_data
   use strucrd
   use miscdata,only:rcov
+  use quicksort_interface
   implicit none
   !> INPUT
   type(systemdata) :: env    ! MAIN STORAGE OS SYSTEM DATA
@@ -741,7 +742,8 @@ subroutine discardbroken(ch,env,topocheck,nat,nall,at,xyz,comments,newnall)
     order = orderref
     call xyzqsort(nat,nall,xyz,c0,order,1,nall)
     order = orderref
-    call stringqsort(nall,comments,1,nall,order)
+    !call stringqsort(nall,comments,1,nall,order)
+    call stringqsort(nall,len(comments(1)),comments,1,nall,order)
 
     llan = nall-newnall
     write (ch,'('' number of removed clashes      :'',i6)') llan
@@ -774,6 +776,7 @@ subroutine cregen_topocheck(ch,env,checkez,nat,nall,at,xyz,comments,newnall)
   use miscdata,only:rcov
   use utilities
   use crest_cn_module
+  use quicksort_interface
   implicit none
   type(systemdata) :: env    ! MAIN STORAGE OS SYSTEM DATA
   integer,intent(in) :: ch ! printout channel
@@ -891,7 +894,8 @@ subroutine cregen_topocheck(ch,env,checkez,nat,nall,at,xyz,comments,newnall)
     order = orderref
     call xyzqsort(nat,nall,xyz,c1,order,1,nall)
     order = orderref
-    call stringqsort(nall,comments,1,nall,order)
+    !call stringqsort(nall,comments,1,nall,order)
+    call stringqsort(nall,len(comments(1)),comments,1,nall,order)
 
     llan = nall-newnall
     write (ch,'('' number of topology mismatches  :'',i6)') llan
@@ -1060,6 +1064,7 @@ subroutine cregen_esort(ch,nat,nall,xyz,comments,nallout,ewin)
 !**************************************************************
   use crest_parameters
   use strucrd
+  use quicksort_interface
   implicit none
   integer,intent(in) :: ch
   integer,intent(in) :: nat
@@ -1098,7 +1103,8 @@ subroutine cregen_esort(ch,nat,nall,xyz,comments,nallout,ewin)
   deallocate (c0)
   order = orderref
 
-  call stringqsort(nall,comments,1,nall,order)
+  !call stringqsort(nall,comments,1,nall,order)
+  call stringqsort(nall,len(comments(1)),comments,1,nall,order) 
 
   !>-- determine cut-off of energies
   if (ewin < 9999.9_wp) then
@@ -1153,6 +1159,7 @@ subroutine cregen_CRE(ch,env,nat,nall,at,xyz,comments,nallout,group,nosort)
   use ls_rmsd
   use axis_module
   use utilities
+  use quicksort_interface
   implicit none
   type(systemdata) :: env
   integer,intent(in) :: ch
@@ -1423,7 +1430,7 @@ subroutine cregen_CRE(ch,env,nat,nall,at,xyz,comments,nallout,group,nosort)
     order = orderref
     call maskqsort(er,1,nall,order)
     order = orderref
-    call stringqsort(nall,comments,1,nall,order)
+    call stringqsort(nall,len(comments(1)),comments,1,nall,order)
     order = orderref
     call matqsort(3,nall,rot,rotdum,1,nall,order)
   end if
@@ -2115,6 +2122,7 @@ subroutine cregen_repairorder(nat,nall,xyz,comments,group)
   use crest_data
   use strucrd
   use utilities
+  use quicksort_interface
   implicit none
   integer,intent(in) :: nat
   integer,intent(in) :: nall
@@ -2168,7 +2176,8 @@ subroutine cregen_repairorder(nat,nall,xyz,comments,group)
   call xyzqsort(nat,nall,xyz,cdum,order,1,nall)
   deallocate (cdum)
   order = orderref
-  call stringqsort(nall,comments,1,nall,order)
+  !call stringqsort(nall,comments,1,nall,order)
+  call stringqsort(nall,len(comments(1)),comments,1,nall,order)
   if (ttag) then
     edum = grepenergy(comments(1))
     write (btmp,*) edum,'!t1'

src/sorting/quicksort.f90

@@ -32,24 +32,24 @@ end subroutine quicksort
     recursive subroutine qsort(a,first,last,ind)
       use iso_fortran_env,only:wp => real64
       implicit none
-      real(wp) :: a(:)
-      integer :: ind(:)
+      real(wp) :: a(*)
+      integer :: ind(*)
       integer :: first,last
     end subroutine qsort
 
     recursive subroutine qqsort(a,first,last)
       use iso_fortran_env,only:wp => real64
       implicit none
-      real(wp) :: a(:)
+      real(wp) :: a(*)
       integer :: first,last
     end subroutine qqsort
 
     recursive subroutine maskqsort(a,first,last,mask)
       use iso_fortran_env,only:wp => real64
       implicit none
-      real(wp) :: a(:)
+      real(wp) :: a(*)
       integer :: first,last
-      integer :: mask(:)
+      integer :: mask(*)
     end subroutine maskqsort
 
     recursive subroutine matqsort(adim,nall,a,adum,first,last,mask)
@@ -61,10 +61,10 @@ recursive subroutine matqsort(adim,nall,a,adum,first,last,mask)
       integer :: mask(nall)
     end subroutine matqsort
 
-    recursive subroutine stringqsort(sdim,strs,first,last,mask)
+    recursive subroutine stringqsort(sdim,slen,strs,first,last,mask)
       implicit none
-      integer :: sdim
-      character(len=*) :: strs(sdim)
+      integer,intent(in) :: sdim,slen
+      character(len=slen) :: strs(sdim)
       integer :: first,last
       integer :: mask(sdim)
     end subroutine stringqsort
@@ -153,9 +153,9 @@ end subroutine quicksort
 recursive subroutine qsort(a,first,last,ind)
   use iso_fortran_env,only:wp => real64
   implicit none
-  real(wp) :: a(:)
+  real(wp) :: a(*)
   real(wp) :: x,t
-  integer :: ind(:)
+  integer :: ind(*)
   integer :: first,last,i,j,ii
 
   x = a((first+last)/2)
@@ -181,7 +181,7 @@ end subroutine qsort
 recursive subroutine qqsort(a,first,last)
   use iso_fortran_env,only:wp => real64
   implicit none
-  real(wp) :: a(:)
+  real(wp) :: a(*)
   real(wp) :: x,t
   integer :: first,last,i,j
 
@@ -207,10 +207,10 @@ end subroutine qqsort
 recursive subroutine maskqsort(a,first,last,mask)
   use iso_fortran_env,only:wp => real64
   implicit none
-  real(wp) :: a(:)
+  real(wp) :: a(*)
   real(wp) :: t
   integer :: x,first,last,i,j,ii
-  integer :: mask(:)
+  integer :: mask(*)
 
   x = mask((first+last)/2)
   i = first
@@ -260,11 +260,11 @@ recursive subroutine matqsort(adim,nall,a,adum,first,last,mask)
   if (j+1 < last) call matqsort(adim,nall,a,adum,j+1,last,mask)
 end subroutine matqsort
 
-recursive subroutine stringqsort(sdim,strs,first,last,mask)
+recursive subroutine stringqsort(sdim,slen,strs,first,last,mask)
   implicit none
-  integer :: sdim
-  character(len=*) :: strs(sdim)
-  character(len=len(strs(1))) :: str
+  integer,intent(in) :: sdim,slen
+  character(len=slen) :: strs(sdim)
+  character(len=slen) :: str
   integer :: x,first,last,i,j,ii
   integer :: mask(sdim)
   x = mask((first+last)/2)
@@ -283,8 +283,8 @@ recursive subroutine stringqsort(sdim,strs,first,last,mask)
     i = i+1
     j = j-1
   end do
-  if (first < i-1) call stringqsort(sdim,strs,first,i-1,mask)
-  if (j+1 < last) call stringqsort(sdim,strs,j+1,last,mask)
+  if (first < i-1) call stringqsort(sdim,slen,strs,first,i-1,mask)
+  if (j+1 < last) call stringqsort(sdim,slen,strs,j+1,last,mask)
 end subroutine stringqsort
 
 subroutine maskinvert(nall,mask)