!!! wien2wannier/SRC_trig/join_vectorfiles.f
!!!
!!!    Joins multiple WIEN2K vector files to one for further processing
!!!
!!!    Usage: x join_vectorfiles [-up/-dn] [-so]
!!!
!!! Copyright 2010-2012 Philipp Wissgott
!!!           2013-2016 Elias Assmann

program join_vectorfiles
  use const,     only: R8, C16, BUFSZ
  use structmod, only: struct_t, struct_read
  use util,      only: paropen
  use clio,      only: argstr, fetcharg, croak
  use kpoints,   only: count_kmesh_klist

  implicit none

  integer, parameter :: unit_def=1
  integer, parameter :: unit_struct=20, unit_vector=10, unit_vector2=11
  integer, parameter :: unit_klist = 4, unit_energy=50, unit_energy2=51
  integer, parameter :: unit_energydum=60, unit_energydum2=61
  integer, parameter :: lmax=13, lomax=3

  character(*), parameter :: fmt_header1 = '(100(f9.5))'
  character(*), parameter :: fmt_header2 = '(100(f12.5))'
  character(*), parameter :: fmt_kpt    = '(3e19.12,a10,2i6,f5.1,a3)'

  integer          :: iproc=0
  character(BUFSZ) :: vecfn='', enefn='', enedumfn=''
  logical          :: complex=.false., do_vector=.false.

  real(R8),     allocatable :: E(:), ELO(:,:)
  integer,      allocatable :: KZZ(:,:)
  real(R8),     allocatable :: Z  (:)
  complex(C16), allocatable :: ZC (:)

  integer        :: nkpoints, NE, NV, nloat
  integer        :: jatom,i,j,jj,jk
  real(R8)       :: SX, SY, SZ, weight, eorb_ind, eigval
  CHARACTER(3)   :: IPGR
  CHARACTER(10)  :: KNAME
  type(struct_t) :: stru

  type(argstr)     :: defname, cmplxarg
  character(BUFSZ) :: fname
  character(11)    :: status, form
  integer          :: iunit

  call fetcharg(1, defname)
  if (command_argument_count() > 1) then
     call fetcharg(2, iproc)
  end if
  if (command_argument_count() > 2) then
     call fetcharg(3, cmplxarg)
     if (cmplxarg%s == '-c') then
        complex = .true.
     else
        call croak("join_vectorfiles: illegal argument: " // trim(cmplxarg%s))
     end if
  end if

  open(unit_def, FILE=defname%s, STATUS='OLD')
  def: do
     read(unit_def,*,END=8001) iunit, fname, status, form

     select case (iunit)
     case (unit_vector)
        vecfn = fname
        do_vector = .true.
     case (unit_energy)
        enefn = fname
     case (unit_energydum)
        enedumfn = fname
     case default
        open(iunit, FILE=fname, STATUS=status, FORM=form)
     end select
  end do def

8001 close(unit_def)

 call struct_read(unit_struct, stru)
 close(unit_struct)

 nkpoints = count_kmesh_klist(unit_klist)
 close(unit_klist)
 
 call find_nloat(nloat)

 allocate( E  (LMAX) )
 allocate( ELO(0:LOMAX,nloat) )

 files_ene: do j=1,iproc
    call paropen(unit_energy, enefn, iproc, j, FORM='formatted')

   atoms_ene: do jatom= 1,stru%nneq
       if (nloat.gt.3) then
         read(unit_energy, fmt_header2) E, eorb_ind
         read(unit_energy, fmt_header2) ELO
       else
         read(unit_energy, fmt_header1) E, eorb_ind
         read(unit_energy, fmt_header1) ELO
       endif
       if (j.eq.1) then
          if (nloat.gt.3) then
            write(unit_energy2, fmt_header2) E, eorb_ind
            write(unit_energy2, fmt_header2) ELO
          else
            write(unit_energy2, fmt_header1) E, eorb_ind
            write(unit_energy2, fmt_header1) ELO
          endif
       endif
    enddo atoms_ene

    k_points_ene: do
       read (unit_energy,  fmt_kpt, end=101) &
            SX, SY, SZ, KNAME, NV, NE, WEIGHT, IPGR
       write(unit_energy2, fmt_kpt) &
            SX, SY, SZ, KNAME, NV, NE, WEIGHT, IPGR

       eig_ene: do jj = 1, NE
          read (unit_energy, *) I, EIGVAL
          write(unit_energy2,*) I, EIGVAL
       end do eig_ene
    end do k_points_ene
101 close(unit_energy)
 end do files_ene

 files_enedum: do j=1,iproc
    call paropen(unit_energydum, enedumfn, iproc, j, FORM='formatted')

   atoms_enedum: do jatom= 1,stru%nneq
       if (nloat.gt.3) then
         read(unit_energydum, fmt_header2, end=102) E, eorb_ind
         read(unit_energydum, fmt_header2, end=102) ELO
       else
         read(unit_energydum, fmt_header1, end=102) E, eorb_ind
         read(unit_energydum, fmt_header1, end=102) ELO
       endif
       if (j.eq.1) then
          if (nloat.gt.3) then
            write(unit_energydum2, fmt_header2) E, eorb_ind
            write(unit_energydum2, fmt_header2) ELO
          else
            write(unit_energydum2, fmt_header1) E, eorb_ind
            write(unit_energydum2, fmt_header1) ELO
          endif
       endif
    enddo atoms_enedum

    k_points_enedum: do
       read (unit_energydum,  fmt_kpt, end=102) &
            SX, SY, SZ, KNAME, NV, NE, WEIGHT, IPGR
       write(unit_energydum2, fmt_kpt) &
            SX, SY, SZ, KNAME, NV, NE, WEIGHT, IPGR

       eig_enedum: do jj = 1, NE
          read (unit_energydum, *) I, EIGVAL
          write(unit_energydum2,*) I, EIGVAL
       end do eig_enedum
    end do k_points_enedum
102 close(unit_energydum)
 end do files_enedum

 do_vec: if (do_vector) then
    files_vec: do j=1,iproc
       call paropen(unit_vector, vecfn, iproc, j, FORM='unformatted')

       atoms_vec: do jatom= 1,stru%nneq
          read(unit_vector) E
          read(unit_vector) ELO

          if (j.eq.1) then
             write(unit_vector2) E
             write(unit_vector2) ELO
          endif
       end do atoms_vec

       k_points_vec: do
          read (unit_vector, end=103)  SX, SY, SZ, KNAME, NV, NE, WEIGHT
          write(unit_vector2)          SX, SY, SZ, KNAME, NV, NE, WEIGHT

          allocate( KZZ(3,NV) )

          if (complex) then
             allocate(ZC(NV))
          else
             allocate(Z (NV))
          end if

          read (unit_vector)  KZZ
          write(unit_vector2) KZZ

          do jj = 1, NE
             read (unit_vector)  I, EIGVAL
             write(unit_vector2) I, EIGVAL

             if (complex) then
                read  (unit_vector)  ZC
                write (unit_vector2) ZC
             else
                read (unit_vector)  Z
                write(unit_vector2) Z
             endif
          end do

          deallocate(KZZ)
          if (complex) then
             deallocate(ZC)
          else
             deallocate(Z)
          end if
       end do k_points_vec
103    close(unit_vector)
    end do files_vec
 end if do_vec
end program join_vectorfiles


!!/---
!! Local Variables:
!! mode: f90
!! End:
!!\---
!!
!! Time-stamp: <2016-01-27 16:10:16 assman@faepop36.tu-graz.ac.at>


      subroutine find_nloat(nloat_new)
      nloat_new=0
      read(5,*,ERR=100,END=100)
      read(5,*)
! atom loop
 10   i=0
      l_old=9999
      read(5,*,err=20,end=20) a,nl
      do il=1,nl
        read(5,*) l
        if(l.eq.l_old) then
          i=i+1
        else
          nloat_new=max(nloat_new,i)
          i=1
          l_old=l
        endif
      enddo
      nloat_new=max(nloat_new,i)

      goto 10

 20   continue
      nloat_new=nloat_new+1
      if(nloat_new.lt.3) nloat_new=3
!      print*, 'nloat determined as',nloat_new,myid
      rewind 5
      return
 100  print*, 'case.in1 file cannot be read'
      stop 'case.in1 file cannot be read'
      end
