initrings.F90

Go to the documentation of this file.

! This file is part of the 'atomes' software.
!
! 'atomes' is free software: you can redistribute it and/or modify it under the terms
! of the GNU Affero General Public License as published by the Free Software Foundation,
! either version 3 of the License, or (at your option) any later version.
!
! 'atomes' is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY;
! without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
! See the GNU General Public License for more details.
!
! You should have received a copy of the GNU Affero General Public License along with 'atomes'.
! If not, see <https://www.gnu.org/licenses/>
!
! Copyright (C) 2022-2024 by CNRS and University of Strasbourg
!
 
LOGICAL FUNCTION allocrings()
 
!
! Memory allocation for ring statistics
!
 
USE parameters
 
IMPLICIT NONE
 
if(allocated(nring)) deallocate(nring)
allocate(nring(taillr,ns), stat=err)
if (err .ne. 0) then
  call show_error ("Impossible to allocate memory"//char(0), &
                   "Function: ALLOCRINGS"//char(0), "Table: NRING"//char(0))
  allocrings=.false.
  goto 001
endif
if (allocated(pna)) deallocate(pna)
allocate(pna(taillr,taillr,ns), stat=err)
if (err .ne. 0) then
  call show_error ("Impossible to allocate memory"//char(0), &
                   "Function: ALLOCRINGS"//char(0), "Table: PNA"//char(0))
  allocrings=.false.
  goto 001
endif
if (allocated(maxpna)) deallocate(maxpna)
allocate(maxpna(taillr,ns), stat=err)
if (err .ne. 0) then
  call show_error ("Impossible to allocate memory"//char(0), &
                   "Function: ALLOCRINGS"//char(0), "Table: MAXPNA"//char(0))
  allocrings=.false.
  goto 001
endif
if (allocated(minpna)) deallocate(minpna)
allocate(minpna(taillr,ns), stat=err)
if (err .ne. 0) then
  call show_error ("Impossible to allocate memory"//char(0), &
                   "Function: ALLOCRINGS"//char(0), "Table: MINPNA"//char(0))
  allocrings=.false.
  goto 001
endif
 
!if (FACTATRING) then
!  if (allocated(ATRING)) deallocate(ATRING)
!  allocate(ATRING(TAILLD,NTLT,NS), STAT=ERR)
!  if (ERR .ne. 0) then
!
!  endif
!  ATRING(:,:,:)=0
!endif
 
if (doampat) then
  if (allocated(ampat)) deallocate(ampat)
  allocate(ampat(ntlt,ns), stat=err)
  if (err .ne. 0) then
    call show_error ("Impossible to allocate memory"//char(0), &
                     "Function: ALLOCRINGS"//char(0), "Table: AMPAT"//char(0))
    allocrings=.false.
    goto 001
  endif
  ampat(:,:)=0
endif
 
!if (FACTATPNA) then
! if (allocated(ATPNA)) deallocate(ATPNA)
!  allocate(ATPNA(TAILLD,NTLT,NS), STAT=ERR)
!  if (ERR .ne. 0) then
!    call show_error ("Impossible to allocate memory"//CHAR(0), &
!                     "Function: ALLOCRINGS"//CHAR(0), "Table: ATPNA"//CHAR(0))
!    ALLOCRINGS=.false.
!    goto 001
!  endif
!  ATPNA(:,:,:)=0
!endif
 
! End of allocation / Initialisation
 
maxpna(:,:)=0
minpna(:,:)=0
pna(:,:,:)=0
nring(:,:)=0
 
allocrings=.true.
 
001 continue
 
END FUNCTION
 
INTEGER (KIND=c_int) FUNCTION initrings (VRINGS, VTAILLD, VTLT, VNUMA, VABAB, VHOMO) bind (C,NAME='initrings_')
 
!
! Initialization of the ring statistics
! The key variable is NUMA see in the following lines
!
 
USE parameters
 
IMPLICIT NONE
 
INTEGER (KIND=c_int), INTENT(IN) :: vrings, vtailld, vtlt, vnuma, vabab, vhomo
INTERFACE
  LOGICAL FUNCTION allocrings()
  END FUNCTION
  INTEGER FUNCTION king_rings()
  END FUNCTION
  INTEGER FUNCTION guttman_rings()
  END FUNCTION
  INTEGER FUNCTION primitive_rings()
  END FUNCTION
END INTERFACE
 
if (vtlt .eq. 0) then
  tlt=nsp+1
else
  tlt=vtlt
endif
numa=vnuma
ntlt=nbspbs(tlt)
taillr=vtailld
tailld=vtailld+1
 
abab=.false.
no_homo=.false.
if (nsp .gt. 1) then
  if (vabab .eq. 1) abab=.true.
  if (vhomo .eq. 1) no_homo=.true.
endif
 
#ifdef DEBUG
  write (6, '("RINGS:: ABAB= ",l1,", NO_HOMO= ",l1,", NUMA= ",i5,", TAILLR= ",i2)') abab, no_homo, numa, taillr
#endif
 
tbr=.false.
alc=.false.
allrings=.false.
calc_strings=.false.
 
! In the following lines the NUMA variable
! gives the 'average' number of rings per size and per step
! this variable depends on the type of rings, of the system studied as well
! as of the search depth.
! NUMA is used as a reference to allocate almost all tabs during rings
! search and analysis. NUMA is a key variable - tweak with caution !
 
if (vrings.eq.1 .or. vrings.eq.2) then
  doampat=.true.
else
  doampat=.false.
endif
 
if (.not.allocrings()) then
  initrings=0
  goto 001
endif
 
if (vrings .eq. 0) allrings=.true.
 
if (vrings .le. 1) then
  initrings=king_rings()
endif
 
if (vrings .eq. 2) then
  initrings=guttman_rings()
endif
 
if (vrings >  2) then
  calc_prings=.true.
  if (.not.pbc) then
    nna=na
    nnp=0
  else
    nnp=na*(nbx**3 - 1)/2
  endif
  if (vrings .eq. 4) calc_strings=.true.
  initrings=primitive_rings()
endif
 
001 continue
 
END FUNCTION