allocbonds.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 allocedco (alloc)
 
!
! Memory allocation for Edge and Corner sharing analysis
!
 
USE parameters
 
IMPLICIT NONE
 
LOGICAL, INTENT(IN) :: alloc
 
if (allocated(edgeta)) deallocate(edgeta)
if (allocated(corta)) deallocate(corta)
if (allocated(defta)) deallocate(defta)
if (allocated(tda)) deallocate(tda)
if (allocated(cornera)) deallocate(cornera)
if (allocated(edgea)) deallocate(edgea)
if (allocated(defa)) deallocate(defa)
if (allocated(tdsa)) deallocate(tdsa)
if (allocated(eabl)) deallocate(eabl)
if (allocated(cabl)) deallocate(cabl)
if (allocated(dabl)) deallocate(dabl)
if (allocated(etabl)) deallocate(etabl)
if (allocated(ctabl)) deallocate(ctabl)
if (allocated(dtabl)) deallocate(dtabl)
if (allocated(ectabl)) deallocate(ectabl)
if (allocated(tdtabl)) deallocate(tdtabl)
if (allocated(etypea)) deallocate(etypea)
if (allocated(ctypea)) deallocate(ctypea)
if (allocated(detypea)) deallocate(detypea)
if (allocated(etda)) deallocate(etda)
if (allocated(mtabl)) deallocate(mtabl)
 
