! This file is part of mctc-lib.
!
! Licensed under the Apache License, Version 2.0 (the "License");
! you may not use this file except in compliance with the License.
! You may obtain a copy of the License at
!
!     http://www.apache.org/licenses/LICENSE-2.0
!
! Unless required by applicable law or agreed to in writing, software
! distributed under the License is distributed on an "AS IS" BASIS,
! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
! See the License for the specific language governing permissions and
! limitations under the License.

module mctc_io_write_vasp
   use mctc_env_accuracy, only : wp
   use mctc_io_convert, only : autoaa
   use mctc_io_math, only : matinv_3x3
   use mctc_io_structure, only : structure_type
   implicit none
   private

   public :: write_vasp


contains


subroutine write_vasp(self, unit, comment_line)
   class(structure_type), intent(in) :: self
   integer, intent(in) :: unit
   character(len=*), intent(in), optional :: comment_line
   integer :: i, j, izp
   integer, allocatable :: kinds(:), species(:)
   real(wp), allocatable :: inv_lat(:, :)
   real(wp), allocatable :: abc(:, :)

   allocate(species(self%nat))
   allocate(kinds(self%nat), source=1)

   j = 0
   izp = 0
   do i = 1, self%nat
      if (izp.eq.self%id(i)) then
         kinds(j) = kinds(j)+1
      else
         j = j+1
         izp = self%id(i)
         species(j) = self%id(i)
      end if
   end do

   ! use vasp 5.x format
   if (present(comment_line)) then
      write(unit, '(a)') comment_line
   else
      if (allocated(self%comment)) then
         write(unit, '(a)') self%comment
      else
         write(unit, '(a)')
      end if
   end if

   ! scaling factor for lattice parameters is always one
   write(unit, '(f20.14)') self%info%scale
   ! write the lattice parameters
   if (any(self%periodic)) then
      if (size(self%lattice, 2) == 3) then
         write(unit, '(3f20.14)') self%lattice
      else
         write(unit, '(3f20.14)') spread(0.0_wp, 1, 9)
      end if
   else
      write(unit, '(3f20.14)') spread(0.0_wp, 1, 9)
   end if

   do i = 1, j
      write(unit, '(1x, a)', advance='no') self%sym(species(i))
   end do
   write(unit, '(a)')

   ! write the count of the consecutive atom types
   do i = 1, j
      write(unit, '(1x, i0)', advance='no') kinds(i)
   end do
   write(unit, '(a)')
   deallocate(kinds, species)

   if (self%info%selective) write(unit, '("Selective")')

   ! we write cartesian coordinates
   if (any(shape(self%lattice) /= [3, 3]) .or. self%info%cartesian) then
      write(unit, '("Cartesian")')

      ! now write the cartesian coordinates
      do i = 1, self%nat
         write(unit, '(3f20.14)') self%xyz(:, i)*autoaa/self%info%scale
      end do
   else
      write(unit, '("Direct")')
      inv_lat = matinv_3x3(self%lattice)
      abc = matmul(inv_lat, self%xyz)

      ! now write the fractional coordinates
      do i = 1, self%nat
         write(unit, '(3f20.14)') abc(:, i)
      end do
   end if

end subroutine write_vasp


end module mctc_io_write_vasp
