comp-chem/NWChem
1
0
Fork 0
mirror of https://github.com/nwchemgit/nwchem.git synced 2026-07-29 06:35:39 -04:00
Code Issues Projects Releases Packages Wiki Activity Actions 1

Revert

Browse source
This commit is contained in:
Kurt Glaesmann 2009-07-16 17:25:22 +00:00
parent 8960e4525d
commit 452997d64e
10 changed files with 43 additions and 48 deletions
Download patch file Download diff file Expand all files Collapse all files

8
src/prepar/pre_angl.F
View file

@ -1,14 +1,12 @@
logical function pre_ang(lbnd,mbnd,nbnd,lang,mang,nang)
logical function pre_ang(lbnd,mbnd,nbmd,lang,mang,nang)
c
c $Id: pre_angl.F,v 1.2 1998-04-29 18:35:11 d3j191 Exp $
c
THIS FILE IS NOT USED
implicit none
c
integer mbnd,mang
integer nbnd,nang
integer lbnd(mbnd,2),lang(mang,3)
integer i,j
c
c determine the list of angles
c ----------------------------
@ -50,10 +48,10 @@ c
2 continue
1 continue
c
pre_ang=.true.
pre_angl=.true.
return
c
9999 continue
pre_ang=.false.
pre_angl=.false.
return
end

20
src/prepar/pre_charge.F
View file

@ -306,9 +306,9 @@ c
if(nox.eq.2) then
do 6 j=1,nb
if(latm(2,iab(j)).eq.8.and.latm(3,iab(j)).eq.1)
+ qatm(iab(j))=qatm(iab(j))-0.33d0
+ qatm(iab(j))=qatm(iab(j))-0.33
6 continue
qatm(i)=qatm(i)-0.34d0
qatm(i)=qatm(i)-0.34
endif
endif
c
@ -322,9 +322,9 @@ c
if(nhx.eq.3) then
do 8 j=1,nb
if(latm(2,iab(j)).eq.1.and.latm(3,iab(j)).eq.1)
+ qatm(iab(j))=qatm(iab(j))+0.25d0
+ qatm(iab(j))=qatm(iab(j))+0.25
8 continue
qatm(i)=qatm(i)+0.25d0
qatm(i)=qatm(i)+0.25
endif
endif
c
@ -338,16 +338,16 @@ c
if(nox.eq.2) then
do 21 j=1,nb
if(latm(2,iab(j)).eq.8.and.latm(3,iab(j)).eq.1)
+ qatm(iab(j))=qatm(iab(j))-0.33d0
+ qatm(iab(j))=qatm(iab(j))-0.33
21 continue
qatm(i)=qatm(i)-0.34d0
qatm(i)=qatm(i)-0.34
endif
if(nox.eq.3) then
do 22 j=1,nb
if(latm(2,iab(j)).eq.8.and.latm(3,iab(j)).eq.1)
+ qatm(iab(j))=qatm(iab(j))-0.50d0
+ qatm(iab(j))=qatm(iab(j))-0.50
22 continue
qatm(i)=qatm(i)-0.50d0
qatm(i)=qatm(i)-0.50
endif
endif
c
@ -361,9 +361,9 @@ c
if(nox.eq.3) then
do 24 j=1,nb
if(latm(2,iab(j)).eq.8.and.latm(3,iab(j)).eq.1)
+ qatm(iab(j))=qatm(iab(j))-0.25d0
+ qatm(iab(j))=qatm(iab(j))-0.25
24 continue
qatm(i)=qatm(i)-0.25d0
qatm(i)=qatm(i)-0.25
endif
endif
c

2
src/prepar/pre_collaps.F
View file

@ -217,7 +217,7 @@ c
do 10 k=1,3
a=a+tr(k)*tr(k)
b=b+(xs(k,i)-xs(k,j))*tr(k)
c=c+xs(k,i)*xs(k,i)+xs(k,j)*xs(k,j)-2*xs(k,i)*xs(k,j)
c=c+xs(k,i)*xs(k,i)+xs(k,j)*xs(k,j)-2.0*xs(k,i)*xs(k,j)
10 continue
b=2.0d0*b
c=c-touch*touch

2
src/prepar/pre_equiv.F
View file

@ -64,5 +64,5 @@ c
c
c 9999 continue
c pre_equiv=.false.
c return
return
end

4
src/prepar/pre_input.F
View file

