escs.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 eescs ()
 
USE parameters
 
IMPLICIT NONE
 
LOGICAL :: dmtxok
 
INTERFACE
  LOGICAL FUNCTION allocedco (alloc)
    LOGICAL, INTENT(IN) :: alloc
  END FUNCTION
  LOGICAL FUNCTION distmtx(NAN, LAN, LOOKNGB, UPNGB, MOLVOL)
    INTEGER, INTENT(IN) :: nan
    INTEGER, DIMENSION(NAN), INTENT(IN) :: lan
    LOGICAL, INTENT(IN) :: lookngb, upngb, molvol
  END FUNCTION
END INTERFACE
 
if (.not. allocedco(.true.)) then
  eescs=.false.
  goto 001
endif
 
calc_prings=.false.
nohp=.false.
! Modify DISTMX to evaluate ES/CS
dmtxok = distmtx(na, lot, .false., .false., .false.)
 
if (.not. dmtxok) then
  eescs=.false.
  goto 001
endif
 
do i=1, ns
  do j=1, na
    do o=1, nsp
      if (contj(j,i).eq.4 .and. (la_count(j,o,i) .eq. 4)) then
        if(ns .gt. 1) tdsa(lot(j),o,i)=tdsa(lot(j),o,i)+1
        tda(lot(j),o) = tda(lot(j),o)+1
      endif
    enddo
  enddo
enddo
 
do j=1, nsp
  do o=1, nsp
    do i=1, ns
      mtabl(i)=edgea(j,o,i)
    enddo
    z=0.0d0
    call moyenne(mtabl, ns, z)
    call ect_type(z, mtabl, ns, etypea(j,o))
    do i=1, ns
      mtabl(i)=cornera(j,o,i)
    enddo
    z=0.0d0
    call moyenne(mtabl, ns, z)
    call ect_type(z, mtabl, ns, ctypea(j,o))
    do i=1, ns
      mtabl(i)=defa(j,o,i)
    enddo
    z=0.0d0
    call moyenne(mtabl, ns, z)
    call ect_type(z, mtabl, ns, detypea(j,o))
    do i=1, ns
      mtabl(i)=tdsa(j,o,i)
    enddo
    call moyenne(mtabl, ns, z)
    call ect_type(z, mtabl, ns, etda(j,o))
  enddo
enddo
 
001 continue
 
eescs=.true.
 
END FUNCTION