Read formatted checkpoint file
subroutine conv_read_chkpt()
!=======================================!
!! Read formatted checkpoint file
!=======================================!
use w90_constants, only: eps6
use w90_io, only: io_error, io_file_unit, stdout, seedname
use w90_parameters
implicit none
integer :: chk_unit, i, j, k, l, nkp, ierr
write (stdout, '(1x,3a)') 'Reading information from file ', trim(seedname), '.chk :'
chk_unit = io_file_unit()
open (unit=chk_unit, file=trim(seedname)//'.chk', status='old', form='unformatted', err=121)
! Read comment line
read (chk_unit) header
write (stdout, '(1x,a)') trim(header)
! Consistency checks
read (chk_unit) num_bands ! Number of bands
write (stdout, '(a,i0)') "Number of bands: ", num_bands
read (chk_unit) num_exclude_bands ! Number of excluded bands
if (num_exclude_bands < 0) then
call io_error('Invalid value for num_exclude_bands')
endif
allocate (exclude_bands(num_exclude_bands), stat=ierr)
if (ierr /= 0) call io_error('Error allocating exclude_bands in conv_read_chkpt')
read (chk_unit) (exclude_bands(i), i=1, num_exclude_bands) ! Excluded bands
write (stdout, '(a)', advance='no') "Excluded bands: "
if (num_exclude_bands == 0) then
write (stdout, '(a)') "none."
else
do i = 1, num_exclude_bands - 1
write (stdout, '(I0,a)', advance='no') exclude_bands(i), ','
end do
write (stdout, '(I0,a)') exclude_bands(num_exclude_bands), '.'
end if
read (chk_unit) ((real_lattice(i, j), i=1, 3), j=1, 3) ! Real lattice
write (stdout, '(a)') "Real lattice: read."
read (chk_unit) ((recip_lattice(i, j), i=1, 3), j=1, 3) ! Reciprocal lattice
write (stdout, '(a)') "Reciprocal lattice: read."
read (chk_unit) num_kpts ! K-points
write (stdout, '(a,I0)') "Num kpts:", num_kpts
read (chk_unit) (mp_grid(i), i=1, 3) ! M-P grid
write (stdout, '(a)') "mp_grid: read."
if (.not. allocated(kpt_latt)) then
allocate (kpt_latt(3, num_kpts), stat=ierr)
if (ierr /= 0) call io_error('Error allocating kpt_latt in conv_read_chkpt')
endif
read (chk_unit) ((kpt_latt(i, nkp), i=1, 3), nkp=1, num_kpts)
write (stdout, '(a)') "kpt_latt: read."
read (chk_unit) nntot ! nntot
write (stdout, '(a,I0)') "nntot:", nntot
read (chk_unit) num_wann ! num_wann
write (stdout, '(a,I0)') "num_wann:", num_wann
read (chk_unit) checkpoint ! checkpoint
checkpoint = adjustl(trim(checkpoint))
write (stdout, '(a,I0)') "checkpoint: "//trim(checkpoint)
read (chk_unit) have_disentangled ! whether a disentanglement has been performed
if (have_disentangled) then
write (stdout, '(a)') "have_disentangled: TRUE"
read (chk_unit) omega_invariant ! omega invariant
write (stdout, '(a)') "omega_invariant: read."
! lwindow
if (.not. allocated(lwindow)) then
allocate (lwindow(num_bands, num_kpts), stat=ierr)
if (ierr /= 0) call io_error('Error allocating lwindow in conv_read_chkpt')
endif
read (chk_unit, err=122) ((lwindow(i, nkp), i=1, num_bands), nkp=1, num_kpts)
write (stdout, '(a)') "lwindow: read."
! ndimwin
if (.not. allocated(ndimwin)) then
allocate (ndimwin(num_kpts), stat=ierr)
if (ierr /= 0) call io_error('Error allocating ndimwin in conv_read_chkpt')
endif
read (chk_unit, err=123) (ndimwin(nkp), nkp=1, num_kpts)
write (stdout, '(a)') "ndimwin: read."
! U_matrix_opt
if (.not. allocated(u_matrix_opt)) then
allocate (u_matrix_opt(num_bands, num_wann, num_kpts), stat=ierr)
if (ierr /= 0) call io_error('Error allocating u_matrix_opt in conv_read_chkpt')
endif
read (chk_unit, err=124) (((u_matrix_opt(i, j, nkp), i=1, num_bands), j=1, num_wann), nkp=1, num_kpts)
write (stdout, '(a)') "U_matrix_opt: read."
else
write (stdout, '(a)') "have_disentangled: FALSE"
endif
! U_matrix
if (.not. allocated(u_matrix)) then
allocate (u_matrix(num_wann, num_wann, num_kpts), stat=ierr)
if (ierr /= 0) call io_error('Error allocating u_matrix in conv_read_chkpt')
endif
read (chk_unit, err=125) (((u_matrix(i, j, k), i=1, num_wann), j=1, num_wann), k=1, num_kpts)
write (stdout, '(a)') "U_matrix: read."
! M_matrix
if (.not. allocated(m_matrix)) then
allocate (m_matrix(num_wann, num_wann, nntot, num_kpts), stat=ierr)
if (ierr /= 0) call io_error('Error allocating m_matrix in conv_read_chkpt')
endif
read (chk_unit, err=126) ((((m_matrix(i, j, k, l), i=1, num_wann), j=1, num_wann), k=1, nntot), l=1, num_kpts)
write (stdout, '(a)') "M_matrix: read."
! wannier_centres
if (.not. allocated(wannier_centres)) then
allocate (wannier_centres(3, num_wann), stat=ierr)
if (ierr /= 0) call io_error('Error allocating wannier_centres in conv_read_chkpt')
end if
read (chk_unit, err=127) ((wannier_centres(i, j), i=1, 3), j=1, num_wann)
write (stdout, '(a)') "wannier_centres: read."
! wannier spreads
if (.not. allocated(wannier_spreads)) then
allocate (wannier_spreads(num_wann), stat=ierr)
if (ierr /= 0) call io_error('Error allocating wannier_centres in conv_read_chkpt')
end if
read (chk_unit, err=128) (wannier_spreads(i), i=1, num_wann)
write (stdout, '(a)') "wannier_spreads: read."
close (chk_unit)
write (stdout, '(a/)') ' ... done'
return
121 call io_error('Error opening '//trim(seedname)//'.chk in conv_read_chkpt')
122 call io_error('Error reading lwindow from '//trim(seedname)//'.chk in conv_read_chkpt')
123 call io_error('Error reading ndimwin from '//trim(seedname)//'.chk in conv_read_chkpt')
124 call io_error('Error reading u_matrix_opt from '//trim(seedname)//'.chk in conv_read_chkpt')
125 call io_error('Error reading u_matrix from '//trim(seedname)//'.chk in conv_read_chkpt')
126 call io_error('Error reading m_matrix from '//trim(seedname)//'.chk in conv_read_chkpt')
127 call io_error('Error reading wannier_centres from '//trim(seedname)//'.chk in conv_read_chkpt')
128 call io_error('Error reading wannier_spreads from '//trim(seedname)//'.chk in conv_read_chkpt')
end subroutine conv_read_chkpt