Chimie Théorique » Opt'n Path

!This subroutines decomposes a connectivity list into fragments.

SUBROUTINE Decomp_Frag(na,ListConnect,ListAt,nbfrag,Fragment,NbAtFrag,FragAt)

!----------------------------------------------------------------------

!  Copyright 2003-2014 Ecole Normale Supérieure de Lyon,

!  Centre National de la Recherche Scientifique,

!  Université Claude Bernard Lyon 1. All rights reserved.

!

!  This work is registered with the Agency for the Protection of Programs

!  as IDDN.FR.001.100009.000.S.P.2014.000.30625

!

!  Authors: P. Fleurat-Lessard, P. Dayal

!  Contact: optnpath@gmail.com

!

! This file is part of "Opt'n Path".

!

!  "Opt'n Path" 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.

!

!  "Opt'n Path" 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 Affero General Public License for more details.

!

!  You should have received a copy of the GNU Affero General Public License

!  along with "Opt'n Path". If not, see <http://www.gnu.org/licenses/>.

!

! Contact The Office of Technology Licensing, valorisation@ens-lyon.fr,

! for commercial licensing opportunities.

!----------------------------------------------------------------------

  Use Path_module, only : NMaxL

  Use Io_module

  IMPLICIT NONE

  INTEGER(KINT), INTENT(IN) :: na

  INTEGER(KINT), INTENT(IN) :: ListConnect(na,0:NMaxL)

  LOGICAL,       INTENT(IN) :: ListAt(na)

  INTEGER(KINT), INTENT(OUT) :: NbFrag,Fragment(na),NbAtFrag(na),FragAt(na,na)

  INTEGER(KINT) :: i, j, iat, jat

  INTEGER(KINT) :: IdxFrag, IdxtoDo, IFrag,IaFaire

  INTEGER(KINT), ALLOCATABLE :: ToDo(:)

  LOGICAL :: Debug

  INTERFACE

     function valid(string) result (isValid)

       CHARACTER(*), intent(in) :: string

       logical                  :: isValid

     END function VALID

  END INTERFACE

  debug=valid('decompfrag').OR.valid('Decomp_frag')

  if (debug) Call Header('Entering DecomFrag')

  !     We analyse the connectivity in terms of fragments

  ALLOCATE(ToDo(na))

  Fragment=0

  ToDo=0

  IdxFrag=0

  NbFrag=0

  NbAtFrag=0

  Fragment=0

  FragAt=0

  DO I=1,na

     IdxToDo=1

     ToDo(IdxToDo)=0

     if (debug) WRITE(*,*) 'Treating atom I, fragment(I)',I,Fragment(I)

     IF (ListAt(I).OR.(ListConnect(I,0).NE.0)) THEN

        IF (Fragment(I).EQ.0) THEN

           IdxFrag=IdxFrag+1

           NbFrag=NbFrag+1

           IFrag=IdxFrag

           Fragment(I)=IFrag

           NbAtFrag(IFrag)=NbAtFrag(IFrag)+1

           FragAt(IFrag,NbAtFrag(IFrag))=I

        ELSE

           IFrag=Fragment(I)

        END IF

        DO J=1,ListConnect(I,0)

           Iat=ListConnect(I,J)

           IF ((Fragment(Iat).NE.0).AND.(Fragment(Iat).NE.IFrag)) THEN

              WRITE(*,*) 'Error : Atoms ',I,' and ',Iat

              WRITE(*,*) 'are linked, but belongs to fragments ',IFrag,' and ',Fragment(Iat)

              STOP

           END IF

           IF (Fragment(Iat).EQ.0) THEN

              ToDo(IdxToDo)=Iat

              Fragment(Iat)=IFrag

              NbAtFrag(IFrag)=NbAtFrag(IFrag)+1

              FragAt(IFrag,NbAtFrag(IFrag))=Iat

              IdxToDo=IdxToDo+1

           END IF

        END DO

        ToDo(IdxToDo)=0

        If (debug) WRITE(*,*) 'ToDo:',ToDo(1:IdxToDo)

        If (debug) WRITE(*,*) 'IFrag=',IFrag

        IAfaire=1

        DO WHILE (ToDo(IAfaire).NE.0)

           Iat=ToDo(IaFaire)

           IF (ListAt(I).OR.(ListConnect(I,0).NE.0)) THEN

              if (debug) WRITE(*,*) 'ToDo treating ',Iat

              IF (Fragment(Iat).EQ.0) THEN

                 WRITE(*,*) 'Error: Atom ',Iat,' does not belong to any fragment !'

                 STOP

              END IF

              DO J=1,ListConnect(Iat,0)

                 Jat=ListConnect(Iat,J)

                 IF ((Fragment(ListConnect(Iat,J)).NE.0).AND.(Fragment(ListConnect(Iat,J)).NE.IFrag)) THEN

                    WRITE(*,*) 'Error: Atoms ',Iat,' and ',ListConnect(Iat,J)

                    WRITE(*,*) 'are linked, but belongs to fragments ',IFrag,' and ',Fragment(ListConnect(Iat,J))

                    STOP

                 END IF

                 IF (Fragment(Jat).EQ.0) THEN

                    ToDo(IdxToDo)=ListConnect(Iat,J)

                    Fragment(Jat)=IFrag

                    NbAtFrag(IFrag)=NbAtFrag(IFrag)+1

                    FragAt(IFrag,NbAtFrag(IFrag))=Jat

                    IdxToDo=IdxToDo+1

                 END IF

              END DO

              ToDo(IdxToDo)=0

              If (debug) WRITE(*,*) 'IAfaire, IdxToDo,ToDo :',IAfaire,IdxToDo,' == ',ToDo(IaFaire+1:IdxToDo)

              IAFaire=IAFaire+1

           END IF

        END DO

     END IF

  END DO

  IF (debug) THEN

     WRITE(*,*) 'DECOMP_FRAG: I found ',NbFrag, 'fragments'

     DO I=1,NbFrag

        WRITE(*,*) 'Fragment ', i,' with ',NbAtFrag(I),' atoms.'

        WRITE(*,*) "FragAt:",(FragAt(I,j),j=1,NbAtFrag(I))

     END DO

  END IF

  if (debug) Call Header('DecomFrag over')

END SUBROUTINE Decomp_Frag