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

	program cellstagger

*******************************************************************************
c
c       This program allows the user to duplicate and stagger a molecule
c       in a unit cell.  The unit cell is expanded in the process.
c
c	To compile non-graphics programs use : 
c        f77 $(OPT) cellstagger.f -o cellstagger
c
        real rx(300), ry(300), rz(300)
        real xdp,ydp,zdp,cx,cy,cz
        character*80    record(300)
        character*80    rec
        character*80    aform
        character*80    bform
        character*40	fname
        character*40	gname
        character*20    right 
        character*20    r1
        character*5     left 
        character*5     l1
        integer         i,ia,id,ih
	integer	        natom
	integer	        ndisp ,nfrag
	integer	        j,itime 
	integer	        ifrag(20) 
c
c 
	 print *,'Enter car file name: '
	 read(5,'(a40)') fname
c
         print *,'Input the number of atoms:'
         read(5,*) natom 
c
c       
         open(unit=7,file=fname,form='formatted',
     $                            status='old',err=990)
c
         aform = "(a5,3(2x,f13.9),a29)"
         bform = "(a5,3(f10.5),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)
         read(7,'(a80)',end=997,err=995) record(5)
         write(6,'(a80)') record(5)

         read (record(5),bform,err=996) l1,cx,cy,cz,r1 
         print *,'A duplicate of the molecule will be created displaced'
         print *,'along the specified coordinates'
         print *,'Input the x displacement'
         read(5,*) xdp 
         print *,'Input the y displacement'
         read(5,*) ydp 
         print *,'Input the z displacement'
         read(5,*) zdp 
c
c         it is assumed that the polymer chain axis is along the 
c         x direction so this unit cell vector is not changed
c         cx=cx+xdp
         cy=cy+ydp
         cz=cz+zdp
c
         do 200 i=1,natom
           read(7,'(a80)',end=997,err=995) record(i+5)
           write(6,'(a80)') record(i+5)
           read (record(i+5),aform,err=996) left,rx(i),
     $                       ry(i),rz(i),right
           rx(i+natom)=rx(i)+xdp
           ry(i+natom)=ry(i)+ydp
           rz(i+natom)=rz(i)+zdp
200      continue
c
         close(7)
c
c
	 print *,'Enter car file name: '
	 read(5,'(a40)') gname
         open(unit=7,file=gname,form='formatted',
     $                            status='new',err=990)
         ierror=0
        junit=7
        do 50 j=1,4
          write(junit,'(a80)') record(j)
50      continue 
        rec=record(5)
        write (junit,10) rec(1:5),cx,cy,cz,rec(36:80)
c
c       there are now twice as many atoms in the unit cell
c
        do 100 j = 1,natom
          rec=record(j+5)
          write (junit,20) rec(1:8),rx(j),ry(j),rz(j),rec(51:80)
100     continue
        do 120 j = 1,natom
          rec=record(j+5)
          k=j+natom
          write (junit,20) rec(1:8),rx(k),ry(k),rz(k),rec(51:80)
120     continue
          do 150 j = 1,2
	    write(junit,'(a3)') 'end'
150       continue 
        close(7)
c
10       format(a5,3(f10.5),a45)
20       format(a8,f12.9,3x,f12.9,3x,f12.9,a30)
c
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