program molxyz implicit none integer*4 nat0 parameter (nat0=20000) integer*4 back(nat0),ib,ia,i,j,l,ii,ix,nat,it(nat0) real*8 rtem(nat0,3),a1,a2,a3,t,r3,a,r1(3),r2(3),r1p(3), 1q(nat0),pi,xyz(3,nat0),sp character*80 s80 pi=4.0d0*atan(1.0d0) open(9,file='mol') open(10,file='xyz') read(9,900)s80 write(10,900)s80 900 format(a80) read(9,*)ib read(9,*)it(1),q(1) read(9,*)(rtem(1,ix),ix=1,3) do 8 ix=1,3 8 xyz(ix,1)=rtem(1,ix) nat=ib+1 if(nat.gt.nat0)then write(6,*)'too many atoms' stop endif do 1 i=1,nat 1 back(i)=0 back(1)=nat+1 back(nat+1)=nat+2 rtem(nat+1,1)=rtem(1,1) rtem(nat+1,2)=rtem(1,2) rtem(nat+1,3)=rtem(1,3)-1.0d0 rtem(nat+2,1)=rtem(1,1)+1.0d0 rtem(nat+2,2)=rtem(1,2) rtem(nat+2,3)=rtem(1,3)-1.0d0 do 2 ii=1,ib l=ii+1 read(9,*)i,j,it(l),r3,a,t,q(l) back(j)=i if(back(i).eq.0.or.back(back(i)).eq.0)then write(6,*)'Ill-defined coordinates, bond ',ii stop endif do 3 ia=1,3 r2(ia)=rtem(i ,ia)-rtem(back(i) ,ia) 3 r1(ia)=rtem(back(i),ia)-rtem(back(back(i)),ia) a1=-r3*sin((180.0d0-a)*pi/180.0d0)*cos(t*pi/180.0d0) a2=-r3*cos(a*pi/180.0d0) if(r3**2-a1**2-a2**2.gt.0.0d0)then a3=dsqrt(r3**2-a1**2-a2**2) else a3=0.0d0 endif if(t.lt.0.0d0)a3=-a3 do 4 ia=1,3 4 r1p(ia)=r1(ia)-sp(r1,r2)*r2(ia)/sp(r2,r2) call norm(r1p) call norm(r2) call vp(r1p,r2,r1) do 5 ia=1,3 5 rtem(j,ia)=rtem(i,ia)+a1*r1p(ia)+a2*r2(ia)+a3*r1(ia) do 6 ia=1,3 6 xyz(ia,l)=rtem(j,ia) 2 continue close(9) write(10,*)nat do 7 ia=1,nat 7 write(10,1000)it(ia),(xyz(ix,ia),ix=1,3),q(ia) 1000 format(i6,3f12.6,' 0 0 0 0 0 0 0 ',f10.2) close(10) stop end function sp(v1,v2) real*8 v1(*),v2(*),sp sp=v1(1)*v2(1)+v1(2)*v2(2)+v1(3)*v2(3) return end subroutine vp(v1,v2,v3) real*8 v1(*),v2(*),v3(*) v3(1)=v1(2)*v2(3)-v1(3)*v2(2) v3(2)=v1(3)*v2(1)-v1(1)*v2(3) v3(3)=v1(1)*v2(2)-v1(2)*v2(1) return end subroutine norm(v) real*8 v(*),a,sp a=1.0d0/dsqrt(sp(v,v)) v(1)=v(1)*a v(2)=v(2)*a v(3)=v(3)*a return end