@ -1237,8 +1237,8 @@ c
goto 2
endif
if(inp_compare(.false.,'collapse_group',item)) then
if(.not.inp_i(icolgrp))call md_abort('pre_input collapse_group',0)
if(.not.inp_i(jcolgrp))call md_abort('pre_input collapse_group',0)
if(.not.inp_i(icolgrp)) call md_abort('pre_input collapse_group')
if(.not.inp_i(jcolgrp)) call md_abort('pre_input collapse_group')
write(68,6885) icolgrp,jcolgrp
6885 format('collapsgr ',2i5)
numcmd=numcmd+1

4
src/prepar/pre_links.F
View file

@ -126,8 +126,8 @@ c
else
call md_abort('inconsistent links',9999)
endif
if(.not.pre_protein(cseq(1,i)).or.
+ .not.pre_protein(cseq(1,i+1))) then
if(.not.pre_protein(ffield,cseq(1,i)).or.
+ .not.pre_protein(ffield,cseq(1,i+1))) then
nlnk=nlnk+1
if(nlnk.gt.mlnk) call md_abort('increase mlnk',9999)
llnk(1,nlnk)=i

40
src/prepar/pre_namiup.F
View file

@ -38,38 +38,32 @@ c
logical flag1
c
if(util_print('sequence',print_debug)) then
write(lfnout,2000)
2000 format(/,'pre_namiup ')
write(lfnout,2000)
2000 format(/,'pre_namiup ')
endif
c
flag1=.false.
do 1 i=1,natm
if(pre_protein(cseq(1,latm(1,i)))) then
if(catm(1,i)(1:2).eq.'1H') flag1=.true.
endif
catm(2,i)=catm(1,i)
if(pre_protein(ffield,cseq(1,latm(1,i)))) then
if(catm(1,i)(1:2).eq.'1H') flag1=.true.
endif
catm(2,i)=catm(1,i)
1 continue
c
c IUPAC hydrogen naming
c
if(flag1) then
do 2 i=1,natm
if(pre_protein(cseq(1,latm(1,i)))) then
if(catm(2,i)(1:2).eq.'1H') then
catm(2,i)(1:2)='2H'
if(i+1 .le. natm .and. catm(2,i+1)(1:2).eq.'2H') then
catm(2,i+1)(1:2)='3H'
if(i+2 .le. natm .and. catm(2,i+2)(1:2).eq.'3H') then
catm(2,i+2)(1:2)='4H'
endif
endif
endif
endif
2 continue
if(util_print('sequence',print_high)) then
write(lfnout,2001)
2001 format(/,'Hydrogen atom prefix corrected ')
endif
do 2 i=1,natm
if(pre_protein(ffield,cseq(1,latm(1,i)))) then
if(catm(2,i)(1:2).eq.'3H') catm(2,i)(1:2)='4H'
if(catm(2,i)(1:2).eq.'2H') catm(2,i)(1:2)='3H'
if(catm(2,i)(1:2).eq.'1H') catm(2,i)(1:2)='2H'
endif
2 continue
if(util_print('sequence',print_high)) then
write(lfnout,2001)
2001 format(/,'Hydrogen atom prefix corrected ')
endif
endif
c
c ILE CD1 -> CD

1
src/prepar/pre_parcom.F
View file

@ -1,7 +1,6 @@
logical function pre_parcnv(icomb,latt,patt,matt,natt)
c
c $Id: pre_parcom.F,v 1.2 1998-04-29 18:35:20 d3j191 Exp $
THIS FILE IS NOT USED
c
implicit none
c

2
src/prepar/pre_repeat.F
View file

@ -52,7 +52,7 @@ c
do 3 k=1,3
imin(k)=1
jmin(k)=1
r2min(k)=1.0d24
r2min(k)=1.0e24
3 continue
c
do 4 i=1,nsa

8
src/prepar/pre_select.F
View file

@ -21,7 +21,8 @@ c
c
c
integer i,j,ifr,ito,igrp
integer iatom,isgm
character*255 target,atomi
integer ndx,iatom,isgm
character*4 trgt
integer i_list,l_list
c
@ -34,6 +35,9 @@ c
if(igrp.gt.maxgrp) call md_abort('Group number error',igrp)
c
card=card(7:80)
c
ndx=index(card,' ')
target=card(1:ndx-1)
c
if(.not.ma_push_get(mt_int,nsa,'list',l_list,i_list))
+ call md_abort('Failed to allocate list',0)
@ -80,7 +84,7 @@ c
integer natoms
character*16 atomname(natoms)
integer isegment(natoms)
character*80 target
character*255 target
character*10 string,aname
integer list(natoms)
c