if (alloc) then
  allocate(edgeta(nsp,nsp), stat=err)
  if (err .ne. 0) then
    call show_error ("Impossible to allocate memory"//char(0), &
                     "Function: ALLOCEDCO"//char(0), "Table: EDGETA"//char(0))
    allocedco=.false.
    goto 001
  endif
  allocate(corta(nsp,nsp), stat=err)
  if (err .ne. 0) then
    call show_error ("Impossible to allocate memory"//char(0), &
                     "Function: ALLOCEDCO"//char(0), "Table: CORTA"//char(0))
    allocedco=.false.
    goto 001
  endif
  allocate(defta(nsp,nsp), stat=err)
  if (err .ne. 0) then
    call show_error ("Impossible to allocate memory"//char(0), &
                     "Function: ALLOCEDCO"//char(0), "Table: DEFTA"//char(0))
    allocedco=.false.
    goto 001
  endif
  allocate(tda(nsp,nsp), stat=err)
  if (err .ne. 0) then
    call show_error ("Impossible to allocate memory"//char(0), &
                     "Function: ALLOCEDCO"//char(0), "Table: TDA"//char(0))
    allocedco=.false.
    goto 001
  endif
  do m=1, nsp
  do n=1, nsp
    edgeta(n,m)=0
    corta(n,m)=0
    defta(n,m)=0
    tda(n,m)=0
  enddo
  enddo
  allocate(cornera(nsp,nsp,ns), stat=err)
  if (err .ne. 0) then
    call show_error ("Impossible to allocate memory"//char(0), &
                     "Function: ALLOCEDCO"//char(0), "Table: CORNERA"//char(0))
    allocedco=.false.
    goto 001
  endif
  allocate(edgea(nsp,nsp,ns), stat=err)
  if (err .ne. 0) then
    call show_error ("Impossible to allocate memory"//char(0), &
                     "Function: ALLOCEDCO"//char(0), "Table: EDGEA"//char(0))
    allocedco=.false.
    goto 001
  endif
  allocate(defa(nsp,nsp,ns), stat=err)
  if (err .ne. 0) then
    call show_error ("Impossible to allocate memory"//char(0), &
                     "Function: ALLOCEDCO"//char(0), "Table: DEFA"//char(0))
    allocedco=.false.
    goto 001
  endif
  allocate(tdsa(nsp,nsp,ns), stat=err)
  if (err .ne. 0) then
    call show_error ("Impossible to allocate memory"//char(0), &
                     "Function: ALLOCEDCO"//char(0), "Table: TDSA"//char(0))
    allocedco=.false.
    goto 001
  endif
  do m=1, nsp
    do n=1, nsp
      do o=1, ns
        cornera(m,n,o)=0
        edgea(m,n,o)=0
        defa(m,n,o)=0
        tdsa(m,n,o)=0
      enddo
    enddo
  enddo
  allocate(eabl(nsp), stat=err)
  if (err .ne. 0) then
    call show_error ("Impossible to allocate memory"//char(0), &
                     "Function: ALLOCEDCO"//char(0), "Table: EABL"//char(0))
    allocedco=.false.
    goto 001
  endif
  allocate(cabl(nsp), stat=err)
  if (err .ne. 0) then
    call show_error ("Impossible to allocate memory"//char(0), &
                     "Function: ALLOCEDCO"//char(0), "Table: CABL"//char(0))
    allocedco=.false.
    goto 001
  endif
  allocate(dabl(nsp), stat=err)
  if (err .ne. 0) then
    call show_error ("Impossible to allocate memory"//char(0), &
                     "Function: ALLOCEDCO"//char(0), "Table: DABL"//char(0))
    allocedco=.false.
    goto 001
  endif
  allocate(etabl(nsp), stat=err)
  if (err .ne. 0) then
    call show_error ("Impossible to allocate memory"//char(0), &
                     "Function: ALLOCEDCO"//char(0), "Table: ETABL"//char(0))
    allocedco=.false.
    goto 001
  endif
  allocate(ctabl(nsp), stat=err)
  if (err .ne. 0) then
    call show_error ("Impossible to allocate memory"//char(0), &
                     "Function: ALLOCEDCO"//char(0), "Table: CTABL"//char(0))
    allocedco=.false.
    goto 001
  endif
  allocate(dtabl(nsp), stat=err)
  if (err .ne. 0) then
    call show_error ("Impossible to allocate memory"//char(0), &
                     "Function: ALLOCEDCO"//char(0), "Table: DTABL"//char(0))
    allocedco=.false.
    goto 001
  endif
  allocate(ectabl(nsp), stat=err)
  if (err .ne. 0) then
    call show_error ("Impossible to allocate memory"//char(0), &
                     "Function: ALLOCEDCO"//char(0), "Table: ECTABL"//char(0))
    allocedco=.false.
    goto 001
  endif
  allocate(tdtabl(nsp), stat=err)
  if (err .ne. 0) then
    call show_error ("Impossible to allocate memory"//char(0), &
                     "Function: ALLOCEDCO"//char(0), "Table: TDTABL"//char(0))
    allocedco=.false.
    goto 001
  endif
  allocate (etypea(nsp,nsp), stat=err)
  if (err .ne. 0) then
    call show_error ("Impossible to allocate memory"//char(0), &
                     "Function: ALLOCEDCO"//char(0), "Table: ETYPEA"//char(0))
    allocedco=.false.
    goto 001
  endif
  allocate (ctypea(nsp,nsp), stat=err)
  if (err .ne. 0) then
    call show_error ("Impossible to allocate memory"//char(0), &
                     "Function: ALLOCEDCO"//char(0), "Table: CTYPEA"//char(0))
    allocedco=.false.
    goto 001
  endif
  allocate (detypea(nsp,nsp), stat=err)
  if (err .ne. 0) then
    call show_error ("Impossible to allocate memory"//char(0), &
                     "Function: ALLOCEDCO"//char(0), "Table: DETYPEA"//char(0))
    allocedco=.false.
    goto 001
  endif
  allocate (etda(nsp,nsp), stat=err)
  if (err .ne. 0) then
    call show_error ("Impossible to allocate memory"//char(0), &
                     "Function: ALLOCEDCO"//char(0), "Table: EDTA"//char(0))
    allocedco=.false.
    goto 001
  endif
  allocate(mtabl(ns), stat=err)
  if (err .ne. 0) then
    call show_error ("Impossible to allocate memory"//char(0), &
                     "Function: ALLOCEDCO"//char(0), "Table: MTABL"//char(0))
    allocedco=.false.
    goto 001
  endif
  do i=1, nsp
    do j=1,nsp
      etypea(j,i)=0.0d0
      ctypea(j,i)=0.0d0
      detypea(j,i)=0.0d0
      etda(j,i)=0.0d0
    enddo
  enddo
endif
 
allocedco=.true.
 
001 continue
 
END FUNCTION
 
LOGICAL FUNCTION allocbonds (alloc)
 
!
! Memory allocation for bond properties
!
 
USE parameters
 
!INTEGER, INTENT(IN) :: adv
LOGICAL, INTENT(IN) :: alloc
 
! For neighbors and environments
 
if (allocated(la_count)) deallocate(la_count)
if (allocated(sa_count)) deallocate(sa_count)
if (allocated(ma_count)) deallocate(ma_count)
if (allocated(togl)) deallocate(togl)
if (allocated(tigl)) deallocate(tigl)
if (allocated(num_gsa)) deallocate(num_gsa)
if (allocated(tot_gsa)) deallocate(tot_gsa)
if (allocated(cabl)) deallocate(cabl)
if (allocated(dabl)) deallocate(dabl)
if (allocated(eabl)) deallocate(eabl)
if (allocated(lgsa)) deallocate(lgsa)
if (allocated(ngsa)) deallocate(ngsa)
if (allocated(lp_geom)) deallocate(lp_geom)
if (allocated(lt_geom)) deallocate(lt_geom)
if (allocated(cmoy)) deallocate(cmoy)
if (allocated(mac)) deallocate(mac)
 
if (alloc) then
  allocate(la_count(na,nsp,ns), stat=err)
  if (err .ne. 0) then
    call show_error ("Impossible to allocate memory"//char(0), &
                     "Function: ALLOCBONDS"//char(0), "Table: LA_COUNT"//char(0))
    allocbonds=.false.
    goto 001
  endif
  allocate(sa_count(nsp), stat=err)
  if (err .ne. 0) then
    call show_error ("Impossible to allocate memory"//char(0), &
                     "Function: ALLOCBONDS"//char(0), "Table: SA_COUNT"//char(0))
    allocbonds=.false.
    goto 001
  endif
  allocate(ma_count(nsp,nsp), stat=err)
  if (err .ne. 0) then
    call show_error ("Impossible to allocate memory"//char(0), &
                     "Function: ALLOCBONDS"//char(0), "Table: MA_COUNT"//char(0))
    allocbonds=.false.
    goto 001
  endif
  sa_count(:)=0
  ma_count(:,:)=0
  la_count(:,:,:)=0
  allocate(togl(ns*na), stat=err)
  if (err .ne. 0) then
    call show_error ("Impossible to allocate memory"//char(0), &
                     "Function: ALLOCBONDS"//char(0), "Table: TOGL"//char(0))
    allocbonds=.false.
    goto 001
  endif
  allocate(tigl(ns*na), stat=err)
  if (err .ne. 0) then
    call show_error ("Impossible to allocate memory"//char(0), &
                     "Function: ALLOCBONDS"//char(0), "Table: TIGL"//char(0))
    allocbonds=.false.
    goto 001
  endif
  allocate(num_gsa(nsp,na*10), stat=err)
  if (err .ne. 0) then
    call show_error ("Impossible to allocate memory"//char(0), &
                     "Function: ALLOCBONDS"//char(0), "Table: NUM_GSA"//char(0))
    allocbonds=.false.
    goto 001
  endif
  allocate(tot_gsa(nsp), stat=err)
  if (err .ne. 0) then
    call show_error ("Impossible to allocate memory"//char(0), &
                     "Function: ALLOCBONDS"//char(0), "Table: TOT_GSA"//char(0))
    allocbonds=.false.
    goto 001
  endif
  allocate(mac(nsp), stat=err)
  if (err .ne. 0) then
    call show_error ("Impossible to allocate memory"//char(0), &
                     "Function: ALLOCBONDS"//char(0), "Table: MAC"//char(0))
    allocbonds=.false.
    goto 001
  endif
endif
 
!if (adv .eq. 1) then
!  ALLOCBONDS = ALLOCEDCO ()
!else
  allocbonds=.true.
!endif
 
001 continue
 
END FUNCTION