write_chkpt Subroutine

public subroutine write_chkpt(common_data, label, istdout, istderr, ierr)

Uses

  • proc~~write_chkpt~~UsesGraph proc~write_chkpt write_chkpt module~w90_comms w90_comms proc~write_chkpt->module~w90_comms module~w90_error w90_error proc~write_chkpt->module~w90_error module~w90_error_base w90_error_base proc~write_chkpt->module~w90_error_base module~w90_wannier90_readwrite w90_wannier90_readwrite proc~write_chkpt->module~w90_wannier90_readwrite module~w90_comms->module~w90_error_base module~w90_constants w90_constants module~w90_comms->module~w90_constants module~w90_error->module~w90_comms module~w90_error->module~w90_error_base module~w90_wannier90_readwrite->module~w90_error module~w90_wannier90_readwrite->module~w90_constants module~w90_readwrite w90_readwrite module~w90_wannier90_readwrite->module~w90_readwrite module~w90_types w90_types module~w90_wannier90_readwrite->module~w90_types module~w90_wannier90_types w90_wannier90_types module~w90_wannier90_readwrite->module~w90_wannier90_types module~w90_readwrite->module~w90_comms module~w90_readwrite->module~w90_constants module~w90_readwrite->module~w90_types module~w90_types->module~w90_constants module~w90_wannier90_types->module~w90_constants

Arguments

Type IntentOptional Attributes Name
type(lib_common_type), intent(in), target :: common_data
character(len=*), intent(in) :: label
integer, intent(in) :: istdout
integer, intent(in) :: istderr
integer, intent(inout) :: ierr

Calls

proc~~write_chkpt~~CallsGraph proc~write_chkpt write_chkpt interface~comms_reduce comms_reduce proc~write_chkpt->interface~comms_reduce proc~mpirank mpirank proc~write_chkpt->proc~mpirank proc~prterr prterr proc~write_chkpt->proc~prterr proc~set_error_alloc set_error_alloc proc~write_chkpt->proc~set_error_alloc proc~set_error_dealloc set_error_dealloc proc~write_chkpt->proc~set_error_dealloc proc~set_error_fatal set_error_fatal proc~write_chkpt->proc~set_error_fatal proc~w90_wannier90_readwrite_write_chkpt w90_wannier90_readwrite_write_chkpt proc~write_chkpt->proc~w90_wannier90_readwrite_write_chkpt proc~comms_reduce_cmplx comms_reduce_cmplx interface~comms_reduce->proc~comms_reduce_cmplx proc~comms_reduce_int comms_reduce_int interface~comms_reduce->proc~comms_reduce_int proc~comms_reduce_real comms_reduce_real interface~comms_reduce->proc~comms_reduce_real proc~prterr->proc~mpirank interface~comms_no_sync_bcast comms_no_sync_bcast proc~prterr->interface~comms_no_sync_bcast interface~comms_no_sync_recv comms_no_sync_recv proc~prterr->interface~comms_no_sync_recv interface~comms_no_sync_send comms_no_sync_send proc~prterr->interface~comms_no_sync_send proc~mpisize mpisize proc~prterr->proc~mpisize proc~comms_sync_error comms_sync_error proc~set_error_alloc->proc~comms_sync_error proc~set_base_error set_base_error proc~set_error_alloc->proc~set_base_error proc~set_error_dealloc->proc~comms_sync_error proc~set_error_dealloc->proc~set_base_error proc~set_error_fatal->proc~comms_sync_error proc~set_error_fatal->proc~set_base_error proc~io_date io_date proc~w90_wannier90_readwrite_write_chkpt->proc~io_date proc~utility_recip_lattice_base utility_recip_lattice_base proc~w90_wannier90_readwrite_write_chkpt->proc~utility_recip_lattice_base proc~comms_no_sync_bcast_char comms_no_sync_bcast_char interface~comms_no_sync_bcast->proc~comms_no_sync_bcast_char proc~comms_no_sync_bcast_cmplx comms_no_sync_bcast_cmplx interface~comms_no_sync_bcast->proc~comms_no_sync_bcast_cmplx proc~comms_no_sync_bcast_int comms_no_sync_bcast_int interface~comms_no_sync_bcast->proc~comms_no_sync_bcast_int proc~comms_no_sync_bcast_logical comms_no_sync_bcast_logical interface~comms_no_sync_bcast->proc~comms_no_sync_bcast_logical proc~comms_no_sync_bcast_real comms_no_sync_bcast_real interface~comms_no_sync_bcast->proc~comms_no_sync_bcast_real proc~comms_no_sync_recv_char comms_no_sync_recv_char interface~comms_no_sync_recv->proc~comms_no_sync_recv_char proc~comms_no_sync_recv_cmplx comms_no_sync_recv_cmplx interface~comms_no_sync_recv->proc~comms_no_sync_recv_cmplx proc~comms_no_sync_recv_int comms_no_sync_recv_int interface~comms_no_sync_recv->proc~comms_no_sync_recv_int proc~comms_no_sync_recv_logical comms_no_sync_recv_logical interface~comms_no_sync_recv->proc~comms_no_sync_recv_logical proc~comms_no_sync_recv_real comms_no_sync_recv_real interface~comms_no_sync_recv->proc~comms_no_sync_recv_real proc~comms_no_sync_send_char comms_no_sync_send_char interface~comms_no_sync_send->proc~comms_no_sync_send_char proc~comms_no_sync_send_cmplx comms_no_sync_send_cmplx interface~comms_no_sync_send->proc~comms_no_sync_send_cmplx proc~comms_no_sync_send_int comms_no_sync_send_int interface~comms_no_sync_send->proc~comms_no_sync_send_int proc~comms_no_sync_send_logical comms_no_sync_send_logical interface~comms_no_sync_send->proc~comms_no_sync_send_logical proc~comms_no_sync_send_real comms_no_sync_send_real interface~comms_no_sync_send->proc~comms_no_sync_send_real proc~comms_reduce_cmplx->proc~comms_sync_error proc~comms_no_sync_reduce_cmplx comms_no_sync_reduce_cmplx proc~comms_reduce_cmplx->proc~comms_no_sync_reduce_cmplx proc~comms_reduce_int->proc~comms_sync_error proc~comms_no_sync_reduce_int comms_no_sync_reduce_int proc~comms_reduce_int->proc~comms_no_sync_reduce_int proc~comms_reduce_real->proc~comms_sync_error proc~comms_no_sync_reduce_real comms_no_sync_reduce_real proc~comms_reduce_real->proc~comms_no_sync_reduce_real proc~utility_inv3 utility_inv3 proc~utility_recip_lattice_base->proc~utility_inv3

