source: cnteny.f@ bd2278d

Last change on this file since bd2278d was bd2278d, checked in by baerbaer <baerbaer@…>, 16 years ago

Reformatting comments and continuation marks.

Fortran 90 and higher use ! to mark comments no matter where they are in the
code. The only valid continuation marker is &.
I also added the SMMP.kdevelop.filelist to the repository to make it easier
to use kdevelop.

git-svn-id: svn+ssh://svn.berlios.de/svnroot/repos/smmp/trunk@12 26dc1dd8-5c4e-0410-9ffe-d298b4865968

  • Property mode set to 100644
File size: 4.6 KB
Line 
1! **************************************************************
2!
3! This file contains the subroutines: cnteny
4!
5! Copyright 2005 Frank Eisenmenger, U.H.E. Hansmann,
6! Shura Hayryan, Chin-Ku
7! Copyright 2007 Frank Eisenmenger, U.H.E. Hansmann,
8! Jan H. Meinke, Sandipan Mohanty
9!
10! **************************************************************
11
12 subroutine cnteny(nml)
13
14! ................................................................................
15! PURPOSE: Calculate atomic contact energy of molecule 'nml' with ECEPP parameters
16!
17! CALLS: nursat
18! ................................................................................
19
20 include 'INCL.H'
21
22 parameter (coeycn=2.d0) ! min. cont. energy to display
23
24 dimension eyatcn(mxat),idxat(mxat)
25
26
27 ieyel=0 ! =1, if count electrost. energy
28
29 ntlvr=nvrml(nml)
30
31 if (ntlvr.eq.0) then
32 write (*,'(a,i4)')
33 & ' cnteny> No variables defined in molecule #',nml
34 return
35 endif
36
37 if (ieyel.eq.1) then
38 coey=5.d0*coeycn
39 else
40 coey=coeycn
41 endif
42
43 iat1=iatrs1(irsml1(nml))-1 ! last atom before 'nml'
44 nat=iatrs2(irsml2(nml))-iat1 ! no. of atoms in 'nml'
45
46 do i=1,nat
47 eyatcn(i)=0.d0
48 enddo
49
50
51 ifivr=ivrml1(nml)
52 i1s=imsml1(nml)+nmsml(nml)
53
54 do io=ifivr+ntlvr-1,ifivr,-1 ! ______ over variables in desc. order
55 iv=iorvr(io) ! index of var.
56
57 ia=iatvr(iv) ! prim.mv.at
58 it=ityvr(iv) ! type
59 ic=iclvr(iv) ! class
60
61 i2s=i1s-1 ! last m.s per 'iv'
62 i1s=imsvr1(iv) ! 1st m.s
63
64 do ims=i1s,i2s ! __ loop over m.s
65 i1=latms1(ims)
66 i2=latms2(ims)
67
68 do i=i1,i2 ! __ over atoms i ===================
69
70 ii=i-iat1
71
72 ity=ityat(i)
73 cqi=conv*cgat(i)
74
75 xi=xat(i)
76 yi=yat(i)
77 zi=zat(i)
78
79 do ivw=ivwat1(i),ivwat2(i) ! vdW-domains of 'i'
80 do j=lvwat1(ivw),lvwat2(ivw) ! atoms j
81
82 jj=j-iat1
83
84 jty=ityat(j)
85
86 xij=xat(j)-xi
87 yij=yat(j)-yi
88 zij=zat(j)-zi
89
90 rij2=xij*xij+yij*yij+zij*zij
91 rij4=rij2*rij2
92 rij6=rij4*rij2
93
94 if (ieyel.eq.1) then
95
96 rij=sqrt(rij2)
97
98 if (epsd) then
99 sr=slp*rij
100 ep=plt-(sr*sr+2.0*sr+2.0)*(plt-1.0)*exp(-sr)/2.0
101 else
102 ep = 1.0d0
103 endif
104
105 ey=cqi*cgat(j)/(rij*ep)
106
107 eyatcn(ii)=eyatcn(ii)+.5d0*ey
108 eyatcn(jj)=eyatcn(jj)+.5d0*ey
109
110 endif ! eyel
111
112 if (ihbty(ity,jty).eq.0) then
113 ey=aij(ity,jty)/(rij6*rij6)-cij(ity,jty)/rij6
114 else ! HB
115 ey=ahb(ity,jty)/(rij6*rij6)-chb(ity,jty)/(rij6*rij4)
116 endif
117
118 eyatcn(ii)=eyatcn(ii)+.5d0*ey
119 eyatcn(jj)=eyatcn(jj)+.5d0*ey
120
121 enddo ! ... atoms j
122 enddo ! ... vdW-domains of i
123
124 do i14=i14at1(i),i14at2(i) ! over 1-4 partn. of 'i'
125 j=l14at(i14)
126
127 jj=j-iat1
128
129 jty=ityat(j)
130
131 xij=xat(j)-xi
132 yij=yat(j)-yi
133 zij=zat(j)-zi
134 rij2=xij*xij+yij*yij+zij*zij
135 rij4=rij2*rij2
136 rij6=rij4*rij2
137
138 if (ieyel.eq.1) then
139
140 rij = sqrt(rij2)
141
142 if (epsd) then
143 sr=slp*rij
144 ep=plt-(sr*sr+2.0*sr+2.0)*(plt-1.0)*exp(-sr)/2.0
145 else
146 ep=1.0d0
147 endif
148
149 ey=cqi*cgat(j)/(rij*ep)
150
151 eyatcn(ii)=eyatcn(ii)+.5d0*ey
152 eyatcn(jj)=eyatcn(jj)+.5d0*ey
153
154 endif ! eel
155
156 if (ihbty(ity,jty).eq.0) then
157 ey=a14(ity,jty)/(rij6*rij6)-cij(ity,jty)/rij6
158 else
159 ey=ahb(ity,jty)/(rij6*rij6)-chb(ity,jty)/(rij6*rij4)
160 endif
161
162 eyatcn(ii)=eyatcn(ii)+.5d0*ey
163 eyatcn(jj)=eyatcn(jj)+.5d0*ey
164
165 enddo ! ... 1-4-partners of i
166
167 enddo ! ... atoms i
168 enddo ! ... m.s.
169
170 enddo ! ... variables
171
172 nbc=0
173
174 do i=1,nat
175 ey=eyatcn(i)
176 if (ey.gt.coey) then
177 nbc=nbc+1
178 ir=nursat(i)
179 write(*,'(1x,i4,1x,a4,1x,a4,a2,e11.4)') ir,seq(ir),nmat(i),
180 & ': ',ey
181 endif
182 enddo
183
184 return
185 end
186
Note: See TracBrowser for help on using the repository browser.