!
! Copyright (c) 2000-2013,2016,2017 Yoshihide Yoshimoto
! 

program wfn2respack
  implicit none
  integer, parameter:: nfin = 10, nfout = 11
  integer, parameter:: nfoutkg = 12, nfouteig = 13

  character(len=8):: sign
  integer:: ver
  integer:: nks, nw, ng, nnp
  integer:: nkmmax
  integer,allocatable:: nkmary(:), kg(:,:), rg(:,:,:), pg(:,:), srg(:)
  real(kind=8),allocatable:: sk(:,:)
  real(kind=8),allocatable:: pr(:)
  complex(kind=8),allocatable:: p(:,:)
  integer:: nspin, ncomp
  real(kind=8):: bb(3,3), aa(3,3)
  integer:: i, j, ios, ik, ig, ib
  character(len=256):: ifname, argv(4)
  logical:: ifinvsymi
  real(kind=8):: w(2) = (/0.0d0, 0.0d0/), ee(2) = (/0.0d0, 0.0d0/)
  real(kind=8):: ecut, x(3), xsq
  logical:: iffedsym, ifgreysym
  integer:: igh

  call getarg(1, argv(1))
  if (len_trim(argv(1)) .eq. 0) then
     write(6,*) 'invalid fname'
     stop
  end if
  ifname = argv(1)

  open(nfin, file=ifname, status='old', action='read', form='unformatted')
  ifinvsymi = .false.
  read(nfin, iostat=ios) sign, ver
  if (ios.ne.0) then
     write(6,*) 'unknown format'
     stop
  end if
  if (ver.ne.3) then
     write(6,*) 'only version 3 format is supported by this program'
  end if
  if (sign .ne. 'TAPP:wfn') then
     if (sign .ne. 'TAPP:wfi') then
        write(6,*) 'Bad magic'
        stop
     else
        ifinvsymi = .true.
     end if
  end if
  read(nfin) aa, bb
  read(nfin) nspin, nks, nw, ng, nnp, ncomp
  allocate(nkmary(nks), sk(3,nks), rg(3,3,ng), pg(3,ng), srg(ng))
  read(nfin) rg, pg, srg

  !
  ! check if symmetry is a Federov group, namely a pure space group.
  !
  iffedsym = .true.
  do ig=1,ng
     if (srg(ig).ne.1) then
        iffedsym = .false.
     end if
  end do
  
  !
  ! check if symmetry is a grey group automatically generated by
  ! symmetry_format = reciprocal in the xTAPP input.
  !
  ifgreysym = .true.
  if (mod(ng,2).ne.0) then
     ifgreysym = .false.
  else
     do igh=1,ng/2
        if (maxval(abs(rg(:,:,2*igh-1)-rg(:,:,2*igh))).ne.0) then
           ifgreysym = .false.
        end if
        if (maxval(abs(pg(:,2*igh-1)-pg(:,2*igh))).ne.0) then
           ifgreysym = .false.
        end if
        if (srg(2*igh-1).ne.1 .or. srg(2*igh).ne.-1) then
           ifgreysym = .false.
        end if
     end do
  end if
  if (.not. (iffedsym .or. ifgreysym) ) then
     write(6,*) 'The symmetry in the wavefunction file is a magnetic type.'
     write(6,*) 'RESPACK does not support this type.'
     stop 1
  end if
  if (iffedsym .and. ifgreysym) then
     write(6,*) 'Internal error in wfn2respack'
     stop 1
  endif

  read(nfin) (sk(:,ik),ik=1,nks)
  read(nfin) nkmary
  nkmmax = maxval(nkmary)
  allocate(kg(3,nkmmax), pr(nkmmax), p(ncomp,nkmmax))

  open(nfout,file='dat.sample-k')
  write(nfout,*) nks
  do ik=1,nks
     write(nfout,*) (sk(i,ik),i=1,3)
  end do

  close(nfout)
  open(nfout,file='dat.nkm')
  do ik=1,nks
     write(nfout,*) nkmary(ik)
  end do
  close(nfout)

  open(nfout,file='dat.lattice')
  write(nfout,*) aa(1,1),aa(2,1),aa(3,1)
  write(nfout,*) aa(1,2),aa(2,2),aa(3,2)
  write(nfout,*) aa(1,3),aa(2,3),aa(3,3)
  close(nfout)

  open(nfout,file='dat.symmetry')
  if (iffedsym) then
     write(nfout,*) ng
     write(nfout,*) nnp
     do ig=1,ng
        write(nfout,'(9(1x,i4))') ((rg(i,j,ig),i=1,3),j=1,3)
        write(nfout,'(3(1x,i4))') (pg(i,ig),i=1,3)
     end do
  else ! grey group case
     write(nfout,*) ng/2
     write(nfout,*) nnp
     do igh=1,ng/2
        write(nfout,'(9(1x,i4))') ((rg(i,j,2*igh-1),i=1,3),j=1,3)
        write(nfout,'(3(1x,i4))') (pg(i,2*igh-1),i=1,3)
     end do
     
  end if
  close(nfout)

  open(nfoutkg,file='dat.kg')
  open(nfouteig,file='dat.eigenvalue')
  open(nfout,file='dat.wfn',form='unformatted')
  write(nfout) ncomp
  write(nfouteig,*) nw

  ecut = 0.0d0

  do ik=1,nks
     read(nfin) ((kg(i,ig),i=1,3),ig=1,nkmary(ik))
     write(nfoutkg,*) nkmary(ik)
     do ig=1,nkmary(ik)
        write(nfoutkg,*) (kg(i,ig),i=1,3)
     end do
     do ig=1,nkmary(ik)
        x(1) = bb(1,1)*( sk(1,ik) + kg(1,ig) ) &
             + bb(1,2)*( sk(2,ik) + kg(2,ig) ) &
             + bb(1,3)*( sk(3,ik) + kg(3,ig) )
        x(2) = bb(2,1)*( sk(1,ik) + kg(1,ig) ) &
             + bb(2,2)*( sk(2,ik) + kg(2,ig) ) &
             + bb(2,3)*( sk(3,ik) + kg(3,ig) )
        x(3) = bb(3,1)*( sk(1,ik) + kg(1,ig) ) &
             + bb(3,2)*( sk(2,ik) + kg(2,ig) ) &
             + bb(3,3)*( sk(3,ik) + kg(3,ig) )
        xsq = x(1)*x(1)+x(2)*x(2)+x(3)*x(3)
        if (xsq.gt.ecut) ecut = xsq
     end do
     
     do ib=1,nw

        if (ifinvsymi) then
           read(nfin) (pr(i),i=1,nkmary(ik)), w(1), ee(1)
           write(nfout) (dcmplx(pr(i),0.0d0),i=1,nkmary(ik))
        else
           read(nfin) ((p(i,j),i=1,ncomp),j=1,nkmary(ik)), w(1), ee(1)
           !
           ! xTAPP uses (sigma, G) order
           ! RESPACK uses (G, sigma) order
           !
           write(nfout) ((p(i,j),j=1,nkmary(ik)),i=1,ncomp)
        end if
        write(nfouteig,*) ee(1)

     end do
     !
     ! advance to the next k-point
     !
     if (nspin .eq. 2) then
        do ib=1,nw
           if (ifinvsymi) then
              read(nfin)
           else
              read(nfin)
           end if
        end do
     end if
  end do
  close(nfoutkg)
  close(nfouteig)
  close(nfout)
  open(nfout,file='dat.bandcalc')
  write(nfout,*) ecut + 16*spacing(ecut)
  close(nfout)

end program wfn2respack