Called by

proc~~write_chkpt~~CalledByGraph proc~write_chkpt write_chkpt program~wannier wannier program~wannier->proc~write_chkpt

Source Code

  subroutine write_chkpt(common_data, label, istdout, istderr, ierr)
    use w90_comms, only: comms_reduce, mpirank
    use w90_error_base, only: w90_error_type
    use w90_error, only: set_error_alloc, set_error_dealloc, set_error_fatal
    use w90_wannier90_readwrite, only: w90_wannier90_readwrite_write_chkpt

    implicit none

    ! arguments
    character(len=*), intent(in) :: label ! e.g. 'postdis' or 'postwann' after disentanglement, wannierisation
    integer, intent(in) :: istdout, istderr
    integer, intent(inout) :: ierr
    type(lib_common_type), target, intent(in) :: common_data

    ! local variables
    complex(kind=dp), allocatable :: m(:, :, :, :)
    integer, allocatable :: global_k(:)
    integer, pointer :: nw, nb, nk, nn
    integer :: rank, nkrank, ikg, ikl, istat
    type(w90_error_type), allocatable :: error

    ierr = 0
    rank = mpirank(common_data%comm)
    nkrank = count(common_data%dist_kpoints == rank)

    nb => common_data%num_bands
    nk => common_data%num_kpts
    nn => common_data%kmesh_info%nntot
    nw => common_data%num_wann

    if (.not. associated(common_data%u_matrix_opt)) then
      call set_error_fatal(error, &
                           'Error: u_matrix_opt not associated for write_chkpt call', common_data%comm)
    else if (.not. associated(common_data%u_matrix)) then
      call set_error_fatal(error, &
                           'Error: u_matrix not associated for write_chkpt call', common_data%comm)
    else if (.not. associated(common_data%m_matrix_local)) then
      call set_error_fatal(error, &
                           'Error: m_matrix_local not set for write_chkpt call', common_data%comm)
    end if
    if (allocated(error)) then
      call prterr(error, ierr, istdout, istderr, common_data%comm)
      return
    end if

    allocate (global_k(nkrank), stat=istat)
    if (istat /= 0) then
      call set_error_alloc(error, 'Error allocating global_k in write_chkpt', common_data%comm)
      call prterr(error, ierr, istdout, istderr, common_data%comm)
      return
    end if

    global_k = huge(1)
    ikl = 1
    do ikg = 1, nk
      if (rank == common_data%dist_kpoints(ikg)) then
        global_k(ikl) = ikg
        ikl = ikl + 1
      end if
    end do

    ! reassemble full m matrix by MPI reduction
    !
    ! allocating and partially assigning the full matrix on all ranks and reducing is a terrible idea
    ! alternatively, allocate on root and use point-to-point
    ! or, if required only for checkpoint file writing, then use mpi-io (but needs to be ordered io, alas)
    ! or, even better, use parallel hdf5. JJ Nov 22
    allocate (m(nw, nw, nn, nk), stat=istat) ! all kpts
    if (istat /= 0) call set_error_alloc(error, 'Error allocating m in write_chkpt', common_data%comm)
    if (allocated(error)) then
      call prterr(error, ierr, istdout, istderr, common_data%comm)
      return
    end if
    m(:, :, :, :) = 0.d0
    do ikl = 1, nkrank
      ikg = global_k(ikl)
      m(:, :, :, ikg) = common_data%m_matrix_local(1:nw, 1:nw, :, ikl)
    end do
    call comms_reduce(m(1, 1, 1, 1), nw*nw*nn*nk, 'SUM', error, common_data%comm)
    if (allocated(error)) then
      call prterr(error, ierr, istdout, istderr, common_data%comm)
      return
    end if

    if (rank == 0) then
      call w90_wannier90_readwrite_write_chkpt(label, common_data%exclude_bands, &
                                               common_data%wannier_data, common_data%kmesh_info, &
                                               common_data%kpt_latt, nk, common_data%dis_manifold, &
                                               nb, nw, common_data%u_matrix, &
                                               common_data%u_matrix_opt, m, common_data%mp_grid, &
                                               common_data%real_lattice, &
                                               common_data%omega%invariant, &
                                               common_data%have_disentangled, &
                                               common_data%print_output%iprint, istdout, &
                                               common_data%seedname)
    end if

    deallocate (m, stat=istat)
    if (istat /= 0) then
      call set_error_dealloc(error, 'Error deallocating m in write_chkpt', common_data%comm)
      call prterr(error, ierr, istdout, istderr, common_data%comm)
      return
    end if
  end subroutine write_chkpt