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

	program cellpack 

*******************************************************************************
c
c
c	To compile non-graphics programs use : 
c        f77 $(OPT) cellpack.f -o cellpack
c
        real rx(3000)
        real ry(3000)
        real nry(3000)
        real rz(3000)
        real ucell ,cx,cy,cz
        character*80    record(3000)
        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
        character*1     AtomType(3000) 
        integer         i,ia,id,ih
	integer	        natom
	integer	        ndisp ,nfrag
	integer	        j,itime 
	integer	        ia(3000) 
c
c 
	 print *,'Enter car file name: '
	 read(5,'(a40)') fname
c
         print *,'Input the number of atoms:'
         read(5,*) natom 
c
         print *,'Input the magnitude of the unit cell shift:'
         read(5,*) sh 
         print *,'Current configuration shifts along the y-axis'
c       
         open(unit=7,file=fname,form='formatted',
     $                            status='old',err=990)
c
         aform = "(a1,4x,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 
         do 200 i=1,natom
           read(7,'(a80)',end=997,err=995) record(i+5)
c           write(6,'(a80)') record(i+5)
           read (record(i+5),aform,err=996) AtomType(i),rx(i),
     $                       ry(i),rz(i),right
           print *,rx(i),ry(i),rz(i)
           if(AtomType(i).eq.'H') ia(i)=1
           if(AtomType(i).eq.'C') ia(i)=6
           if(AtomType(i).eq.'N') ia(i)=7
           if(AtomType(i).eq.'O') ia(i)=8
           if(AtomType(i).eq.'Fe') ia(i)=26
           if(AtomType(i).eq.'S') ia(i)=16
           if(AtomType(i).eq.'Au') ia(i)=107
200      continue
c
         close(7)
c
c
	 print *,'Enter output 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,5
          write(junit,'(a80)') record(j)
50      continue 
c        rec=record(5)
c        write (junit,10) rec(1:5),cx,cy,cz,rec(36:80)
        do 100 j = 1,natom
          rec=record(j+5)
          nry(j)=ry(j)+sh
           print *,rx(j),nry(j),rz(j)
          if(j.le.9) then
            write (junit,25) AtomType(j),j,
     $ rx(j),nry(j),rz(j),rec(51:80)
           else if(j.gt.9.and.j.le.99) then
             write (junit,27) AtomType(j),j,
     $ rx(j),nry(j),rz(j),rec(51:80)
           else if(j.gt.99.and.j.le.999) then
             write (junit,29) AtomType(j),j,
     $ rx(j),nry(j),rz(j),rec(51:80)
           else if(j.gt.999) then
             write (junit,31) AtomType(j),j,
     $ rx(j),nry(j),rz(j),rec(51:80)
          endif 
100     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)
25       format(a1,i1,6x,f12.8,3x,f12.8,3x,f12.8,a30)
27       format(a1,i2,5x,f12.8,3x,f12.8,2x,f13.9,a30)
29       format(a1,i3,4x,f12.8,3x,f12.8,2x,f13.9,a30)
31       format(a1,i4,3x,f12.8,3x,f12.8,2x,f13.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