root / src / CalcCnct.f90 @ 8
History  View  Annotate  Download (3.7 kB)
1 
!================================================================ 

2 
! Calculation of the connectivity. 
3 
! 
4 
! Input: 
5 
! Na: (INTEGER) Number of atoms in the system 
6 
! Atome: (INTEGER) Number of mass of the atoms. 
7 
! Needed to find their covalent raii. 
8 
! x(Nat), y(nat), z(nat) : (REAL) Cartesian coordinates of the system. 
9 
! LIAISONS: (INTEGER Na,0:NMaxL) Array containing the connectivity. 
10 
! That is Liaisons(i,:) contains the atoms linked to i. 
11 
! Liaisons(i,0) contains the number of atoms linked to i. 
12 
! r_cov(0:Max_Z) (REAL) Covalent radii 
13 
! Fact (REAL) Factor used to determined if two atoms are linked : 
14 
! i and j are linked if (dist(i,j)*fact <= rcov(i)+rcov(j) 
15 
! 
16 
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
17 
! Taken from Path_Module 
18 
! NMaxL (INTEGER): Maximum number of bonds for one atome 
19 
! Max_Z (INTEGER): Last atom for which I have the atomic of mass and covalent radii. 
20 
! Nom(Nat) (STRING): Name of the atoms. 
21 
! Prog (SCHARS): Name of the program used to calculate energies and gradients 
22 
! 
23 
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
24 
! v1.0 (c) PFL 
25 
! v1.1 (c) PFL 11.2007 
26 
! A test has been added for periodic system, ie the linked test 
27 
! is done between i in the central cell, and j in all surrounding cells. 
28 
! 
29 
!================================================================ 
30  
31 
SUBROUTINE CalcCnct(na,atome,x,y,z,LIAISONS,r_cov,fact) 
32  
33 
use Path_module, only : NMaxL, max_Z,Nom,Prog, KINT, KREAL 
34 

35 
IMPLICIT NONE 
36  
37 
integer(KINT) :: na, atome(Na) 
38 
real(KREAL) :: x(Na),y(Na),z(Na),fact 
39 
real(KREAL) :: vx,vy,vz,dist 
40 
REAL(KREAL) :: r_cov(0:Max_Z) 
41 
INTEGER(KINT) :: LIAISONS(Na,0:NMaxL),Nbli,Nblj 
42  
43 
! For periodic systems 
44 
INTEGER(KINT) :: Ka,Kb,Kc 
45 
LOGICAL :: Bound 
46  
47 
! Internals 
48 
logical(KREAL) ::debug 
49 
REAL(KREAL) :: DistTh 
50 
INTEGER(KINT) :: I,j,iat 
51  
52 
INTERFACE 
53 
function valid(string) result (isValid) 
54 
CHARACTER(*), intent(in) :: string 
55 
logical :: isValid 
56 
END function VALID 
57 
END INTERFACE 
58  
59 
debug=valid('calccnct') 
60 
if (debug) Call Header (" Entering CalcCnct ") 
61  
62 
DO i=1,na 
63 
Liaisons(i,0)=0 
64 
END DO 
65  
66 
if (debug) THEN 
67 
WRITE(*,*) 'CalcCnct' 
68 
DO iat=1,na 
69 
i=atome(iat) 
70 
WRITE(*,*) Nom(I),I,r_cov(i),r_cov(i)*fact 
71 
END DO 
72 
END IF 
73  
74 
IF (PROG/="VASP") THEN 
75 
DO i=1,na 
76 
NbLi=LIAISONS(i,0) 
77 
DO j=i+1,na 
78 
CALL vecteur(j,i,x,y,z,vx,vy,vz,dist) 
79 
dist=dist/fact 
80 
distth=(r_cov(atome(i))+r_cov(atome(j)))/100. 
81 
! if (debug) WRITE(*,*) atome(i),atome(j),dist,distth 
82 
if (dist.le.distth) THEN 
83 
NbLi=NbLi+1 
84 
LIAISONS(i,NbLi)=j; 
85 
NBlj=LIAISONS(j,0)+1 
86 
LIAISONS(j,Nblj)=i; 
87 
LIAISONS(j,0)=Nblj 
88 
END IF 
89 
END DO 
90 
LIAISONS(i,0)=Nbli 
91 
END DO 
92 
ELSE 
93 
DO i=1,na 
94 
NbLi=LIAISONS(i,0) 
95 
DO j=i+1,na 
96 
Bound=.FALSE. 
97 
DO ka=1,1 
98 
DO Kb=1,1 
99 
DO Kc=1,1 
100 
CALL VectorPer(j,i,ka,kb,kc,x,y,z,vx,vy,vz,dist) 
101 
dist=dist/fact 
102 
distth=(r_cov(atome(i))+r_cov(atome(j)))/100. 
103 
! if (debug) WRITE(*,*) atome(i),atome(j),dist,distth 
104 
if (dist.le.distth) Bound=.TRUE. 
105 
END DO 
106 
END DO 
107 
END DO 
108 
IF (Bound) THEN 
109 
if (debug) WRITE(*,*) "Adding a bond between:",i,j 
110 
NbLi=NbLi+1 
111 
LIAISONS(i,NbLi)=j; 
112 
NBlj=LIAISONS(j,0)+1 
113 
LIAISONS(j,Nblj)=i; 
114 
LIAISONS(j,0)=Nblj 
115 
END IF 
116 
END DO 
117 
LIAISONS(i,0)=Nbli 
118 
END DO 
119 
END IF 
120 
if (debug) Call Header (" CalcCnct over ") 
121 
END SUBROUTINE CalcCnct 