Read formatted checkpoint file
| Type | Intent | Optional | Attributes | Name | ||
|---|---|---|---|---|---|---|
| character(len=20), | intent(out) | :: | checkpoint | |||
| integer, | intent(in) | :: | stdout | |||
| character(len=50), | intent(in) | :: | seedname |
subroutine conv_read_chkpt(checkpoint, stdout, seedname) !================================================! ! !! Read formatted checkpoint file ! !================================================! use w90_constants, only: eps6 use w90chk_parameters use wannchk_data implicit none integer, intent(in) :: stdout character(len=50), intent(in) :: seedname character(len=20), intent(out) :: checkpoint integer :: chk_unit, i, j, k, l, nkp, ierr write (stdout, '(1x,3a)') 'Reading information from file ', trim(seedname), '.chk :' open (newunit=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', stdout) end if allocate (exclude_bands(num_exclude_bands), stat=ierr) if (ierr /= 0) call io_error('Error allocating exclude_bands in conv_read_chkpt', stdout) 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', stdout) end if read (chk_unit) ((kpt_latt(i, nkp), i=1, 3), nkp=1, num_kpts) write (stdout, '(a)') "kpt_latt: read." read (chk_unit) kmesh_info%nntot ! nntot write (stdout, '(a,I0)') "nntot:", kmesh_info%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(dis_manifold%lwindow)) then allocate (dis_manifold%lwindow(num_bands, num_kpts), stat=ierr) if (ierr /= 0) call io_error('Error allocating lwindow in conv_read_chkpt', stdout) end if read (chk_unit, err=122) ((dis_manifold%lwindow(i, nkp), i=1, num_bands), nkp=1, num_kpts) write (stdout, '(a)') "lwindow: read." ! nfirstwin ! this info is not presently codified in the ckpt file (although it belongs with ndimwin) ! -JJ !if (.not. allocated(dis_manifold%nfirstwin)) then ! allocate (dis_manifold%nfirstwin(num_kpts), stat=ierr) ! if (ierr /= 0) call io_error('Error allocating nfirstwin in conv_read_chkpt', stdout) !endif !read (chk_unit, err=123) (dis_manifold%nfirstwin(nkp), nkp=1, num_kpts) !write (stdout, '(a)') "nfirstwin: read." ! ndimwin if (.not. allocated(dis_manifold%ndimwin)) then allocate (dis_manifold%ndimwin(num_kpts), stat=ierr) if (ierr /= 0) call io_error('Error allocating ndimwin in conv_read_chkpt', stdout) end if read (chk_unit, err=123) (dis_manifold%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', stdout) end if 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" end if ! 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', stdout) end if 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, kmesh_info%nntot, num_kpts), stat=ierr) if (ierr /= 0) call io_error('Error allocating m_matrix in conv_read_chkpt', stdout) end if read (chk_unit, err=126) ((((m_matrix(i, j, k, l), i=1, num_wann), j=1, num_wann), k=1, kmesh_info%nntot), l=1, num_kpts) write (stdout, '(a)') "M_matrix: read." ! wannier_centres if (.not. allocated(wannier_data%centres)) then allocate (wannier_data%centres(3, num_wann), stat=ierr) if (ierr /= 0) call io_error('Error allocating wannier_centres in conv_read_chkpt', stdout) end if read (chk_unit, err=127) ((wannier_data%centres(i, j), i=1, 3), j=1, num_wann) write (stdout, '(a)') "wannier_centres: read." ! wannier spreads if (.not. allocated(wannier_data%spreads)) then allocate (wannier_data%spreads(num_wann), stat=ierr) if (ierr /= 0) call io_error('Error allocating wannier_centres in conv_read_chkpt', stdout) end if read (chk_unit, err=128) (wannier_data%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', stdout) 122 call io_error('Error reading lwindow from '//trim(seedname)//'.chk in conv_read_chkpt', stdout) 123 call io_error('Error reading ndimwin from '//trim(seedname)//'.chk in conv_read_chkpt', stdout) 124 call io_error('Error reading u_matrix_opt from '//trim(seedname)//'.chk in conv_read_chkpt', stdout) 125 call io_error('Error reading u_matrix from '//trim(seedname)//'.chk in conv_read_chkpt', stdout) 126 call io_error('Error reading m_matrix from '//trim(seedname)//'.chk in conv_read_chkpt', stdout) 127 call io_error('Error reading wannier_centres from '//trim(seedname)//'.chk in conv_read_chkpt', stdout) 128 call io_error('Error reading wannier_spreads from '//trim(seedname)//'.chk in conv_read_chkpt', stdout) end subroutine conv_read_chkpt