1! Small program to convert coordinates .xyz file to
2! inputblock.dat which is the coordinate format used by latte
3! Written by C. F. A. Negre. Nov. 2014. Los Alamos Nat. Lab.
4
5
6PROGRAM xyz2latte
7
8  IMPLICIT NONE
9  REAL(8) :: xmin,xmax,ymin,ymax,zmin,zmax
10  INTEGER :: N, i, io
11  CHARACTER :: dummy
12  CHARACTER(2), ALLOCATABLE :: atom(:)
13  REAL(8), ALLOCATABLE :: x(:),y(:),z(:)
14
15  WRITE(*,*) 'Reading coordinates ...'
16
17  OPEN(1,file='coords.xyz') ! Default coordinates name.
18
19  READ(1,*) N ! Number of atoms.
20
21  ALLOCATE(atom(N),x(N),y(N),z(N)) ! Allocate manes and coordinates.
22
23  READ(1,'(A1)',IOSTAT=io) dummy  ! Reads the dummy name of the xyz file.
24
25  WRITE(*,*)'Number of atoms', N
26
27  DO i=1,N ! Reading names and coordinates.
28     READ(1,*)atom(i),x(i),y(i),z(i)
29     WRITE(*,*)atom(i),x(i),y(i),z(i)
30  ENDDO
31
32  xmin=1000000 ! Initial guess for the boundaries.
33  xmax=-100000
34  ymin=100000
35  ymax=-1000000
36  zmin=1000000
37  zmax=-10000000
38
39  DO i=1,N  ! Searching for the boundaries.
40
41     IF(xmin.GT.x(i))xmin=x(i)
42     IF(xmax.LT.x(i))xmax=x(i)
43
44     IF(ymin.GT.y(i))ymin=y(i)
45     IF(ymax.LT.y(i))ymax=y(i)
46
47     IF(zmin.GT.z(i))zmin=z(i)
48     IF(zmax.LT.z(i))zmax=z(i)
49
50  ENDDO
51
52  WRITE(*,*)'xmin xmax', xmin,xmax
53  WRITE(*,*)'ymin ymax', ymin,ymax
54  WRITE(*,*)'zmin zmax', zmin,zmax
55
56  xmin=xmin-5.0 ! Adding some space to the simulation box.
57  xmax=xmax+5.0
58  ymin=ymin-5.0
59  ymax=ymax+5.0
60  zmin=zmin-5.0
61  zmax=zmax+5.0
62
63  OPEN(2,file='inputblock.dat')
64
65  ! inputblock.dat format. See LATTE documentation files.
66  WRITE(2,*)N
67  WRITE(2,"(3F20.5)")xmax-xmin,0.0,0.0
68  WRITE(2,"(3F20.5)")0.0,ymax-ymin,0.0
69  WRITE(2,"(3F20.5)")0.0,0.0,zmax-zmin
70  DO i=1,N
71     WRITE(2,'(A2,3F20.5)')atom(i),x(i),y(i),z(i)
72  ENDDO
73
74END PROGRAM xyz2latte
75