*******************************************************************************

	program hbvecm 

*******************************************************************************
c
c       This program allows the user to create input car files with
c       a hydrogen atom displacement between two hydrogen bond partners
c       For example, in a N-H...O hydrogen bond the H is displaced
c       along the N--->O vector
c
c	To compile non-graphics programs use : 
c        f77 $(OPT) hbvecm.f -o hbvecm
c
        real rx(300), ry(300), rz(300)
        real dax,day,daz,dhx,dhy,dhz
        real davec,dhvec,udax,uday,udaz
        real dstart,disp,prod
        character*80    record(300)
        character*80    rec
        character*80    aform
        character*40	fname
        character*40	gname
        character*40	hname
        character*4     root
        character*20    right 
        character*5     left 
        character*2     tchar2
        character*1     tchar1
        integer         i,ia,id,ih
	integer	        natom
	integer	        ndisp 
	integer	        j,itime 
c
c 
	 print *,'Enter car file name: '
	 read(5,'(a40)') fname
c
         print *,'Input the number of atoms:'
         read(5,*) natom 
c
	 print *,'Enter output file name:  '
	 read(5,'(a40)') hname
c       
         open(unit=7,file=fname,form='formatted',
     $                            status='old',err=990)
         open(unit=3,file=hname,form='formatted',
     $                            status='new',err=990)
c
         aform = "(a5,3(2x,f13.9),a29)"
c
         read(7,'(a80)',end=997,err=995) record(1)
         read(7,'(a80)',end=997,err=995) record(2)
         read(7,'(a80)',end=997,err=995) record(3)
         read(7,'(a80)',end=997,err=995) record(4)

         do 200 i=1,natom
           read(7,'(a80)',end=997,err=995) record(i+4)
           write(6,'(a80)') record(i+4)
           read (record(i+4),aform,err=996) left,rx(i),
     $                       ry(i),rz(i),right
200      continue
         print *,'Input the atom number of the Hbond donor:'
         read(5,*) id 
         print *,'Input the atom number of the Hbond acceptor:'
         read(5,*) ia 
         print *,'Input hydrogen atom number:'
         read(5,*) ih 
         dax=rx(ia)-rx(id)
         day=ry(ia)-ry(id)
         daz=rz(ia)-rz(id)
         davec=sqrt(dax*dax+day*day+daz*daz)
         print *,'The donor-acceptor distance is:',davec
         dhx=rx(ih)-rx(id)
         dhy=ry(ih)-ry(id)
         dhz=rz(ih)-rz(id)
         dhvec=sqrt(dhx*dhx+dhy*dhy+dhz*dhz)
         print *,'The donor-hydrogen distance is:',dhvec
         prod=(dax*dhx+day*dhy+daz*dhz)/davec/dhvec
         prod=180/3.1415926*acos(prod)
         print *,'The angle between D-A and D-H is:',prod
         udax=dax/davec
         uday=day/davec
         udaz=daz/davec
c
         close(7)
c
         print *,'Input the number of displacement steps:'
         read(5,*) ndisp
         print *,'Input the initial distance:' 
         read(5,*) dstart 
         print *,'Input the displacement distance per step:'
         read(5,*) disp 
c
         print *,'Atom number',ih,' will be displaced from'
         print *, dstart,' to ',dstart+ndisp*disp
c
         print *,'Enter the root name for output files.'
         print *,'Enter a 4 character string (no single quotes):'
         read(5,'(a4)') root 
         ierror=0
         do i=1,ndisp
           call int2char(i,tchar1,tchar2)
           if (i.le.9) then
              gname = root//tchar1//'.car'
           else
              gname = root//tchar2//'.car'
           endif
           rx(ih)=rx(id)+udax*((i-1)*disp+dstart)
           ry(ih)=ry(id)+uday*((i-1)*disp+dstart)
           rz(ih)=rz(id)+udaz*((i-1)*disp+dstart)
           junit=7
           open(unit=7,file=gname,form='formatted',err=990)
           do 50 j = 1,4
             write(junit,'(a80)') record(j)
50         continue 
           do 100 j = 1,natom
             if(j.ne.ih) then
               write(junit,'(a80)') record(j+4)
             else
               rec=record(ih+4)
           write (junit,20) rec(1:8),rx(ih),ry(ih),rz(ih),
     $ rec(51:80)
             endif
100     continue
          do 150 j = 1,2
	    write(junit,'(a3)') 'end'
150       continue 
        close(7)
c
	enddo
c
20       format(a8,f12.9,3x,f12.9,3x,f12.9,a30)
c
        do 250 i=2,ndisp
           if(i.lt.10) then
             write(3,35) root,root,i
           else if(i.ge.10) then
             write(3,37) root,root,i
            endif
250     continue
        do 270 i=1,ndisp
           if(i.lt.10) then
             write(3,45) root,i
           else if(i.ge.10) then
             write(3,47) root,i
            endif
270     continue
c
35         format('cp ',a4,'1.input ',a4,i1,'.input')
37         format('cp ',a4,'1.input ',a4,i2,'.input')
45         format('prpq2 ',a4,i1)
47         format('prpq2 ',a4,i2)
c
         goto 999
990      continue
         print *,'Error in input file'
         goto 999
995      continue
         print *,'Error in format'
         print *, record
         goto 999
996      continue
         print *,'Error parsing format'
         print *, record
         print *,left, rx(i), ry(i), rz(i),right 
         goto 999
997      continue
         print *,'End of file detected'
999      continue
c
         end
c
***************************************************************************

      Subroutine int2char(i,tempchar1,tempchar2)

***************************************************************************
!          To convert the integer data to character data

      Implicit None

      Integer i
      Character*1 tempchar1
      Character*2 tempchar2
      Character*4 record
 
      if(i.lt.10) then
        Write (record,'(i1)') i
        Read (record,'(a1)') tempchar1
      else
        Write (record,'(i2)') i
        Read (record,'(a2)') tempchar2
      endif

      Return
      End