mirror of
https://github.com/nwchemgit/nwchem.git
synced 2026-07-21 06:25:21 -04:00
vector analysis option
This commit is contained in:
Tjerk Straatsma
parent
903c893ed1
commit
f08e48acb8
3 changed files with 100 additions and 8 deletions
|
|
@ -1,6 +1,6 @@
|
|||
subroutine ana_groups(card,sgmnam,imol,isel,wt,x)
|
||||
c
|
||||
c $Id: ana_groups.F,v 1.13 2003-12-15 20:25:40 d3j191 Exp $
|
||||
c $Id: ana_groups.F,v 1.14 2006-11-10 22:01:11 d3j191 Exp $
|
||||
c
|
||||
implicit none
|
||||
c
|
||||
|
|
@ -26,6 +26,7 @@ c
|
|||
+ (rgroups(ngroups,i),i=1,2)
|
||||
1001 format(4i7,i5,i3,2f12.6)
|
||||
endif
|
||||
print*,'++++++++++',igroups(ngroups,5)
|
||||
c
|
||||
filgrp=card(68:80)
|
||||
if(filgrp(1:1).ne.' ') then
|
||||
|
|
@ -37,6 +38,8 @@ c
|
|||
+ call ana_grpdis(sgmnam,imol,isel,wt,x,ngroups)
|
||||
if(igroups(ngroups,5).eq.4)
|
||||
+ call ana_grpcogang(sgmnam,imol,isel,wt,x,ngroups)
|
||||
if(igroups(ngroups,5).eq.5)
|
||||
+ call ana_grpvectors(sgmnam,imol,isel,wt,x,ngroups)
|
||||
ngroups=ngroups-1
|
||||
close(unit=lfngrp)
|
||||
endif
|
||||
|
|
@ -45,7 +48,7 @@ c
|
|||
end
|
||||
subroutine ana_group(card,sgmnam,imol,isel,wt,x,iwrk)
|
||||
c
|
||||
c $Id: ana_groups.F,v 1.13 2003-12-15 20:25:40 d3j191 Exp $
|
||||
c $Id: ana_groups.F,v 1.14 2006-11-10 22:01:11 d3j191 Exp $
|
||||
c
|
||||
implicit none
|
||||
c
|
||||
|
|
@ -137,6 +140,91 @@ c
|
|||
endif
|
||||
2 continue
|
||||
1 continue
|
||||
c
|
||||
write(lfngrp,1002) 0
|
||||
1002 format(i5)
|
||||
c
|
||||
return
|
||||
end
|
||||
subroutine ana_grpvectors(sgmnam,imol,isel,wt,x,igr)
|
||||
c
|
||||
implicit none
|
||||
c
|
||||
#include "ana_common.fh"
|
||||
#include "global.fh"
|
||||
#include "mafdecls.fh"
|
||||
#include "msgids.fh"
|
||||
c
|
||||
character*16 sgmnam(nsa)
|
||||
real*8 wt(nsa)
|
||||
integer isel(nsa),igr,imol(msa)
|
||||
real*8 x(nsa,3),vi(3),vj(3)
|
||||
c
|
||||
integer igrp,jgrp
|
||||
integer i,j,jfrom,ia,ja,number
|
||||
real*8 dist,dx,dy,dz,dot
|
||||
c
|
||||
igrp=igroups(igr,1)
|
||||
jgrp=igroups(igr,2)
|
||||
print*,'igrp,jgrp=',igrp,jgrp
|
||||
c
|
||||
number=0
|
||||
c
|
||||
if(ldef(igrp).lt.0) return
|
||||
c
|
||||
write(lfngrp,1000) igr,igroups(igr,5)
|
||||
1000 format(2i5)
|
||||
c
|
||||
if(igrp.eq.jgrp)
|
||||
+ call md_abort('vectors: single atom list',0)
|
||||
if(ldef(igrp).ne.ldef(jgrp))
|
||||
+ call md_abort('vectors: unequal atom lists',0)
|
||||
ito=ldef(igrp)
|
||||
do 1 i=1,ito
|
||||
ia=idef(igrp,i)
|
||||
ja=idef(jgrp,i)
|
||||
dx=abs(x(ia,1)-x(ja,1))
|
||||
dy=abs(x(ia,2)-x(ja,2))
|
||||
dz=abs(x(ia,3)-x(ja,3))
|
||||
if(igroups(igr,6).eq.1) then
|
||||
if(dz.gt.box(3)) dz=dz-box(3)
|
||||
elseif(igroups(igr,6).eq.2) then
|
||||
if(dx.gt.box(1)) dx=dx-box(1)
|
||||
if(dy.gt.box(2)) dy=dy-box(2)
|
||||
elseif(igroups(igr,6).eq.3) then
|
||||
if(dx.gt.box(1)) dx=dx-box(1)
|
||||
if(dy.gt.box(2)) dy=dy-box(2)
|
||||
if(dz.gt.box(3)) dz=dz-box(3)
|
||||
endif
|
||||
dist=sqrt(dx*dx+dy*dy+dz*dz)
|
||||
c write(lfngrp,1001)
|
||||
c + imol(ia),sgmnam(ia)(11:16),sgmnam(ia)(1:5),sgmnam(ia)(6:10),
|
||||
c + imol(ja),sgmnam(ja)(11:16),sgmnam(ja)(1:5),sgmnam(ja)(6:10),dist
|
||||
c 1001 format(2(i5,a6,' ',a5,':',a5,' '),f12.6)
|
||||
write(lfngrp,1003) i,(x(ia,j),j=1,3),(x(ja,j)-x(ia,j),j=1,3),dist
|
||||
1003 format(i5,7f12.6)
|
||||
number=number+1
|
||||
1 continue
|
||||
do 2 i=1,ito
|
||||
ia=idef(igrp,i)
|
||||
ja=idef(jgrp,i)
|
||||
vi(1)=x(ia,1)-x(ja,1)
|
||||
vi(2)=x(ia,2)-x(ja,2)
|
||||
vi(3)=x(ia,3)-x(ja,3)
|
||||
do 3 j=i,ito
|
||||
ia=idef(igrp,j)
|
||||
ja=idef(jgrp,j)
|
||||
vj(1)=x(ia,1)-x(ja,1)
|
||||
vj(2)=x(ia,2)-x(ja,2)
|
||||
vj(3)=x(ia,3)-x(ja,3)
|
||||
dot=(vi(1)*vj(1)+vi(2)*vj(2)+vi(3)*vj(3))/
|
||||
+ (sqrt(vi(1)**2+vi(2)**2+vi(3)**2)*
|
||||
+ sqrt(vj(1)**2+vj(2)**2+vj(3)**2))
|
||||
write(lfngrp,1004) i,j,dot
|
||||
1004 format(2i5,f12.6)
|
||||
3 continue
|
||||
2 continue
|
||||
c 1 continue
|
||||
c
|
||||
write(lfngrp,1002) 0
|
||||
1002 format(i5)
|
||||
|
|
|
|||
|
|
@ -1,6 +1,6 @@
|
|||
subroutine ana_input(irtdb)
|
||||
c
|
||||
c $Id: ana_input.F,v 1.72 2006-03-30 17:55:57 d3j191 Exp $
|
||||
c $Id: ana_input.F,v 1.73 2006-11-10 22:01:11 d3j191 Exp $
|
||||
c
|
||||
implicit none
|
||||
c
|
||||
|
|
@ -422,17 +422,18 @@ c
|
|||
if(inp_compare(.false.,'distances',item)) iopt=2
|
||||
if(inp_compare(.false.,'zcoordinate',item)) iopt=3
|
||||
if(inp_compare(.false.,'angle',item)) iopt=4
|
||||
if(inp_compare(.false.,'vectors',item)) iopt=5
|
||||
if(.not.inp_f(rsel)) rsel=0.0d0
|
||||
if(.not.inp_f(rval)) rval=rsel
|
||||
if(.not.inp_a(item)) item=' '
|
||||
if(iopt.eq.1.and.jsel.le.0)
|
||||
+ call md_abort('Error in groups definition',4)
|
||||
if(iopt.eq.2.and.jsel.le.0)
|
||||
+ call md_abort('Error in groups definition',4)
|
||||
+ call md_abort('Error in groups definition',5)
|
||||
if(iopt.eq.4.and.(jsel.le.0.or.ksel.le.0))
|
||||
+ call md_abort('Error in groups definition',4)
|
||||
if(iopt.eq.5.and.(jsel.le.0.or.ksel.le.0.or.lsel.le.0))
|
||||
+ call md_abort('Error in groups definition',4)
|
||||
+ call md_abort('Error in groups definition',6)
|
||||
c if(iopt.eq.5.and.(jsel.le.0.or.ksel.le.0.or.lsel.le.0))
|
||||
c + call md_abort('Error in groups definition',7)
|
||||
write(lfncmd,1022) isel,jsel,ksel,lsel,iopt,ipbc,rsel,rval,
|
||||
+ item(1:index(item,' ')-1)
|
||||
1022 format('groups ',4i7,i5,i3,2f12.6,a)
|
||||
|
|
|
|||
|
|
@ -1,6 +1,6 @@
|
|||
subroutine ana_task
|
||||
c
|
||||
c $Id: ana_task.F,v 1.106 2006-09-11 21:22:33 d3j191 Exp $
|
||||
c $Id: ana_task.F,v 1.107 2006-11-10 22:01:12 d3j191 Exp $
|
||||
c
|
||||
implicit none
|
||||
c
|
||||
|
|
@ -1099,6 +1099,9 @@ c
|
|||
if(igroups(i,5).eq.4)
|
||||
+ call ana_grpcogang(byte_mb(i_snam),int_mb(i_imol),int_mb(i_isel),
|
||||
+ dbl_mb(i_wt),dbl_mb(i_xdat),i)
|
||||
if(igroups(i,5).eq.5)
|
||||
+ call ana_grpvectors(byte_mb(i_snam),int_mb(i_imol),
|
||||
+ int_mb(i_isel),dbl_mb(i_wt),dbl_mb(i_xdat),i)
|
||||
3301 continue
|
||||
endif
|
||||
c
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue