Add files via upload

FOCEX/utility/poscar2xyz.f90

@@ -0,0 +1,129 @@
+ program poscar2xyz
+!! the following reads the POSCAR file that is used by VASP
+!! reads supercell translation vectors and atomic coordinates therein
+ implicit none
+ integer, parameter :: nt=9
+ character line*90, poscar*50
+ character(len=2) :: name(nt)
+ integer i,j,uposcar,uxyz,natom(nt),natom_super_cell,ntype
+ real latt_const,om,a,b,c,lattice_parameter,rs1(3),rs2(3),rs3(3),volume_r,pos(3)
+ logical exst
+
+ uposcar =10
+ uxyz=20
+ write(*,*)'Input the filename having the POSCAR format '
+ read(*,*)poscar 
+ inquire(file=poscar,exist=exst)
+ if(exst) then
+      open (uposcar,file=poscar,status='old')
+ else
+      write(*   ,*)' poscar file ',poscar,' does not exist; check your files location and run again'
+      stop
+ endif
+ open(uxyz, file='pos.xyz')
+ name=(/'Si','O ','Ge','Al','Fe','Ni','Zn','Mg','Ti'/)
+
+ read(uposcar,'(a)') line
+ write(*,*)' job title on line 1 of POSCAR is:'//line
+ read(uposcar,*)lattice_parameter
+ read(uposcar,*)rs1
+ read(uposcar,*)rs2
+ read(uposcar,*)rs3
+ if (lattice_parameter .lt.0) then  ! it is the -volume of the cell
+    volume_r = -lattice_parameter  ! need to find the volume(r1,r2,r3) for scaling
+    call calculate_volume(rs1,rs2,rs3,om)
+    latt_const = (volume_r/om)**(1./3.)
+ else
+    latt_const = lattice_parameter
+ endif
+ rs1=latt_const*rs1; rs2=latt_const*rs2; rs3=latt_const*rs3
+ call calculate_volume(rs1,rs2,rs3,volume_r)
+ write(*,*)' Volume of supercell ',volume_r
+
+ natom=0
+ read(uposcar,'(a)') line
+ call read_numbers(line,natom,ntype)
+ write(*,*)'reading ',ntype,' atom types'
+ write(*,*)' number of atoms of each type=',natom(1:ntype)
+ natom_super_cell = sum(natom)
+ write(*,*)' total number of atoms in the file=',natom_super_cell
+ write(uxyz,*)natom_super_cell
+ write(uxyz,*)' cartesian coordinates of poscar generated by poscar2xyz are below'
+ write(*,*) "translation vectors of the cell are"
+ write(*,4) rs1
+ write(*,4) rs2
+ write(*,4) rs3
+
+! read equilibrium positions from POSCAR file and write in logfile ------------
+ read(uposcar,*) line
+ if (line(1:1).eq.'s' .or. line(1:1).eq.'S' ) then  ! this for selective dynamics
+    read(uposcar,*) line
+ endif
+ if (line(1:1).eq.'d' .or. line(1:1).eq.'D' ) then
+    do j=1,ntype
+    do i=1,natom(j) 
+       read(uposcar,*) a,b,c
+       pos = a*rs1+b*rs2+c*rs3
+       write(uxyz,2)name(j),pos
+    enddo
+    enddo
+ elseif (line(1:1).eq.'c' .or. line(1:1).eq.'C' ) then
+    do j=1,ntype
+    do i=1,natom(j) 
+       read(uposcar,*) pos
+       pos = latt_const*pos  
+       write(uxyz,2)name(j),pos
+    enddo
+    enddo
+ else
+    write(*,*)'POSCAR: positions are not in direct or cartesian coordinates'
+    stop
+ endif
+ close(uposcar)
+ close(uxyz)
+ write(*,*)' POSCAR read successfully and closed'
+
+
+2 format(a,9(2x,f19.9))
+4 format(9(2x,f19.9))
+6 format(2x,i5,1x,a2,2x,i5,9(2x,f19.10))
+
+ end program poscar2xyz
+!-----------------------------------------
+  subroutine calculate_volume(r1,r2,r3,om)
+  implicit none
+  real, intent(out) :: om
+  real, intent(in) :: r1(3),r2(3),r3(3)
+  real cross12(3)
+
+  call cross(r1,r2,cross12)
+  om = abs(dot_product(r3,cross12))  !r3 .dot. cross12)
+
+  end subroutine calculate_volume
+!-----------------------------------
+  subroutine cross(v,w,cr)
+     real, intent(in) :: v(3),w(3)
+     real, intent(out) :: cr(3)
+
+     cr(1) = v(2)*w(3)-v(3)*w(2)
+     cr(2) = v(3)*w(1)-v(1)*w(3)
+     cr(3) = v(1)*w(2)-v(2)*w(1)
+  end subroutine cross
+!-----------------------------------
+ subroutine read_numbers(line,natom,n)
+ implicit none
+ integer, intent(inout) :: n
+ integer, intent(inout):: natom(9)
+ character, intent(in) :: line*(*)
+ integer iostat
+
+  n = 0
+
+  do while(n.lt.9)
+    n = n + 1
+    read(line,*,iostat=iostat) natom(1:n) 
+ write(*,*)'n,natom(n)=',n,natom(1:n),iostat
+    if (iostat /= 0) exit
+  end do
+
+ end subroutine read_numbers