diff --git a/src/disentangle.F90 b/src/disentangle.F90 index f5cacef5d..b6704ec3b 100644 --- a/src/disentangle.F90 +++ b/src/disentangle.F90 @@ -288,9 +288,9 @@ subroutine setup_m_loc(kmesh_info, print_output, m_matrix_local, m_matrix_orig_l integer, intent(in) :: optimisation integer, intent(in) :: dist_k(:) - complex(kind=dp), intent(in) :: u_matrix(:, :, :) ! (num_wann, num_wann, num_kpts) - complex(kind=dp), intent(in) :: m_matrix_orig_local(:, :, :, :) ! (num_bands, num_bands, nntot, num_kpts) - complex(kind=dp), intent(inout) :: m_matrix_local(:, :, :, :) ! (num_wann, num_wann, nntot, rank_kpts) + complex(kind=dp), intent(in) :: u_matrix(:, :, :) ! (num_wann, num_wann, num_kpts) -- full array duplicated on all ranks + complex(kind=dp), intent(in) :: m_matrix_orig_local(:, :, :, :) ! (num_bands, num_bands, nntot, num_kpts) -- only local kpts + complex(kind=dp), intent(inout) :: m_matrix_local(:, :, :, :) ! (num_wann, num_wann, nntot, rank_kpts) -- only local kpts type(kmesh_info_type), intent(in) :: kmesh_info type(print_output_type), intent(in) :: print_output @@ -368,11 +368,6 @@ subroutine setup_m_loc(kmesh_info, print_output, m_matrix_local, m_matrix_orig_l close (page_unit) endif - ! collect up the local parts back on root - !m = num_wann*num_wann*kmesh_info%nntot - !call comms_gatherv(m_matrix_local, m*counts(my_node_id), m_matrix, m*counts, m*displs, error, comm) - !if (allocated(error)) return - deallocate (cwb) deallocate (cww) deallocate (global_k) diff --git a/src/library_interface.F90 b/src/library_interface.F90 index e9028e729..e2a1dd3c7 100644 --- a/src/library_interface.F90 +++ b/src/library_interface.F90 @@ -10,142 +10,114 @@ module w90_helper_types implicit none - ! should we have a lib_wannierise_type? - + ! datatype encapsulating types of use in both wannier90 and postw90 type lib_global_type - ! matrices - complex(kind=dp), pointer :: u_opt(:, :, :) => null() - complex(kind=dp), pointer :: u_matrix(:, :, :) => null() - - integer, pointer :: dist_kpoints(:) => null() - !! distk(i) = node operating on k-point i - type(atom_data_type) :: atom_data - !type(dis_control_type) :: dis_control type(dis_manifold_type) :: dis_manifold - !type(dis_spheres_type) :: dis_spheres type(kmesh_info_type) :: kmesh_info type(kmesh_input_type) :: kmesh_input type(kpoint_path_type) :: kpoint_path - !type(output_file_type) :: output_file type(print_output_type) :: print_output - !type(proj_input_type) :: proj - !type(proj_input_type) :: proj_input - !type(real_space_ham_type) :: real_space_ham - !type(select_projection_type) :: select_proj + type(timer_list_type) :: timer + type(w90_physical_constants_type) :: physics type(w90_system_type) :: w90_system - !type(wann_control_type) :: wann_control type(wannier_data_type) :: wannier_data - !type(wann_omega_type) :: wann_omega type(ws_region_type) :: ws_region - !type(wvfn_read_type) :: wvfn_read - type(w90_physical_constants_type) :: physics - type(timer_list_type) :: timer + complex(kind=dp), pointer :: u_matrix(:, :, :) => null() + complex(kind=dp), pointer :: u_opt(:, :, :) => null() + !! matrices + + real(kind=dp), allocatable :: eigval(:, :) + real(kind=dp), allocatable :: fermi_energy_list(:) + real(kind=dp), allocatable :: kpt_latt(:, :) + real(kind=dp) :: real_lattice(3, 3) + + integer, pointer :: dist_kpoints(:) => null() + !! dist_kpoints(i) = rank operating on k-point i integer, allocatable :: exclude_bands(:) integer :: mp_grid(3) integer :: num_bands integer :: num_kpts - !integer :: num_proj = 0 integer :: num_wann = -99 - !integer :: optimisation = 3 - real(kind=dp), allocatable :: eigval(:, :) - real(kind=dp), allocatable :: fermi_energy_list(:) - real(kind=dp), allocatable :: kpt_latt(:, :) - real(kind=dp) :: real_lattice(3, 3) - !!real(kind=dp) :: symmetrize_eps - - !logical :: eig_found = .false. - !Projections - !logical :: lhasproj = .false. - ! RS: symmetry-adapted Wannier functions - !logical :: lsitesymmetry = .false. - !logical :: use_bloch_phases = .false. - !logical :: calc_only_A = .false. logical :: gamma_only - - ! added for wannierise - !type(wann_omega_type) :: omega - !type(ham_logical_type) :: ham_logical - !type(sitesym_type) :: sitesym - !complex(kind=dp), allocatable :: ham_k(:, :, :) - !complex(kind=dp), allocatable :: ham_r(:, :, :) - !real(kind=dp), allocatable :: wannier_centres_translated(:, :) - !integer, allocatable :: irvec(:, :) - !integer, allocatable :: shift_vec(:, :) - !integer, allocatable :: ndegen(:) - !integer :: rpt_origin - !integer :: nrpts logical :: have_disentangled = .false. + character(len=128) :: seedname end type lib_global_type + ! datatype encapsulating types of use in wannier90 exclusively type lib_w90_type - type(w90_calculation_type) :: w90_calculation ! separate this? ... maybe yes (JJ) - ! matrices - complex(kind=dp), pointer :: a_matrix(:, :, :) => null() - complex(kind=dp), pointer :: m_matrix(:, :, :, :) => null() - complex(kind=dp), pointer :: m_matrix_local(:, :, :, :) => null() - complex(kind=dp), pointer :: m_orig(:, :, :, :) => null() !m_matrix_orig_local - type(dis_control_type) :: dis_control type(dis_spheres_type) :: dis_spheres + type(ham_logical_type) :: ham_logical type(output_file_type) :: output_file type(proj_input_type) :: proj type(proj_input_type) :: proj_input type(real_space_ham_type) :: real_space_ham type(select_projection_type) :: select_proj + type(sitesym_type) :: sitesym + type(w90_calculation_type) :: w90_calculation ! separate this? ... maybe yes (JJ) type(wann_control_type) :: wann_control + type(wann_omega_type) :: omega type(wann_omega_type) :: wann_omega - type(wvfn_read_type) :: wvfn_read - - !type(timer_list_type) :: timer - integer :: num_proj = 0 - integer :: optimisation = 3 - - logical :: eig_found = .false. - !Projections - logical :: lhasproj = .false. - ! RS: symmetry-adapted Wannier functions - logical :: lsitesymmetry = .false. - logical :: use_bloch_phases = .false. - logical :: calc_only_A = .false. - - ! added for wannierise complex(kind=dp), allocatable :: ham_k(:, :, :) complex(kind=dp), allocatable :: ham_r(:, :, :) + complex(kind=dp), pointer :: a_matrix(:, :, :) => null() + complex(kind=dp), pointer :: m_matrix_local(:, :, :, :) => null() + complex(kind=dp), pointer :: m_matrix(:, :, :, :) => null() + complex(kind=dp), pointer :: m_orig(:, :, :, :) => null() !m_matrix_orig_local + + real(kind=dp), allocatable :: wannier_centres_translated(:, :) + integer, allocatable :: irvec(:, :) integer, allocatable :: ndegen(:) integer, allocatable :: shift_vec(:, :) + integer :: nrpts + integer :: num_proj = 0 + integer :: optimisation = 3 integer :: rpt_origin - real(kind=dp), allocatable :: wannier_centres_translated(:, :) - type(ham_logical_type) :: ham_logical - type(sitesym_type) :: sitesym - type(wann_omega_type) :: omega + logical :: eig_found = .false. + logical :: lhasproj = .false. - !plot + ! plot type(band_plot_type) :: band_plot type(wannier_plot_type) :: wann_plot type(fermi_surface_plot_type) :: fermi_surface_data - !transport + ! transport type(transport_type) :: tran - end type lib_w90_type + type(wvfn_read_type) :: wvfn_read - public:: create_kmesh, get_fortran_stdout, get_fortran_stderr, input_reader, & - overlaps, plot_files, print_times, transport, wannierise, write_kmesh, & - write_chkpt, read_chkpt + ! symmetry-adapted Wannier functions + logical :: calc_only_A = .false. + logical :: lsitesymmetry = .false. + logical :: use_bloch_phases = .false. + end type lib_w90_type + public :: create_kmesh + public :: get_fortran_stderr + public :: get_fortran_stdout + public :: input_reader + public :: overlaps + public :: plot_files + public :: print_times + public :: read_chkpt public :: set_option + public :: transport + public :: wannierise + public :: write_chkpt + public :: write_kmesh + interface set_option module procedure set_option_bool - !module procedure set_option_cplx + !module procedure set_option_cplx ? useful? module procedure set_option_text - module procedure set_option_dble + module procedure set_option_real module procedure set_option_int end interface set_option @@ -182,19 +154,12 @@ subroutine set_option_bool(string, bool) call update_settings(string, bool, "", 0.d0, 0) endsubroutine set_option_bool - !subroutine set_option_cplx(string,cval) - ! implicit none - ! character(*), intent(in) :: string - ! complex(kind=dp), intent(in) :: cval - ! call update_settings(string, .false., cval, 0.d0, 0) - !endsubroutine set_option_cplx - - subroutine set_option_dble(string, rval) + subroutine set_option_real(string, rval) implicit none character(*), intent(in) :: string real(kind=dp), intent(in) :: rval call update_settings(string, .false., "", rval, 0) - endsubroutine set_option_dble + endsubroutine set_option_real subroutine set_option_int(string, ival) implicit none @@ -212,51 +177,103 @@ subroutine set_option_text(string, text) subroutine write_chkpt(helper, wan90, label, seedname, output, outerr, status, comm) use w90_wannier90_readwrite, only: w90_wannier90_readwrite_write_chkpt - use w90_comms, only: w90_comm_type, mpirank + use w90_comms, only: comms_reduce, mpirank, w90_comm_type + use w90_error_base, only: w90_error_type implicit none ! arguments - character(len=*), intent(in) :: seedname character(len=*), intent(in) :: label ! e.g. 'postdis' or 'postwann' after disentanglement, wannierisation + character(len=*), intent(in) :: seedname integer, intent(in) :: output, outerr integer, intent(inout) :: status - type(lib_global_type), intent(inout) :: helper + type(lib_global_type), target, intent(in) :: helper type(lib_w90_type), intent(in) :: wan90 type(w90_comm_type), intent(in) :: comm + ! local + complex(kind=dp), allocatable :: u(:, :, :), uopt(:, :, :), m(:, :, :, :) + integer, allocatable :: global_k(:) + integer, pointer :: nw, nb, nk, nn + integer :: rank, nkl, ikg, ikl + type(w90_error_type), allocatable :: error + status = 0 - if (.not. associated(helper%u_matrix)) then - write (*, *) 'u_matrix not set for write_chkpt call' + + rank = mpirank(comm) + + nb => helper%num_bands + nk => helper%num_kpts + nn => helper%kmesh_info%nntot + nw => helper%num_wann + + if (.not. associated(helper%u_opt)) then + write (outerr, *) 'u_opt not set for write_chkpt call' + status = 1 + return + else if (.not. associated(helper%u_matrix)) then write (outerr, *) 'u_matrix not set for write_chkpt call' status = 1 return - else if (.not. associated(helper%u_opt)) then - write (*, *) 'u_opt not set for write_chkpt call' - write (outerr, *) 'u_opt not set for write_chkpt call' + else if (.not. associated(wan90%m_matrix_local)) then + write (outerr, *) 'm_matrix_local not set for write_chkpt call' status = 1 return - else if (.not. associated(wan90%m_matrix)) then - write (*, *) 'm_matrix not set for write_chkpt call' - write (outerr, *) 'm_matrix not set for write_chkpt call' + endif + + nkl = count(helper%dist_kpoints == rank) + allocate (global_k(nkl)) + global_k = huge(1); ikl = 1 + do ikg = 1, nk + if (helper%dist_kpoints(ikg) == rank) then + global_k(ikl) = ikg + ikl = ikl + 1 + endif + enddo + + ! allocating and partially assigning the full matrix on all ranks and reducing is a terrible idea at scale + ! 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 + ! fixme. JJ Nov 22 + allocate (u(nw, nw, nk)) ! all kpts + allocate (uopt(nb, nw, nk)) ! all kpts + allocate (m(nw, nw, nn, nk)) ! all kpts + u(:, :, :) = 0.d0 + uopt(:, :, :) = 0.d0 + m(:, :, :, :) = 0.d0 + do ikl = 1, nkl + ikg = global_k(ikl) + u(:, :, ikg) = helper%u_matrix(:, :, ikl) + uopt(:, :, ikg) = helper%u_opt(:, :, ikl) + m(:, :, :, ikg) = wan90%m_matrix_local(:, :, :, ikl) + enddo + call comms_reduce(u(1, 1, 1), nw*nw*nk, 'SUM', error, comm) + call comms_reduce(uopt(1, 1, 1), nb*nw*nk, 'SUM', error, comm) + call comms_reduce(m(1, 1, 1, 1), nw*nw*nn*nk, 'SUM', error, comm) + if (allocated(error)) then + write (*, *) 'problem coalescing matrices for checkpoint write' status = 1 return endif - if (mpirank(comm) == 0) then + if (rank == 0) then call w90_wannier90_readwrite_write_chkpt(label, helper%exclude_bands, helper%wannier_data, & - helper%kmesh_info, helper%kpt_latt, & - helper%num_kpts, helper%dis_manifold, & - helper%num_bands, helper%num_wann, helper%u_matrix, & - helper%u_opt, wan90%m_matrix, helper%mp_grid, & - helper%real_lattice, wan90%omega%invariant, & - helper%have_disentangled, output, seedname) + helper%kmesh_info, helper%kpt_latt, nk, & + helper%dis_manifold, nb, nw, u, uopt, m, & + helper%mp_grid, helper%real_lattice, & + wan90%omega%invariant, helper%have_disentangled, & + output, seedname) endif + deallocate (u) + deallocate (uopt) + deallocate (m) end subroutine write_chkpt subroutine read_chkpt(helper, wan90, checkpoint, seedname, output, outerr, status, comm) - use w90_comms, only: w90_comm_type + use w90_comms, only: w90_comm_type, mpirank use w90_error_base, only: w90_error_type - use w90_readwrite, only: w90_readwrite_read_chkpt_header, w90_readwrite_read_chkpt_matrices + use w90_readwrite, only: w90_readwrite_read_chkpt_header, w90_readwrite_read_chkpt_matrices, & + w90_readwrite_chkpt_dist implicit none ! arguments @@ -264,42 +281,62 @@ subroutine read_chkpt(helper, wan90, checkpoint, seedname, output, outerr, statu character(len=*), intent(out) :: checkpoint integer, intent(in) :: output, outerr integer, intent(out) :: status - type(lib_global_type), intent(inout) :: helper + type(lib_global_type), target, intent(inout) :: helper type(lib_w90_type), intent(inout) :: wan90 type(w90_comm_type), intent(in) :: comm ! local variables + complex(kind=dp), allocatable :: m(:, :, :, :) integer :: chk_unit - logical :: have_disentangled, ispostw90 = .false. + integer, pointer :: nw, nb, nk, nn + integer :: rank, nexclude = 0 + logical :: ispostw90 = .false. ! ispostw90 is used to print a different error message in case the chk file is missing (did you run w90 first?) + logical :: have_disentangled ! assigned here type(w90_error_type), allocatable :: error - real(dp) :: omega_invariant status = 0 - call w90_readwrite_read_chkpt_header(helper%exclude_bands, helper%kmesh_info, helper%kpt_latt, & - helper%real_lattice, helper%mp_grid, helper%num_bands, & - size(helper%exclude_bands), helper%num_kpts, & - helper%num_wann, checkpoint, have_disentangled, & - ispostw90, seedname, chk_unit, output, error, comm) - if (allocated(error)) call prterr(error, output, outerr, comm) - - call w90_readwrite_read_chkpt_matrices(helper%dis_manifold, helper%kmesh_info, & - helper%wannier_data, wan90%m_matrix, helper%u_matrix, & - helper%u_opt, omega_invariant, helper%num_bands, & - helper%num_kpts, helper%num_wann, have_disentangled, & - seedname, chk_unit, output, error, comm) - if (allocated(error)) call prterr(error, output, outerr, comm) - -! scatter from m_matrix_orig to m_matrix_orig_local -! normally achieved in overlap_read -! scatter from m_matrix to m_matrix_local -! w = num_wann*num_wann*kmesh_info%nntot -! call comms_scatterv(m_matrix_local, w*counts(my_node_id), m_matrix, w*counts, w*displs, error, comm) -! if (allocated(error)) call prterr(error, stdout, stderr, comm) - -!call w90_readwrite_chkpt_dist(dis_manifold, wannier_data, u_matrix, u_matrix_opt, & -! omega%invariant, num_bands, num_kpts, num_wann, checkpoint, & -! have_disentangled, error, comm) + rank = mpirank(comm) + + nb => helper%num_bands + nk => helper%num_kpts + nn => helper%kmesh_info%nntot + nw => helper%num_wann + + ! allocating and partially assigning the full matrix on all ranks and reducing is a terrible idea at scale + ! 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 + ! fixme. JJ Nov 22 + allocate (m(nw, nw, nn, nk)) ! all kpts + + if (rank == 0) then + ! have_disenangled is read from file + if (allocated(helper%exclude_bands)) nexclude = size(helper%exclude_bands) + + call w90_readwrite_read_chkpt_header(helper%exclude_bands, helper%kmesh_info, & + helper%kpt_latt, helper%real_lattice, helper%mp_grid, & + nb, nexclude, nk, nw, checkpoint, & + have_disentangled, ispostw90, seedname, chk_unit, & + output, error, comm) + if (allocated(error)) call prterr(error, output, outerr, comm) + + call w90_readwrite_read_chkpt_matrices(helper%dis_manifold, helper%kmesh_info, & + helper%wannier_data, m, helper%u_matrix, & + helper%u_opt, wan90%omega%invariant, nb, nk, nw, & + have_disentangled, seedname, chk_unit, output, error, & + comm) + if (allocated(error)) call prterr(error, output, outerr, comm) + endif + + ! scatter from m_matrix to m_matrix_local + ! normally achieved in overlap_read + call w90_readwrite_chkpt_dist(helper%dis_manifold, helper%wannier_data, helper%u_matrix, & + helper%u_opt, m, wan90%m_matrix_local, wan90%omega%invariant, & + nb, nk, nw, nn, checkpoint, have_disentangled, & + helper%dist_kpoints, error, comm) + + deallocate (m) end subroutine read_chkpt subroutine input_reader(helper, wan90, seedname, output, outerr, status, comm) @@ -351,8 +388,8 @@ subroutine input_reader(helper, wan90, seedname, output, outerr, status, comm) helper%num_bands, helper%num_kpts, wan90%num_proj, & helper%num_wann, wan90%optimisation, wan90%eig_found, & wan90%calc_only_A, cp_pp, helper%gamma_only, & - wan90%lhasproj, .false., .false., wan90%lsitesymmetry, & - wan90%use_bloch_phases, seedname, output, error, comm) + wan90%lhasproj, wan90%lsitesymmetry, wan90%use_bloch_phases, & + seedname, output, error, comm) ! test mpi error handling using "unlucky" input token ! this machinery used to sit in w90_wannier90_readwrite_dist @@ -401,6 +438,7 @@ subroutine input_reader(helper, wan90, seedname, output, outerr, status, comm) if (mpirank(comm) /= 0) helper%print_output%iprint = 0 ! supress printing non-rank-0 end subroutine input_reader + subroutine create_kmesh(helper, output, outerr, status, comm) use w90_kmesh, only: kmesh_get use w90_error_base, only: w90_error_type @@ -609,10 +647,10 @@ subroutine wannierise(helper, wan90, output, outerr, status, comm) endif status = 0 if (helper%gamma_only) then - call wann_main_gamma(helper%kmesh_info, helper%kpt_latt, wan90%wann_control, wan90%omega, & + call wann_main_gamma(helper%kmesh_info, wan90%wann_control, wan90%omega, & helper%print_output, helper%wannier_data, wan90%m_matrix_local, & - helper%u_matrix, helper%real_lattice, helper%mp_grid, helper%num_kpts, & - helper%num_wann, output, helper%timer, error, comm) + helper%u_matrix, helper%real_lattice, helper%num_kpts, helper%num_wann, & + output, helper%timer, error, comm) else call wann_main(wan90%ham_logical, helper%kmesh_info, helper%kpt_latt, wan90%wann_control, & wan90%omega, wan90%sitesym, helper%print_output, helper%wannier_data, & diff --git a/src/postw90/postw90_readwrite.F90 b/src/postw90/postw90_readwrite.F90 index 3db5eef9c..033799ef1 100644 --- a/src/postw90/postw90_readwrite.F90 +++ b/src/postw90/postw90_readwrite.F90 @@ -140,10 +140,9 @@ subroutine w90_postw90_readwrite_read(ws_region, w90_system, exclude_bands, prin integer :: num_exclude_bands logical :: dos_plot logical :: found_fermi_energy - logical :: disentanglement, library, ok + logical :: disentanglement, ok character(len=20) :: energy_unit - library = .false. pw90_kslice%corner = 0.0_dp pw90_kslice%b1 = [1.0_dp, 0.0_dp, 0.0_dp] pw90_kslice%b2 = [0.0_dp, 1.0_dp, 0.0_dp] @@ -166,19 +165,18 @@ subroutine w90_postw90_readwrite_read(ws_region, w90_system, exclude_bands, prin if (allocated(error)) return call w90_readwrite_read_exclude_bands(exclude_bands, num_exclude_bands, error, comm) !for read_chkpt if (allocated(error)) return - call w90_readwrite_read_num_bands(effective_model, library, num_exclude_bands, num_bands, & - num_wann, .false., stdout, error, comm) + call w90_readwrite_read_num_bands(effective_model, num_exclude_bands, num_bands, & + num_wann, stdout, error, comm) if (allocated(error)) return disentanglement = (num_bands > num_wann) !call w90_readwrite_read_devel(print_output%devel_flag, stdout, seedname) - call w90_readwrite_read_mp_grid(effective_model, library, mp_grid, num_kpts, stdout, & - error, comm) + call w90_readwrite_read_mp_grid(effective_model, mp_grid, num_kpts, error, comm) if (allocated(error)) return - call w90_readwrite_read_gamma_only(gamma_only, num_kpts, library, stdout, error, comm) + call w90_readwrite_read_gamma_only(gamma_only, num_kpts, error, comm) if (allocated(error)) return - call w90_readwrite_read_system(library, w90_system, stdout, error, comm) + call w90_readwrite_read_system(w90_system, error, comm) if (allocated(error)) return - call w90_readwrite_read_kpath(library, kpoint_path, ok, .false., error, comm) + call w90_readwrite_read_kpath(kpoint_path, ok, .false., error, comm) if (allocated(error)) return call w90_readwrite_read_fermi_energy(found_fermi_energy, fermi_energy_list, error, comm) if (allocated(error)) return @@ -214,7 +212,7 @@ subroutine w90_postw90_readwrite_read(ws_region, w90_system, exclude_bands, prin if (allocated(error)) return call w90_readwrite_read_eigvals(effective_model, pw90_calculation%boltzwann, & pw90_calculation%geninterp, dos_plot, disentanglement, & - eig_found, eigval, library, .false., num_bands, num_kpts, & + eig_found, eigval, .false., num_bands, num_kpts, & stdout, seedname, error, comm) if (allocated(error)) return dis_manifold%win_min = -1.0_dp @@ -233,14 +231,13 @@ subroutine w90_postw90_readwrite_read(ws_region, w90_system, exclude_bands, prin dis_manifold, fermi_energy_list, eigval, & pw90_extra_io, error, comm) if (allocated(error)) return - call w90_readwrite_read_lattice(library, real_lattice, bohr, stdout, error, comm) + call w90_readwrite_read_lattice(real_lattice, bohr, error, comm) if (allocated(error)) return call w90_readwrite_read_kmesh_data(kmesh_input, error, comm) if (allocated(error)) return call utility_recip_lattice(real_lattice, recip_lattice, volume, error, comm) if (allocated(error)) return - call w90_readwrite_read_kpoints(effective_model, library, kpt_latt, num_kpts, & - bohr, stdout, error, comm) + call w90_readwrite_read_kpoints(effective_model, kpt_latt, num_kpts, bohr, error, comm) if (allocated(error)) return call w90_wannier90_readwrite_read_global_kmesh(pw90_extra_io%global_kmesh_set, & pw90_extra_io%global_kmesh, recip_lattice, & @@ -251,7 +248,7 @@ subroutine w90_postw90_readwrite_read(ws_region, w90_system, exclude_bands, prin recip_lattice, pw90_extra_io%global_kmesh_set, & pw90_extra_io%global_kmesh, error, comm) if (allocated(error)) return - call w90_readwrite_read_atoms(library, atom_data, real_lattice, bohr, stdout, error, comm) + call w90_readwrite_read_atoms(atom_data, real_lattice, bohr, error, comm) if (allocated(error)) return end subroutine w90_postw90_readwrite_read @@ -310,9 +307,8 @@ subroutine w90_postw90_readwrite_readall(w90_system, dis_manifold, fermi_energy_ real(kind=dp) :: recip_lattice(3, 3), volume logical :: dos_plot logical :: found_fermi_energy - logical :: disentanglement, library + logical :: disentanglement - library = .false. pw90_kslice%corner = 0.0_dp pw90_kslice%b1 = [1.0_dp, 0.0_dp, 0.0_dp] pw90_kslice%b2 = [0.0_dp, 1.0_dp, 0.0_dp] diff --git a/src/readwrite.F90 b/src/readwrite.F90 index df201eb74..f287abb45 100644 --- a/src/readwrite.F90 +++ b/src/readwrite.F90 @@ -280,17 +280,15 @@ subroutine w90_readwrite_read_exclude_bands(exclude_bands, num_exclude_bands, er end if end subroutine w90_readwrite_read_exclude_bands - subroutine w90_readwrite_read_num_bands(pw90_effective_model, library, num_exclude_bands, & - num_bands, num_wann, library_param_read_first_pass, & - stdout, error, comm) + subroutine w90_readwrite_read_num_bands(pw90_effective_model, num_exclude_bands, num_bands, & + num_wann, stdout, error, comm) use w90_error, only: w90_error_type, set_error_input implicit none - logical, intent(in) :: pw90_effective_model, library + logical, intent(in) :: pw90_effective_model integer, intent(in) :: num_exclude_bands integer, intent(inout) :: num_bands integer, intent(in) :: num_wann integer, intent(in) :: stdout - logical, intent(in) :: library_param_read_first_pass type(w90_error_type), allocatable, intent(out) :: error type(w90_comm_type), intent(in) :: comm @@ -299,31 +297,31 @@ subroutine w90_readwrite_read_num_bands(pw90_effective_model, library, num_exclu call w90_readwrite_get_keyword('num_bands', found, error, comm, i_value=i_temp) if (allocated(error)) return - if (found .and. library) write (stdout, '(/a)') ' Ignoring in input file' - if (.not. library .and. .not. pw90_effective_model) then - if (found) num_bands = i_temp - if (.not. found) num_bands = num_wann - end if - ! GP: I subtract it here, but only the first time when I pass the total number of bands - ! In later calls, I need to pass instead num_bands already subtracted. - if (library .and. library_param_read_first_pass) num_bands = num_bands - num_exclude_bands if (.not. pw90_effective_model) then - if (found .and. num_bands < num_wann) then - write (stdout, *) 'num_bands', num_bands - write (stdout, *) 'num_wann', num_wann - call set_error_input(error, 'Error: num_bands must be greater than or equal to num_wann', comm) - return + if (found) then + num_bands = i_temp + if (num_bands < num_wann) then + write (stdout, *) 'num_bands', num_bands + write (stdout, *) 'num_wann', num_wann + call set_error_input(error, 'Error: num_bands must be greater than or equal to num_wann', comm) + return + endif + else + num_bands = num_wann endif + !end if + ! GP: I subtract it here, but only the first time when I pass the total number of bands + ! In later calls, I need to pass instead num_bands already subtracted. + !if (library .and. library_param_read_first_pass) num_bands = num_bands - num_exclude_bands + !if (.not. pw90_effective_model) then endif end subroutine w90_readwrite_read_num_bands - subroutine w90_readwrite_read_gamma_only(gamma_only, num_kpts, library, stdout, error, comm) + subroutine w90_readwrite_read_gamma_only(gamma_only, num_kpts, error, comm) use w90_error, only: w90_error_type, set_error_input implicit none - integer, intent(in) :: stdout logical, intent(inout) :: gamma_only integer, intent(in) :: num_kpts - logical, intent(in) :: library type(w90_error_type), allocatable, intent(out) :: error type(w90_comm_type), intent(in) :: comm @@ -332,23 +330,17 @@ subroutine w90_readwrite_read_gamma_only(gamma_only, num_kpts, library, stdout, ltmp = .false. call w90_readwrite_get_keyword('gamma_only', found, error, comm, l_value=ltmp) if (allocated(error)) return - if (.not. library) then - gamma_only = ltmp - if (gamma_only .and. (num_kpts .ne. 1)) then - call set_error_input(error, 'Error: gamma_only is true, but num_kpts > 1', comm) - return - endif - else - if (found) write (stdout, '(a)') ' Ignoring in input file' + gamma_only = ltmp + if (gamma_only .and. (num_kpts .ne. 1)) then + call set_error_input(error, 'Error: gamma_only is true, but num_kpts > 1', comm) + return endif end subroutine w90_readwrite_read_gamma_only - subroutine w90_readwrite_read_mp_grid(pw90_effective_model, library, mp_grid, num_kpts, stdout, & - error, comm) + subroutine w90_readwrite_read_mp_grid(pw90_effective_model, mp_grid, num_kpts, error, comm) use w90_error, only: w90_error_type, set_error_input implicit none - integer, intent(in) :: stdout - logical, intent(in) :: pw90_effective_model, library + logical, intent(in) :: pw90_effective_model integer, intent(inout) :: mp_grid(3), num_kpts type(w90_error_type), allocatable, intent(out) :: error type(w90_comm_type), intent(in) :: comm @@ -358,8 +350,7 @@ subroutine w90_readwrite_read_mp_grid(pw90_effective_model, library, mp_grid, nu call w90_readwrite_get_keyword_vector('mp_grid', found, 3, error, comm, i_value=iv_temp) if (allocated(error)) return - if (found .and. library) write (stdout, '(a)') ' Ignoring in input file' - if (.not. library .and. .not. pw90_effective_model) then + if (.not. pw90_effective_model) then if (found) mp_grid = iv_temp if (.not. found) then call set_error_input(error, 'Error: You must specify dimensions of the Monkhorst-Pack grid by setting mp_grid', comm) @@ -372,11 +363,9 @@ subroutine w90_readwrite_read_mp_grid(pw90_effective_model, library, mp_grid, nu end if end subroutine w90_readwrite_read_mp_grid - subroutine w90_readwrite_read_system(library, w90_system, stdout, error, comm) + subroutine w90_readwrite_read_system(w90_system, error, comm) use w90_error, only: w90_error_type, set_error_input implicit none - integer, intent(in) :: stdout - logical, intent(in) :: library type(w90_system_type), intent(inout) :: w90_system type(w90_error_type), allocatable, intent(out) :: error type(w90_comm_type), intent(in) :: comm @@ -386,11 +375,7 @@ subroutine w90_readwrite_read_system(library, w90_system, stdout, error, comm) ltmp = .false. ! by default our WF are not spinors call w90_readwrite_get_keyword('spinors', found, error, comm, l_value=ltmp) if (allocated(error)) return - if (.not. library) then - w90_system%spinors = ltmp - else - if (found) write (stdout, '(a)') ' Ignoring in input file' - endif + w90_system%spinors = ltmp ! if(spinors .and. (2*(num_wann/2))/=num_wann) & ! call io_error('Error: For spinor WF num_wann must be even') @@ -424,10 +409,10 @@ subroutine w90_readwrite_read_system(library, w90_system, stdout, error, comm) end subroutine w90_readwrite_read_system - subroutine w90_readwrite_read_kpath(library, kpoint_path, ok, bands_plot, error, comm) + subroutine w90_readwrite_read_kpath(kpoint_path, ok, bands_plot, error, comm) use w90_error, only: w90_error_type, set_error_input, set_error_alloc implicit none - logical, intent(in) :: library, bands_plot + logical, intent(in) :: bands_plot type(kpoint_path_type), intent(inout) :: kpoint_path logical, intent(out) :: ok type(w90_error_type), allocatable, intent(out) :: error @@ -437,7 +422,7 @@ subroutine w90_readwrite_read_kpath(library, kpoint_path, ok, bands_plot, error, logical :: found bands_num_spec_points = 0 - call w90_readwrite_get_block_length('kpoint_path', found, i_temp, library, error, comm) + call w90_readwrite_get_block_length('kpoint_path', found, i_temp, error, comm) if (allocated(error)) return if (found) then ok = .true. @@ -603,7 +588,7 @@ subroutine w90_readwrite_read_ws_data(ws_region, error, comm) end subroutine w90_readwrite_read_ws_data subroutine w90_readwrite_read_eigvals(pw90_effective_model, pw90_boltzwann, pw90_geninterp, & - w90_plot, disentanglement, eig_found, eigval, library, & + w90_plot, disentanglement, eig_found, eigval, & postproc_setup, num_bands, num_kpts, stdout, seedname, & error, comm) @@ -615,7 +600,7 @@ subroutine w90_readwrite_read_eigvals(pw90_effective_model, pw90_boltzwann, pw90 integer, intent(in) :: stdout real(kind=dp), allocatable, intent(inout) :: eigval(:, :) character(len=*), intent(in) :: seedname - logical, intent(in) :: disentanglement, library, postproc_setup + logical, intent(in) :: disentanglement, postproc_setup logical, intent(in) :: pw90_effective_model, pw90_boltzwann, pw90_geninterp, w90_plot logical, intent(inout) :: eig_found type(w90_error_type), allocatable, intent(out) :: error @@ -624,7 +609,7 @@ subroutine w90_readwrite_read_eigvals(pw90_effective_model, pw90_boltzwann, pw90 integer :: i, j, k, n, eig_unit, ierr ! Read the eigenvalues from wannier.eig - if (.not. library .and. .not. pw90_effective_model) then + if (.not. pw90_effective_model) then if (.not. postproc_setup) then inquire (file=trim(seedname)//'.eig', exist=eig_found) @@ -669,7 +654,7 @@ subroutine w90_readwrite_read_eigvals(pw90_effective_model, pw90_boltzwann, pw90 end if end if - if (library .and. allocated(eigval)) eig_found = .true. + if (allocated(eigval)) eig_found = .true. return @@ -797,14 +782,13 @@ subroutine w90_readwrite_read_kmesh_data(kmesh_input, error, comm) end subroutine w90_readwrite_read_kmesh_data - subroutine w90_readwrite_read_kpoints(pw90_effective_model, library, kpt_latt, num_kpts, & - bohr, stdout, error, comm) + subroutine w90_readwrite_read_kpoints(pw90_effective_model, kpt_latt, num_kpts, & + bohr, error, comm) use w90_error, only: w90_error_type, set_error_input, set_error_alloc, set_error_dealloc implicit none integer, intent(in) :: num_kpts - integer, intent(in) :: stdout - logical, intent(in) :: pw90_effective_model, library + logical, intent(in) :: pw90_effective_model real(kind=dp), allocatable, intent(inout) :: kpt_latt(:, :) real(kind=dp), intent(in) :: bohr type(w90_error_type), allocatable, intent(out) :: error @@ -819,19 +803,16 @@ subroutine w90_readwrite_read_kpoints(pw90_effective_model, library, kpt_latt, n call set_error_alloc(error, 'Error allocating kpt_cart in w90_readwrite_read_kpoints', comm) return endif - if (.not. library) then - allocate (kpt_latt(3, num_kpts), stat=ierr) - if (ierr /= 0) then - call set_error_alloc(error, 'Error allocating kpt_latt in w90_readwrite_read_kpoints', comm) - return - endif - end if + allocate (kpt_latt(3, num_kpts), stat=ierr) + if (ierr /= 0) then + call set_error_alloc(error, 'Error allocating kpt_latt in w90_readwrite_read_kpoints', comm) + return + endif call w90_readwrite_get_keyword_block('kpoints', found, num_kpts, 3, bohr, error, comm, & r_value=kpt_cart) if (allocated(error)) return - if (found .and. library) write (stdout, '(a)') ' Ignoring in input file' - if (.not. library .and. .not. pw90_effective_model) then + if (.not. pw90_effective_model) then kpt_latt = kpt_cart if (.not. found) then call set_error_input(error, 'Error: Did not find the kpoint information in the input file', comm) @@ -853,11 +834,9 @@ subroutine w90_readwrite_read_kpoints(pw90_effective_model, library, kpt_latt, n end subroutine w90_readwrite_read_kpoints - subroutine w90_readwrite_read_lattice(library, real_lattice, bohr, stdout, error, comm) + subroutine w90_readwrite_read_lattice(real_lattice, bohr, error, comm) use w90_error, only: w90_error_type, set_error_input implicit none - logical, intent(in) :: library - integer, intent(in) :: stdout real(kind=dp), intent(out) :: real_lattice(3, 3) real(kind=dp) :: real_lattice_tmp(3, 3) real(kind=dp), intent(in) :: bohr @@ -869,21 +848,16 @@ subroutine w90_readwrite_read_lattice(library, real_lattice, bohr, stdout, error call w90_readwrite_get_keyword_block('unit_cell_cart', found, 3, 3, bohr, error, comm, & r_value=real_lattice_tmp) if (allocated(error)) return - if (found .and. library) write (stdout, '(a)') ' Ignoring in input file' - if (.not. library) then - real_lattice = transpose(real_lattice_tmp) - if (.not. found) then - call set_error_input(error, 'Error: Did not find the cell information in the input file', comm) - return - endif - end if + real_lattice = transpose(real_lattice_tmp) + if (.not. found) then + call set_error_input(error, 'Error: Did not find the cell information in the input file', comm) + return + endif end subroutine w90_readwrite_read_lattice - subroutine w90_readwrite_read_atoms(library, atom_data, real_lattice, bohr, stdout, error, comm) + subroutine w90_readwrite_read_atoms(atom_data, real_lattice, bohr, error, comm) use w90_error, only: w90_error_type, set_error_input implicit none - logical, intent(in) :: library - integer, intent(in) :: stdout type(atom_data_type), intent(inout) :: atom_data real(kind=dp), intent(in) :: real_lattice(3, 3) real(kind=dp), intent(in) :: bohr @@ -894,30 +868,27 @@ subroutine w90_readwrite_read_atoms(library, atom_data, real_lattice, bohr, stdo logical :: found, found2, lunits ! Atoms - if (.not. library) atom_data%num_atoms = 0 - call w90_readwrite_get_block_length('atoms_frac', found, i_temp, library, error, comm) + call w90_readwrite_get_block_length('atoms_frac', found, i_temp, error, comm) if (allocated(error)) return - if (found .and. library) write (stdout, '(a)') ' Ignoring in input file' - call w90_readwrite_get_block_length('atoms_cart', found2, i_temp2, library, error, comm, lunits) + call w90_readwrite_get_block_length('atoms_cart', found2, i_temp2, error, comm, lunits) if (allocated(error)) return - if (found2 .and. library) write (stdout, '(a)') ' Ignoring in input file' - if (.not. library) then - if (found .and. found2) then - call set_error_input(error, 'Error: Cannot specify both atoms_frac and atoms_cart', comm) - return - endif - if (found .and. i_temp > 0) then - lunits = .false. - atom_data%num_atoms = i_temp - elseif (found2 .and. i_temp2 > 0) then - atom_data%num_atoms = i_temp2 - if (lunits) atom_data%num_atoms = atom_data%num_atoms - 1 - end if - if (atom_data%num_atoms > 0) then - call readwrite_get_atoms(atom_data, library, lunits, real_lattice, bohr, error, comm) - if (allocated(error)) return - end if + if (found .and. found2) then + call set_error_input(error, 'Error: Cannot specify both atoms_frac and atoms_cart', comm) + return endif + if (found .and. i_temp > 0) then + lunits = .false. + atom_data%num_atoms = i_temp + elseif (found2 .and. i_temp2 > 0) then + atom_data%num_atoms = i_temp2 + ! fixme JJ, what does this logic do??? + if (lunits) atom_data%num_atoms = atom_data%num_atoms - 1 + end if + if (atom_data%num_atoms > 0) then + ! fixme JJ, what does this logic do??? + call readwrite_get_atoms(atom_data, lunits, real_lattice, bohr, error, comm) + if (allocated(error)) return + end if end subroutine w90_readwrite_read_atoms subroutine w90_readwrite_clear_keywords(comm) @@ -2175,9 +2146,9 @@ subroutine w90_readwrite_read_chkpt_matrices(dis_manifold, kmesh_info, wannier_d end subroutine w90_readwrite_read_chkpt_matrices !================================================! - subroutine w90_readwrite_chkpt_dist(dis_manifold, wannier_data, u_matrix, u_matrix_opt, & - omega_invariant, num_bands, num_kpts, num_wann, checkpoint, & - have_disentangled, error, comm) + subroutine w90_readwrite_chkpt_dist(dis_manifold, wannier_data, u_matrix, u_matrix_opt, m_matrix, & + m_matrix_local, omega_invariant, num_bands, num_kpts, num_wann, & + nntot, checkpoint, have_disentangled, distk, error, comm) !================================================! ! !! Distribute the chk files @@ -2197,42 +2168,47 @@ subroutine w90_readwrite_chkpt_dist(dis_manifold, wannier_data, u_matrix, u_matr type(w90_error_type), allocatable, intent(out) :: error type(w90_comm_type), intent(in) :: comm - integer, intent(inout) :: num_bands - integer, intent(inout) :: num_wann - integer, intent(inout) :: num_kpts + integer, intent(in) :: num_bands + integer, intent(in) :: num_wann + integer, intent(in) :: num_kpts + integer, intent(in) :: nntot + integer, intent(in) :: distk(:) - complex(kind=dp), allocatable, intent(inout) :: u_matrix(:, :, :) - complex(kind=dp), allocatable, intent(inout) :: u_matrix_opt(:, :, :) + complex(kind=dp), intent(inout) :: u_matrix(:, :, :) + complex(kind=dp), intent(inout) :: u_matrix_opt(:, :, :) + complex(kind=dp), intent(inout) :: m_matrix_local(:, :, :, :) + complex(kind=dp), intent(inout) :: m_matrix(:, :, :, :) !only alloc/assigned on root real(kind=dp), intent(inout) :: omega_invariant character(len=*), intent(inout) :: checkpoint logical, intent(inout) :: have_disentangled ! local variables - integer :: ierr - + integer :: ierr, ikl, nkl, ikg, rank logical :: on_root = .false. - if (mpirank(comm) == 0) on_root = .true. + rank = mpirank(comm) + if (rank == 0) on_root = .true. call comms_bcast(checkpoint, len(checkpoint), error, comm) if (allocated(error)) return - if (.not. on_root .and. .not. allocated(u_matrix)) then - allocate (u_matrix(num_wann, num_wann, num_kpts), stat=ierr) - if (ierr /= 0) then - call set_error_alloc(error, 'Error allocating u_matrix in w90_readwrite_chkpt_dist', comm) - return - endif - endif + ! fixme jj document strategy here + warning + ! assumes u is alloc'd on all nodes call comms_bcast(u_matrix(1, 1, 1), num_wann*num_wann*num_kpts, error, comm) -! if (.not.on_root .and. .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 w90_readwrite_chkpt_dist') -! endif -! call comms_bcast(m_matrix(1,1,1,1),num_wann*num_wann*nntot*num_kpts) + ! assumes m is alloc'd on all nodes + call comms_bcast(m_matrix(1, 1, 1, 1), num_wann*num_wann*nntot*num_kpts, error, comm) + + nkl = count(distk(:) == rank) + ikl = 1 + ! should assert that the size is compatible, fixme jj + do ikg = 1, num_kpts + if (distk(ikg) == rank) then + m_matrix_local(:, :, :, ikl) = m_matrix(:, :, :, ikg) + ikl = ikl + 1 + endif + enddo call comms_bcast(have_disentangled, 1, error, comm) if (allocated(error)) return @@ -2240,13 +2216,13 @@ subroutine w90_readwrite_chkpt_dist(dis_manifold, wannier_data, u_matrix, u_matr if (have_disentangled) then if (.not. on_root) then - if (.not. allocated(u_matrix_opt)) then - allocate (u_matrix_opt(num_bands, num_wann, num_kpts), stat=ierr) - if (ierr /= 0) then - call set_error_alloc(error, 'Error allocating u_matrix_opt in w90_readwrite_chkpt_dist', comm) - return - endif - endif + !if (.not. allocated(u_matrix_opt)) then + ! allocate (u_matrix_opt(num_bands, num_wann, num_kpts), stat=ierr) + ! if (ierr /= 0) then + ! call set_error_alloc(error, 'Error allocating u_matrix_opt in w90_readwrite_chkpt_dist', comm) + ! return + ! endif + !endif if (.not. allocated(dis_manifold%lwindow)) then allocate (dis_manifold%lwindow(num_bands, num_kpts), stat=ierr) @@ -2764,7 +2740,7 @@ subroutine w90_readwrite_get_keyword_block(keyword, found, rows, columns, bohr, end subroutine w90_readwrite_get_keyword_block !================================================! - subroutine w90_readwrite_get_block_length(keyword, found, rows, library, error, comm, lunits) + subroutine w90_readwrite_get_block_length(keyword, found, rows, error, comm, lunits) !================================================! ! !! Finds the length of the data block @@ -2783,7 +2759,6 @@ subroutine w90_readwrite_get_block_length(keyword, found, rows, library, error, !! Is keyword present integer, intent(out) :: rows !! Number of rows - logical, intent(in) :: library logical, optional, intent(out) :: lunits !! Have we found a unit specification @@ -2845,13 +2820,6 @@ subroutine w90_readwrite_get_block_length(keyword, found, rows, library, error, found = .true. - ! Ignore atoms_cart and atoms_frac blocks if running in library mode - if (library) then - if (trim(keyword) .eq. 'atoms_cart' .or. trim(keyword) .eq. 'atoms_frac') then - in_data(line_s:line_e) (1:maxlen) = ' ' - endif - endif - if (present(lunits)) then dummy = in_data(line_s + 1) read (dummy, *, end=555) atsym, (atpos(i), i=1, 3) @@ -2877,7 +2845,7 @@ subroutine w90_readwrite_get_block_length(keyword, found, rows, library, error, end subroutine w90_readwrite_get_block_length !================================================! - subroutine readwrite_get_atoms(atom_data, library, lunits, real_lattice, bohr, error, comm) + subroutine readwrite_get_atoms(atom_data, lunits, real_lattice, bohr, error, comm) !================================================! ! !! Fills the atom data block @@ -2891,7 +2859,6 @@ subroutine readwrite_get_atoms(atom_data, library, lunits, real_lattice, bohr, e type(atom_data_type), intent(inout) :: atom_data type(w90_error_type), allocatable, intent(out) :: error type(w90_comm_type), intent(in) :: comm - logical, intent(in) :: library logical, intent(in) :: lunits !! Do we expect a first line with the units real(kind=dp), intent(in) :: real_lattice(3, 3) @@ -2911,7 +2878,7 @@ subroutine readwrite_get_atoms(atom_data, library, lunits, real_lattice, bohr, e keyword = "atoms_cart" frac = .false. - call w90_readwrite_get_block_length("atoms_frac", found, i_temp, library, error, comm) + call w90_readwrite_get_block_length("atoms_frac", found, i_temp, error, comm) if (allocated(error)) return if (found) then keyword = "atoms_frac" diff --git a/src/tiny-lib2-demo.F90 b/src/tiny-lib2-demo.F90 index d64edc6a5..98d9976b4 100644 --- a/src/tiny-lib2-demo.F90 +++ b/src/tiny-lib2-demo.F90 @@ -70,11 +70,13 @@ program libv2 call mpi_init(ierr) #endif - call input_reader(w90main, w90dat, fn, 6, 6, ierr, comm) + call get_fortran_stdout(stdout) + call get_fortran_stderr(stderr) + call input_reader(w90main, w90dat, fn, stdout, stderr, ierr, comm) ! special branch for writing nnkp file if (pp) then - call write_kmesh(w90main, w90dat, fn, 6, 6, ierr, comm) + call write_kmesh(w90main, w90dat, fn, stdout, stderr, ierr, comm) #ifdef MPI call mpi_finalize(ierr) #endif @@ -172,7 +174,7 @@ program libv2 lplot = .false. ltran = .true. !else - ! illegitimate restart choice + ! illegitimate restart choice, should declaim the acceptable choices endif endif ! end restart system @@ -186,16 +188,16 @@ program libv2 if (nw < nb) then ! disentanglement reqired call disentangle(w90main, w90dat, stdout, stderr, ierr, comm) if (ierr /= 0) error stop - !call write_chkpt(w90main, w90dat, 'postdis', fn, stdout, stderr, ierr, comm) - !if (ierr /= 0) error stop + call write_chkpt(w90main, w90dat, 'postdis', fn, stdout, stderr, ierr, comm) + if (ierr /= 0) error stop endif endif if (lwann) then call wannierise(w90main, w90dat, stdout, stderr, ierr, comm) if (ierr /= 0) error stop - !call write_chkpt(w90main, w90dat, 'postwann', fn, stdout, stderr, ierr, comm) - !if (ierr /= 0) error stop + call write_chkpt(w90main, w90dat, 'postwann', fn, stdout, stderr, ierr, comm) + if (ierr /= 0) error stop endif if (lplot) then diff --git a/src/w90spn2spn.F90 b/src/w90spn2spn.F90 index bcb2bd28c..f0618d161 100644 --- a/src/w90spn2spn.F90 +++ b/src/w90spn2spn.F90 @@ -43,7 +43,7 @@ module w90_conv_spn contains - subroutine io_error(error_msg, stdout, seedname) + subroutine io_error(error_msg, stdout) !================================================ ! !! Abort the code giving an error message @@ -53,7 +53,6 @@ subroutine io_error(error_msg, stdout, seedname) implicit none character(len=*), intent(in) :: error_msg - character(len=50), intent(in) :: seedname integer :: stdout close (stdout) @@ -111,7 +110,7 @@ subroutine conv_get_seedname(stdout, seedname) call get_command_argument(2, seedname) else call print_usage(stdout) - call io_error('Wrong command line arguments, see logfile for usage', stdout, seedname) + call io_error('Wrong command line arguments, see logfile for usage', stdout) end if ! If on the command line the whole seedname.win was passed, I strip the last ".win" @@ -133,7 +132,7 @@ subroutine conv_get_seedname(stdout, seedname) else write (stdout, '(A)') 'Wrong command line action: '//trim(ctemp) call print_usage(stdout) - call io_error('Wrong command line arguments, see logfile for usage', stdout, seedname) + call io_error('Wrong command line arguments, see logfile for usage', stdout) end if end subroutine conv_get_seedname @@ -174,10 +173,10 @@ subroutine conv_read_spn(stdout, seedname) write (stdout, '(1x,a,i0)') "Number of k-points: ", num_kpts allocate (spn_o(num_bands, num_bands, num_kpts, 3), stat=ierr) - if (ierr /= 0) call io_error('Error in allocating spm_temp in conv_read_spn', stdout, seedname) + if (ierr /= 0) call io_error('Error in allocating spm_temp in conv_read_spn', stdout) allocate (spn_temp(3, (num_bands*(num_bands + 1))/2), stat=ierr) - if (ierr /= 0) call io_error('Error in allocating spm_temp in conv_read_spn', stdout, seedname) + if (ierr /= 0) call io_error('Error in allocating spm_temp in conv_read_spn', stdout) do ik = 1, num_kpts read (spn_unit) ((spn_temp(s, m), s=1, 3), m=1, (num_bands*(num_bands + 1))/2) counter = 0 @@ -205,14 +204,14 @@ subroutine conv_read_spn(stdout, seedname) write (stdout, '(1x,a)') "spn: read." deallocate (spn_temp, stat=ierr) - if (ierr /= 0) call io_error('Error in deallocating spm_temp in conv_read_spn', stdout, seedname) + if (ierr /= 0) call io_error('Error in deallocating spm_temp in conv_read_spn', stdout) write (stdout, '(1x,a)') 'read done.' return -109 call io_error('Error opening '//trim(seedname)//'.spn.fmt in conv_read_spn', stdout, seedname) -110 call io_error('Error reading '//trim(seedname)//'.spn.fmt in conv_read_spn', stdout, seedname) +109 call io_error('Error opening '//trim(seedname)//'.spn.fmt in conv_read_spn', stdout) +110 call io_error('Error reading '//trim(seedname)//'.spn.fmt in conv_read_spn', stdout) end subroutine conv_read_spn @@ -252,7 +251,7 @@ subroutine conv_read_spn_fmt(stdout, seedname) write (stdout, '(1x,a,i0)') "Number of k-points: ", num_kpts allocate (spn_o(num_bands, num_bands, num_kpts, 3), stat=ierr) - if (ierr /= 0) call io_error('Error in allocating spn_o in conv_read_spn_fmt', stdout, seedname) + if (ierr /= 0) call io_error('Error in allocating spn_o in conv_read_spn_fmt', stdout) do ik = 1, num_kpts do m = 1, num_bands @@ -284,8 +283,8 @@ subroutine conv_read_spn_fmt(stdout, seedname) return -109 call io_error('Error opening '//trim(seedname)//'.spn.fmt in conv_read_spn_fmt', stdout, seedname) -110 call io_error('Error reading '//trim(seedname)//'.spn.fmt in conv_read_spn_fmt', stdout, seedname) +109 call io_error('Error opening '//trim(seedname)//'.spn.fmt in conv_read_spn_fmt', stdout) +110 call io_error('Error reading '//trim(seedname)//'.spn.fmt in conv_read_spn_fmt', stdout) end subroutine conv_read_spn_fmt @@ -314,7 +313,7 @@ subroutine conv_write_spn(stdout, seedname) open (unit=spn_unit, file=trim(seedname)//'.spn', form='unformatted') allocate (spn_temp(3, (num_bands*(num_bands + 1))/2), stat=ierr) - if (ierr /= 0) call io_error('Error in allocating spm_temp in conv_write_spn', stdout, seedname) + if (ierr /= 0) call io_error('Error in allocating spm_temp in conv_write_spn', stdout) write (spn_unit) header write (spn_unit) num_bands, num_kpts diff --git a/src/wannier90_readwrite.F90 b/src/wannier90_readwrite.F90 index 5e15e8f7a..bf29ce73a 100644 --- a/src/wannier90_readwrite.F90 +++ b/src/wannier90_readwrite.F90 @@ -58,9 +58,8 @@ subroutine w90_wannier90_readwrite_read(atom_data, band_plot, dis_control, dis_s w90_calculation, eigval, real_lattice, bohr, & symmetrize_eps, mp_grid, num_bands, num_kpts, num_proj, & num_wann, optimisation, eig_found, calc_only_A, cp_pp, & - gamma_only, lhasproj, library, & - library_param_read_first_pass, lsitesymmetry, & - use_bloch_phases, seedname, stdout, error, comm) + gamma_only, lhasproj, lsitesymmetry, use_bloch_phases, & + seedname, stdout, error, comm) !================================================! ! !! Read parameters and calculate derived values @@ -123,8 +122,6 @@ subroutine w90_wannier90_readwrite_read(atom_data, band_plot, dis_control, dis_s real(kind=dp) :: recip_lattice(3, 3), volume, inv_lattice(3, 3) logical, intent(inout) :: eig_found - logical, intent(in) :: library - logical, intent(in) :: library_param_read_first_pass !Projections logical, intent(out) :: lhasproj ! RS: symmetry-adapted Wannier functions @@ -172,22 +169,22 @@ subroutine w90_wannier90_readwrite_read(atom_data, band_plot, dis_control, dis_s call w90_readwrite_read_exclude_bands(exclude_bands, num_exclude_bands, error, comm) if (allocated(error)) return - call w90_readwrite_read_num_bands(.false., library, num_exclude_bands, num_bands, & - num_wann, library_param_read_first_pass, stdout, error, comm) + call w90_readwrite_read_num_bands(.false., num_exclude_bands, num_bands, num_wann, stdout, & + error, comm) if (allocated(error)) return disentanglement = (num_bands > num_wann) - call w90_readwrite_read_lattice(library, real_lattice, bohr, stdout, error, comm) + call w90_readwrite_read_lattice(real_lattice, bohr, error, comm) if (allocated(error)) return call w90_wannier90_readwrite_read_wannierise(wann_control, num_wann, w90_extra_io%ccentres_frac, & stdout, error, comm) if (allocated(error)) return - call w90_readwrite_read_mp_grid(.false., library, mp_grid, num_kpts, stdout, error, comm) + call w90_readwrite_read_mp_grid(.false., mp_grid, num_kpts, error, comm) if (allocated(error)) return - call w90_readwrite_read_gamma_only(gamma_only, num_kpts, library, stdout, error, comm) + call w90_readwrite_read_gamma_only(gamma_only, num_kpts, error, comm) if (allocated(error)) return call w90_wannier90_readwrite_read_post_proc(cp_pp, calc_only_A, w90_calculation%postproc_setup, & @@ -197,10 +194,10 @@ subroutine w90_wannier90_readwrite_read(atom_data, band_plot, dis_control, dis_s call w90_wannier90_readwrite_read_restart(w90_calculation, seedname, error, comm) if (allocated(error)) return - call w90_readwrite_read_system(library, w90_system, stdout, error, comm) + call w90_readwrite_read_system(w90_system, error, comm) if (allocated(error)) return - call w90_readwrite_read_kpath(library, kpoint_path, has_kpath, w90_calculation%bands_plot, & + call w90_readwrite_read_kpath(kpoint_path, has_kpath, w90_calculation%bands_plot, & error, comm) if (allocated(error)) return @@ -239,7 +236,7 @@ subroutine w90_wannier90_readwrite_read(atom_data, band_plot, dis_control, dis_s call w90_readwrite_read_eigvals(.false., .false., .false., & w90_calculation%bands_plot .or. w90_calculation%fermi_surface_plot .or. & output_file%write_hr, disentanglement, eig_found, & - eigval, library, w90_calculation%postproc_setup, num_bands, & + eigval, w90_calculation%postproc_setup, num_bands, & num_kpts, stdout, seedname, error, comm) if (allocated(error)) return @@ -268,23 +265,23 @@ subroutine w90_wannier90_readwrite_read(atom_data, band_plot, dis_control, dis_s call utility_inverse_mat(real_lattice, inv_lattice) - call w90_readwrite_read_kpoints(.false., library, kpt_latt, num_kpts, bohr, stdout, error, comm) + call w90_readwrite_read_kpoints(.false., kpt_latt, num_kpts, bohr, error, comm) if (allocated(error)) return - call w90_wannier90_readwrite_read_explicit_kpts(library, w90_calculation, kmesh_info, & + call w90_wannier90_readwrite_read_explicit_kpts(w90_calculation, kmesh_info, & num_kpts, bohr, error, comm) if (allocated(error)) return !call w90_wannier90_readwrite_read_global_kmesh(global_kmesh_set, kmesh_spacing, kmesh, recip_lattice, & ! stdout, seedname) - call w90_readwrite_read_atoms(library, atom_data, real_lattice, bohr, stdout, error, comm) + call w90_readwrite_read_atoms(atom_data, real_lattice, bohr, error, comm) if (allocated(error)) return call w90_wannier90_readwrite_read_projections(proj, use_bloch_phases, lhasproj, & wann_control%guiding_centres%enable, & proj_input, select_proj, num_proj, & atom_data, inv_lattice, num_wann, gamma_only, & - w90_system%spinors, library, bohr, stdout, & + w90_system%spinors, bohr, stdout, & error, comm) if (allocated(error)) return @@ -298,8 +295,7 @@ subroutine w90_wannier90_readwrite_read(atom_data, band_plot, dis_control, dis_s if (wann_control%constrain%constrain) then call w90_wannier90_readwrite_read_constrained_centres(w90_extra_io%ccentres_frac, & wann_control, real_lattice, & - num_wann, library, stdout, & - error, comm) + num_wann, stdout, error, comm) if (allocated(error)) return endif @@ -390,16 +386,11 @@ subroutine w90_wannier90_readwrite_readall(atom_data, band_plot, dis_control, di ! local variables integer :: num_exclude_bands - !! Units for energy - logical :: library - logical :: library_param_read_first_pass logical :: found_fermi_energy logical :: has_kpath logical :: disentanglement character(len=20) :: energy_unit - library = .false. - library_param_read_first_pass = .false. disentanglement = .false. call w90_wannier90_readwrite_read_sym(symmetrize_eps, lsitesymmetry, error, comm) if (allocated(error)) return @@ -413,8 +404,8 @@ subroutine w90_wannier90_readwrite_readall(atom_data, band_plot, dis_control, di call w90_wannier90_readwrite_read_w90_calcs(w90_calculation, error, comm) if (allocated(error)) return - call w90_wannier90_readwrite_read_transport(w90_calculation%transport, tran, w90_calculation%restart, & - error, comm) + call w90_wannier90_readwrite_read_transport(w90_calculation%transport, tran, & + w90_calculation%restart, error, comm) if (allocated(error)) return call w90_wannier90_readwrite_read_dist_cutoff(real_space_ham, error, comm) @@ -431,32 +422,32 @@ subroutine w90_wannier90_readwrite_readall(atom_data, band_plot, dis_control, di call w90_readwrite_read_exclude_bands(exclude_bands, num_exclude_bands, error, comm) if (allocated(error)) return - call w90_readwrite_read_num_bands(.false., library, num_exclude_bands, num_bands, & - num_wann, library_param_read_first_pass, stdout, error, comm) + call w90_readwrite_read_num_bands(.false., num_exclude_bands, num_bands, num_wann, stdout, & + error, comm) if (allocated(error)) return disentanglement = (num_bands > num_wann) - call w90_readwrite_read_lattice(library, real_lattice, bohr, stdout, error, comm) + call w90_readwrite_read_lattice(real_lattice, bohr, error, comm) if (allocated(error)) return call w90_wannier90_readwrite_read_wannierise(wann_control, num_wann, w90_extra_io%ccentres_frac, & stdout, error, comm) if (allocated(error)) return - call w90_readwrite_read_mp_grid(.false., library, mp_grid, num_kpts, stdout, error, comm) + call w90_readwrite_read_mp_grid(.false., mp_grid, num_kpts, error, comm) if (allocated(error)) return - call w90_readwrite_read_gamma_only(gamma_only, num_kpts, library, stdout, error, comm) + call w90_readwrite_read_gamma_only(gamma_only, num_kpts, error, comm) if (allocated(error)) return call w90_wannier90_readwrite_read_restart(w90_calculation, seedname, error, comm) if (allocated(error)) return w90_system%num_valence_bands = num_wann - call w90_readwrite_read_system(library, w90_system, stdout, error, comm) + call w90_readwrite_read_system(w90_system, error, comm) if (allocated(error)) return - call w90_readwrite_read_kpath(library, kpoint_path, has_kpath, w90_calculation%bands_plot, & + call w90_readwrite_read_kpath(kpoint_path, has_kpath, w90_calculation%bands_plot, & error, comm) if (allocated(error)) return @@ -495,7 +486,7 @@ subroutine w90_wannier90_readwrite_readall(atom_data, band_plot, dis_control, di call w90_readwrite_read_eigvals(.false., .false., .false., & w90_calculation%bands_plot .or. w90_calculation%fermi_surface_plot .or. & output_file%write_hr, disentanglement, eig_found, & - eigval, library, w90_calculation%postproc_setup, num_bands, & + eigval, w90_calculation%postproc_setup, num_bands, & num_kpts, stdout, seedname, error, comm) if (allocated(error)) return @@ -524,21 +515,21 @@ subroutine w90_wannier90_readwrite_readall(atom_data, band_plot, dis_control, di call utility_inverse_mat(real_lattice, inv_lattice) - call w90_readwrite_read_kpoints(.false., library, kpt_latt, num_kpts, bohr, stdout, error, comm) + call w90_readwrite_read_kpoints(.false., kpt_latt, num_kpts, bohr, error, comm) if (allocated(error)) return - call w90_wannier90_readwrite_read_explicit_kpts(library, w90_calculation, kmesh_info, & + call w90_wannier90_readwrite_read_explicit_kpts(w90_calculation, kmesh_info, & num_kpts, bohr, error, comm) if (allocated(error)) return - call w90_readwrite_read_atoms(library, atom_data, real_lattice, bohr, stdout, error, comm) + call w90_readwrite_read_atoms(atom_data, real_lattice, bohr, error, comm) if (allocated(error)) return call w90_wannier90_readwrite_read_projections(proj, use_bloch_phases, lhasproj, & wann_control%guiding_centres%enable, & proj_input, select_proj, num_proj, & atom_data, inv_lattice, num_wann, gamma_only, & - w90_system%spinors, library, bohr, stdout, & + w90_system%spinors, bohr, stdout, & error, comm) if (allocated(error)) return @@ -552,7 +543,7 @@ subroutine w90_wannier90_readwrite_readall(atom_data, band_plot, dis_control, di if (wann_control%constrain%constrain) then call w90_wannier90_readwrite_read_constrained_centres(w90_extra_io%ccentres_frac, & wann_control, real_lattice, & - num_wann, library, stdout, & + num_wann, stdout, & error, comm) if (allocated(error)) return @@ -1513,7 +1504,7 @@ subroutine w90_wannier90_readwrite_read_bloch_phase(use_bloch_phases, disentangl end subroutine w90_wannier90_readwrite_read_bloch_phase !================================================! - subroutine w90_wannier90_readwrite_read_explicit_kpts(library, w90_calculation, kmesh_info, & + subroutine w90_wannier90_readwrite_read_explicit_kpts(w90_calculation, kmesh_info, & num_kpts, bohr, error, comm) !================================================! @@ -1527,7 +1518,6 @@ subroutine w90_wannier90_readwrite_read_explicit_kpts(library, w90_calculation, type(w90_calculation_type), intent(in) :: w90_calculation integer, intent(in) :: num_kpts real(kind=dp), intent(in) :: bohr - logical, intent(in) :: library type(w90_error_type), allocatable, intent(out) :: error type(w90_comm_type), intent(in) :: comm @@ -1538,7 +1528,7 @@ subroutine w90_wannier90_readwrite_read_explicit_kpts(library, w90_calculation, logical :: found ! get the nnkpts block -- this is allowed only in postproc-setup mode - call w90_readwrite_get_block_length('nnkpts', kmesh_info%explicit_nnkpts, rows, library, error, comm) + call w90_readwrite_get_block_length('nnkpts', kmesh_info%explicit_nnkpts, rows, error, comm) if (allocated(error)) return if (kmesh_info%explicit_nnkpts) then @@ -1615,7 +1605,7 @@ end subroutine w90_wannier90_readwrite_read_explicit_kpts subroutine w90_wannier90_readwrite_read_projections(proj, use_bloch_phases, lhasproj, & guiding_centres, proj_input, select_proj, & num_proj, atom_data, recip_lattice, & - num_wann, gamma_only, spinors, library, & + num_wann, gamma_only, spinors, & bohr, stdout, error, comm) !================================================! use w90_error, only: w90_error_type @@ -1634,7 +1624,7 @@ subroutine w90_wannier90_readwrite_read_projections(proj, use_bloch_phases, lhas real(kind=dp), intent(in) :: recip_lattice(3, 3) logical, intent(in) :: gamma_only logical, intent(in) :: spinors - logical, intent(in) :: use_bloch_phases, guiding_centres, library + logical, intent(in) :: use_bloch_phases, guiding_centres logical, intent(out) :: lhasproj integer, intent(in) :: stdout @@ -1649,7 +1639,7 @@ subroutine w90_wannier90_readwrite_read_projections(proj, use_bloch_phases, lhas l_value=proj_input%auto_projections) if (allocated(error)) return - call w90_readwrite_get_block_length('projections', found, i_temp, library, error, comm) + call w90_readwrite_get_block_length('projections', found, i_temp, error, comm) if (allocated(error)) return ! check to see that there are no unrecognised keywords if (found) then @@ -1762,7 +1752,7 @@ end subroutine w90_wannier90_readwrite_read_projections !================================================! subroutine w90_wannier90_readwrite_read_constrained_centres(ccentres_frac, wann_control, & - real_lattice, num_wann, library, & + real_lattice, num_wann, & stdout, error, comm) !================================================! implicit none @@ -1773,13 +1763,12 @@ subroutine w90_wannier90_readwrite_read_constrained_centres(ccentres_frac, wann_ real(kind=dp), intent(in) :: real_lattice(3, 3) integer, intent(in) :: num_wann integer, intent(in) :: stdout - logical, intent(in) :: library integer :: i_temp logical :: found ! Constrained centres - call w90_readwrite_get_block_length('slwf_centres', found, i_temp, library, error, comm) + call w90_readwrite_get_block_length('slwf_centres', found, i_temp, error, comm) if (allocated(error)) return if (found) then diff --git a/src/wannier_lib.F90 b/src/wannier_lib.F90 index 6a86591ba..0253583c4 100644 --- a/src/wannier_lib.F90 +++ b/src/wannier_lib.F90 @@ -337,8 +337,8 @@ subroutine wannier_setup(seed__name, mp_grid_loc, num_kpts_loc, real_lattice_loc tran, verbose, wann_plot, write_data, ws_region, w90_calcs, & eigval, real_lattice, physics%bohr, symmetrize_eps, mp_grid, & num_bands, num_kpts, num_proj, num_wann, optimisation, & - eig_found, calc_only_A, cp_pp, gamma_only, lhasproj, .true., & - .true., lsitesymmetry, use_bloch_phases, seedname, stdout, & + eig_found, calc_only_A, cp_pp, gamma_only, lhasproj, & + lsitesymmetry, use_bloch_phases, seedname, stdout, & error, comm) if (allocated(error)) call prterr(error, stdout) call w90_readwrite_clean_infile(stdout, seedname, error, comm) @@ -655,8 +655,8 @@ subroutine wannier_run(seed__name, mp_grid_loc, num_kpts_loc, real_lattice_loc, tran, verbose, wann_plot, write_data, ws_region, w90_calcs, & eigval, real_lattice, physics%bohr, symmetrize_eps, mp_grid, & num_bands, num_kpts, num_proj, num_wann, optimisation, & - eig_found, calc_only_A, cp_pp, gamma_only, lhasproj, .true., & - .false., lsitesymmetry, use_bloch_phases, seedname, stdout, & + eig_found, calc_only_A, cp_pp, gamma_only, lhasproj, & + lsitesymmetry, use_bloch_phases, seedname, stdout, & error, comm) if (allocated(error)) call prterr(error, stdout) call w90_readwrite_clean_infile(stdout, seedname, error, comm) @@ -766,20 +766,16 @@ subroutine wannier_run(seed__name, mp_grid_loc, num_kpts_loc, real_lattice_loc, end if if (gamma_only) then - call wann_main_gamma(atoms, dis_window, exclude_bands, kmesh_info, kpt_latt, out_files, & - wannierise, wann_omega, system, verbose, wann_data, m_matrix, & - u_matrix, u_matrix_opt, eigval, real_lattice, mp_grid, & - num_bands, num_kpts, num_wann, have_disentangled, & - rs_region%translate_home_cell, seedname, stdout, timer, error, comm) + call wann_main_gamma(kmesh_info, wannierise, wann_omega, verbose, wann_data, m_matrix, & + u_matrix, real_lattice, num_kpts, num_wann, stdout, timer, error, comm) if (allocated(error)) call prterr(error, stdout) else - call wann_main(atoms, dis_window, exclude_bands, hmlg, kmesh_info, kpt_latt, out_files, & - rs_region, wannierise, wann_omega, sym, system, verbose, wann_data, & - ws_region, w90_calcs, ham_k, ham_r, m_matrix_local, u_matrix, u_matrix_opt, eigval, & - real_lattice, wannier_centres_translated, irvec, mp_grid, ndegen, shift_vec, & - nrpts, num_bands, num_kpts, num_proj, num_wann, optimisation, rpt_origin, & - band_plot%mode, tran%mode, have_disentangled, lsitesymmetry, & - seedname, stdout, timer, dist_k, error, comm) + call wann_main(hmlg, kmesh_info, kpt_latt, wannierise, wann_omega, sym, verbose, wann_data, & + ws_region, w90_calcs, ham_k, ham_r, m_matrix_local, u_matrix, & + real_lattice, wannier_centres_translated, irvec, mp_grid, ndegen, & + nrpts, num_kpts, num_proj, num_wann, optimisation, rpt_origin, & + band_plot%mode, tran%mode, lsitesymmetry, & + stdout, timer, dist_k, error, comm) if (allocated(error)) call prterr(error, stdout) endif @@ -793,12 +789,12 @@ subroutine wannier_run(seed__name, mp_grid_loc, num_kpts_loc, real_lattice_loc, if (w90_calcs%wannier_plot .or. w90_calcs%bands_plot .or. w90_calcs%fermi_surface_plot .or. out_files%write_hr) then call plot_main(atoms, band_plot, dis_window, fermi_energy_list, fermi_surface_data, hmlg, & - kmesh_info, kpt_latt, out_files, plot, rs_region, spec_points, & - verbose, wann_data, wann_plot, ws_region, w90_calcs, ham_k, ham_r, m_matrix, & - u_matrix, u_matrix_opt, eigval, real_lattice, & - wannier_centres_translated, physics%bohr, irvec, mp_grid, ndegen, shift_vec, & - nrpts, num_bands, num_kpts, num_wann, rpt_origin, tran%mode, have_disentangled, & - lsitesymmetry, system%spinors, seedname, stdout, timer, error, comm) + kmesh_info, kpt_latt, out_files, plot, rs_region, spec_points, verbose, & + wann_data, wann_plot, ws_region, w90_calcs, ham_k, ham_r, m_matrix, u_matrix, & + u_matrix_opt, eigval, real_lattice, wannier_centres_translated, physics%bohr, & + irvec, mp_grid, ndegen, shift_vec, nrpts, num_bands, num_kpts, num_wann, & + rpt_origin, tran%mode, have_disentangled, lsitesymmetry, system, seedname, & + stdout, timer, dist_k, error, comm) if (allocated(error)) call prterr(error, stdout) time1 = io_time() write (stdout, '(1x,a25,f11.3,a)') 'Time for plotting ', time1 - time2, ' (sec)' diff --git a/src/wannierise.F90 b/src/wannierise.F90 index 92b870cda..aaa718862 100644 --- a/src/wannierise.F90 +++ b/src/wannierise.F90 @@ -62,10 +62,9 @@ subroutine wann_main(ham_logical, kmesh_info, kpt_latt, wann_control, omega, sit sitesym_type, ham_logical_type use w90_types, only: kmesh_info_type, print_output_type, wannier_data_type, ws_region_type, & timer_list_type - use w90_wannier90_readwrite, only: w90_wannier90_readwrite_write_chkpt use w90_utility, only: utility_frac_to_cart, utility_zgemm use w90_sitesym, only: sitesym_symmetrize_gradient - use w90_comms, only: mpisize, mpirank, comms_allreduce, comms_reduce, w90_comm_type + use w90_comms, only: mpisize, mpirank, comms_allreduce, w90_comm_type use w90_hamiltonian, only: hamiltonian_setup implicit none @@ -268,6 +267,7 @@ subroutine wann_main(ham_logical, kmesh_info, kpt_latt, wann_control, omega, sit return endif + !fixme jj shift this to writing/plot if (wann_control%precond) then call hamiltonian_setup(ham_logical, print_output, ws_region, w90_calculation, ham_k, ham_r, & real_lattice, wannier_centres_translated, irvec, mp_grid, ndegen, & @@ -2671,9 +2671,9 @@ subroutine wann_check_unitarity(num_kpts, num_wann, u_matrix, timing_level, ipri end subroutine wann_check_unitarity !================================================! - subroutine wann_main_gamma(kmesh_info, kpt_latt, wann_control, omega, print_output, & - wannier_data, m_matrix, u_matrix, real_lattice, mp_grid, & - num_kpts, num_wann, stdout, timer, error, comm) + subroutine wann_main_gamma(kmesh_info, wann_control, omega, print_output, wannier_data, & + m_matrix, u_matrix, real_lattice, num_kpts, num_wann, stdout, timer, & + error, comm) !================================================! ! ! Calculate the Unitary Rotations to give @@ -2707,10 +2707,8 @@ subroutine wann_main_gamma(kmesh_info, kpt_latt, wann_control, omega, print_outp integer, intent(in) :: stdout integer, intent(in) :: num_wann integer, intent(in) :: num_kpts - integer, intent(in) :: mp_grid(3) ! needed for write_chkpt real(kind=dp), intent(in) :: real_lattice(3, 3) - real(kind=dp), intent(in) :: kpt_latt(:, :) ! needed for write_chkpt complex(kind=dp), intent(inout) :: u_matrix(:, :, :) complex(kind=dp), intent(inout) :: m_matrix(:, :, :, :) diff --git a/utility/w90pov/src/driver.f90 b/utility/w90pov/src/driver.f90 index e720062dc..11712d061 100644 --- a/utility/w90pov/src/driver.f90 +++ b/utility/w90pov/src/driver.f90 @@ -27,9 +27,9 @@ module m_driver ! alatt = reciprocal lattice real(q) :: blatt(3, 3) ! nspecies = number of atomtypes - integer :: nspecies + !integer :: nspecies ! ntype = number of atoms of type i - integer :: ntype(100) + !integer :: ntype(100) ! natoms = number of atoms integer :: natoms ! posion = atomic positions (real coordinates)