!!! 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