From d65e6626906cee339d60e25dfb23bc8743bb4e35 Mon Sep 17 00:00:00 2001 From: Edward Linscott Date: Mon, 6 Jul 2026 10:51:45 +0200 Subject: [PATCH 1/4] Fix MPI hang/abort on UNK read failure in plot_wannier Symptom: with MPI and wannier_plot enabled, a missing, unreadable, or header-mismatched UNK file for one k-point could hang or abort the run with no clean error message, instead of reporting the offending file. Cause: k-points are distributed over ranks (dist_k), so each rank reads only its own UNK files. Two rank-local failure sites inside the read loop were mishandled: 1. A header mismatch called set_error_file directly. That routine syncs the error across the communicator (comms_sync_error -> mpi_allreduce). When only the owning rank failed, it entered the allreduce while the other ranks proceeded to the comms_reduce of wann_func: mismatched collectives, i.e. a deadlock (observed as an abnormal termination on OpenMPI, an indefinite hang on stricter MPI stacks). 2. A missing file was not detected: open without status='old' recreated it empty and the subsequent unguarded read aborted with a raw EOF runtime error and no W90 message. Fix: detect missing files (inquire + status='old'), add iostat to the open and all UNK reads, and record any rank-local failure in a local status flag instead of erroring mid-loop. After the loop every rank synchronises together: failing ranks call set_error_file (naming the file), succeeding ranks call comms_sync_error(comm, error, 0), so the collective is matched and all ranks return before comms_reduce. This is the same reduce-then-set idiom already used elsewhere (e.g. the unlucky_rank path in wannier_prog.F90 and write_kmesh in library_extra.F90). Repro (test-suite testw90_cube_format, 8 k-points, formatted UNK): mpirun -np 2 wannier90.x gaas # rank 1 owns k=5-8 deleting or corrupting UNK00005.1 previously hung/aborted; it now exits nonzero within seconds with "plot_wannier: file UNK00005.1 not found (rank: 1)". Control runs (all files present) are unchanged. Co-Authored-By: Claude Fable 5 --- src/plot.F90 | 99 ++++++++++++++++++++++++++++++++++++++++------------ 1 file changed, 77 insertions(+), 22 deletions(-) diff --git a/src/plot.F90 b/src/plot.F90 index 53756001..de4f3987 100644 --- a/src/plot.F90 +++ b/src/plot.F90 @@ -1558,9 +1558,9 @@ subroutine plot_wannier(wannier_plot, wvfn_read, wannier_data, print_output, u_m use w90_types, only: wannier_data_type, atom_data_type, dis_manifold_type, print_output_type, & timer_list_type use w90_wannier90_types, only: wvfn_read_type, wannier_plot_type - use w90_comms, only: w90_comm_type + use w90_comms, only: w90_comm_type, comms_sync_error use w90_error, only: w90_error_type, set_error_alloc, set_error_dealloc, set_error_file, & - set_error_warn + set_error_warn, code_file implicit none @@ -1614,6 +1614,9 @@ subroutine plot_wannier(wannier_plot, wvfn_read, wannier_data, print_output, u_m integer :: loop_b, nx, ny, nz, npoint, file_unit, loop_w, num_inc integer :: wann_plot_num + integer :: ierr_read + character(len=60) :: errmsg_read + character(len=11) :: wfnname character(len=60) :: wanxsf, wancube character(len=9) :: cdate, ctime @@ -1741,8 +1744,10 @@ subroutine plot_wannier(wannier_plot, wvfn_read, wannier_data, print_output, u_m return end if + ierr_read = 0 + errmsg_read = '' call io_date(cdate, ctime) - do loop_kpt = 1, num_kpts + kpt_loop: do loop_kpt = 1, num_kpts if (dist_k(loop_kpt) /= my_node_id) cycle inc_band = .true. @@ -1757,20 +1762,45 @@ subroutine plot_wannier(wannier_plot, wvfn_read, wannier_data, print_output, u_m else write (wfnname, 199) loop_kpt end if + + ! A missing UNK file must be detected here rather than silently + ! (re)created by the open below (status='old' forbids creation). + inquire (file=wfnname, exist=have_file) + if (.not. have_file) then + errmsg_read = 'plot_wannier: file '//wfnname//' not found' + ierr_read = code_file + exit kpt_loop + end if if (wvfn_read%formatted) then - open (newunit=file_unit, file=wfnname, form='formatted') - read (file_unit, *) ix, iy, iz, ik, nbnd + open (newunit=file_unit, file=wfnname, form='formatted', status='old', iostat=ierr) else - open (newunit=file_unit, file=wfnname, form='unformatted') - read (file_unit) ix, iy, iz, ik, nbnd + open (newunit=file_unit, file=wfnname, form='unformatted', status='old', iostat=ierr) + end if + if (ierr /= 0) then + errmsg_read = 'plot_wannier: could not open file '//wfnname + ierr_read = code_file + exit kpt_loop + end if + if (wvfn_read%formatted) then + read (file_unit, *, iostat=ierr) ix, iy, iz, ik, nbnd + else + read (file_unit, iostat=ierr) ix, iy, iz, ik, nbnd + end if + if (ierr /= 0) then + errmsg_read = 'plot_wannier: error reading file '//wfnname + ierr_read = code_file + close (file_unit) + exit kpt_loop end if if ((ix /= ngx) .or. (iy /= ngy) .or. (iz /= ngz) .or. (ik /= loop_kpt)) then write (stdout, '(1x,a,a)') 'WARNING: mismatch in file', trim(wfnname) write (stdout, '(1x,5(a6,I5))') ' ix=', ix, ' iy=', iy, ' iz=', iz, ' ik=', ik, ' nbnd=', nbnd write (stdout, '(1x,5(a6,I5))') ' ngx=', ngx, ' ngy=', ngy, ' ngz=', ngz, ' kpt=', loop_kpt, 'bands=', num_bands - call set_error_file(error, 'plot_wannier', comm) - return + errmsg_read = 'plot_wannier: mismatch in file '//wfnname + ierr_read = code_file + close (file_unit) + exit kpt_loop end if if (have_disentangled) then @@ -1779,59 +1809,73 @@ subroutine plot_wannier(wannier_plot, wvfn_read, wannier_data, print_output, u_m if (counter > num_inc) exit if (wvfn_read%formatted) then do nx = 1, ngx*ngy*ngz - read (file_unit, *) w_real, w_imag + read (file_unit, *, iostat=ierr) w_real, w_imag + if (ierr /= 0) exit if (.not. spinors) then r_wvfn_tmp(nx, counter) = cmplx(w_real, w_imag, kind=dp) else r_wvfn_tmp_nc(nx, counter, 1) = cmplx(w_real, w_imag, kind=dp) ! up-spinor end if end do - if (spinors) then + if (ierr == 0 .and. spinors) then do nx = 1, ngx*ngy*ngz - read (file_unit, *) w_real, w_imag + read (file_unit, *, iostat=ierr) w_real, w_imag + if (ierr /= 0) exit r_wvfn_tmp_nc(nx, counter, 2) = cmplx(w_real, w_imag, kind=dp) ! down-spinor end do end if else if (.not. spinors) then - read (file_unit) (r_wvfn_tmp(nx, counter), nx=1, ngx*ngy*ngz) + read (file_unit, iostat=ierr) (r_wvfn_tmp(nx, counter), nx=1, ngx*ngy*ngz) else - read (file_unit) (r_wvfn_tmp_nc(nx, counter, 1), nx=1, ngx*ngy*ngz) ! up-spinor - read (file_unit) (r_wvfn_tmp_nc(nx, counter, 2), nx=1, ngx*ngy*ngz) ! down-spinor + read (file_unit, iostat=ierr) (r_wvfn_tmp_nc(nx, counter, 1), nx=1, ngx*ngy*ngz) ! up-spinor + if (ierr == 0) & + read (file_unit, iostat=ierr) (r_wvfn_tmp_nc(nx, counter, 2), nx=1, ngx*ngy*ngz) ! down-spinor end if end if + if (ierr /= 0) exit if (inc_band(loop_b)) counter = counter + 1 end do else do loop_b = 1, num_bands if (wvfn_read%formatted) then do nx = 1, ngx*ngy*ngz - read (file_unit, *) w_real, w_imag + read (file_unit, *, iostat=ierr) w_real, w_imag + if (ierr /= 0) exit if (.not. spinors) then r_wvfn(nx, loop_b) = cmplx(w_real, w_imag, kind=dp) else r_wvfn_nc(nx, loop_b, 1) = cmplx(w_real, w_imag, kind=dp) ! up-spinor end if end do - if (spinors) then + if (ierr == 0 .and. spinors) then do nx = 1, ngx*ngy*ngz - read (file_unit, *) w_real, w_imag + read (file_unit, *, iostat=ierr) w_real, w_imag + if (ierr /= 0) exit r_wvfn_nc(nx, loop_b, 2) = cmplx(w_real, w_imag, kind=dp) ! down-spinor end do end if else if (.not. spinors) then - read (file_unit) (r_wvfn(nx, loop_b), nx=1, ngx*ngy*ngz) + read (file_unit, iostat=ierr) (r_wvfn(nx, loop_b), nx=1, ngx*ngy*ngz) else - read (file_unit) (r_wvfn_nc(nx, loop_b, 1), nx=1, ngx*ngy*ngz) ! up-spinor - read (file_unit) (r_wvfn_nc(nx, loop_b, 2), nx=1, ngx*ngy*ngz) ! down-spinor + read (file_unit, iostat=ierr) (r_wvfn_nc(nx, loop_b, 1), nx=1, ngx*ngy*ngz) ! up-spinor + if (ierr == 0) & + read (file_unit, iostat=ierr) (r_wvfn_nc(nx, loop_b, 2), nx=1, ngx*ngy*ngz) ! down-spinor end if end if + if (ierr /= 0) exit end do end if close (file_unit) + if (ierr /= 0) then + errmsg_read = 'plot_wannier: error reading file '//wfnname + ierr_read = code_file + exit kpt_loop + end if + if (have_disentangled) then if (.not. spinors) then r_wvfn = cmplx_0 @@ -1921,7 +1965,18 @@ subroutine plot_wannier(wannier_plot, wvfn_read, wannier_data, print_output, u_m end do end do - end do !loop over kpoints + end do kpt_loop !loop over kpoints + + ! Failures above are rank-local (k-points are distributed), but + ! set_error_file is collective. Here we direct succeeding ranks to enter + ! the same synchronisation (comms_sync_error) as the failing ones rather + ! than continuing to the comms_reduce below. + if (ierr_read /= 0) then + call set_error_file(error, trim(errmsg_read), comm) + else + call comms_sync_error(comm, error, 0) + end if + if (allocated(error)) return if (spinors) then call comms_reduce(wann_func_nc(nxx_lo, nyy_lo, nzz_lo, 1, 1), & From 29358de6ce7f0d12ffd37ce40eea5b50d051039c Mon Sep 17 00:00:00 2001 From: Edward Linscott Date: Mon, 13 Jul 2026 10:08:26 +0200 Subject: [PATCH 2/4] Set UNK read errors at the failure site via set_base_error Review follow-up: record each rank-local UNK read failure directly at the failure condition with the non-collective set_base_error (the same primitive the comms module uses in its rank-divergent paths), instead of carrying ierr_read/errmsg_read flags to the end of the loop. All ranks still meet at a single comms_sync_error before the comms_reduce; an immediate collective set_error_file at the site would recreate the mismatched-collective hang this branch fixes. Re-verified (gfortran-12, OpenMPI): np=2 control byte-identical to serial modulo timestamp; missing UNK at np=2 and truncated UNK at np=4 exit with the proper werr message and no empty file created. Co-Authored-By: Claude Fable 5 --- src/plot.F90 | 37 +++++++++++++------------------------ 1 file changed, 13 insertions(+), 24 deletions(-) diff --git a/src/plot.F90 b/src/plot.F90 index de4f3987..302f2812 100644 --- a/src/plot.F90 +++ b/src/plot.F90 @@ -1560,7 +1560,7 @@ subroutine plot_wannier(wannier_plot, wvfn_read, wannier_data, print_output, u_m use w90_wannier90_types, only: wvfn_read_type, wannier_plot_type use w90_comms, only: w90_comm_type, comms_sync_error use w90_error, only: w90_error_type, set_error_alloc, set_error_dealloc, set_error_file, & - set_error_warn, code_file + set_error_warn, set_base_error, code_file implicit none @@ -1614,8 +1614,7 @@ subroutine plot_wannier(wannier_plot, wvfn_read, wannier_data, print_output, u_m integer :: loop_b, nx, ny, nz, npoint, file_unit, loop_w, num_inc integer :: wann_plot_num - integer :: ierr_read - character(len=60) :: errmsg_read + integer :: sync_code character(len=11) :: wfnname character(len=60) :: wanxsf, wancube @@ -1744,8 +1743,6 @@ subroutine plot_wannier(wannier_plot, wvfn_read, wannier_data, print_output, u_m return end if - ierr_read = 0 - errmsg_read = '' call io_date(cdate, ctime) kpt_loop: do loop_kpt = 1, num_kpts if (dist_k(loop_kpt) /= my_node_id) cycle @@ -1767,8 +1764,7 @@ subroutine plot_wannier(wannier_plot, wvfn_read, wannier_data, print_output, u_m ! (re)created by the open below (status='old' forbids creation). inquire (file=wfnname, exist=have_file) if (.not. have_file) then - errmsg_read = 'plot_wannier: file '//wfnname//' not found' - ierr_read = code_file + call set_base_error(error, 'plot_wannier: file '//wfnname//' not found', code_file) exit kpt_loop end if if (wvfn_read%formatted) then @@ -1777,8 +1773,7 @@ subroutine plot_wannier(wannier_plot, wvfn_read, wannier_data, print_output, u_m open (newunit=file_unit, file=wfnname, form='unformatted', status='old', iostat=ierr) end if if (ierr /= 0) then - errmsg_read = 'plot_wannier: could not open file '//wfnname - ierr_read = code_file + call set_base_error(error, 'plot_wannier: could not open file '//wfnname, code_file) exit kpt_loop end if if (wvfn_read%formatted) then @@ -1787,8 +1782,7 @@ subroutine plot_wannier(wannier_plot, wvfn_read, wannier_data, print_output, u_m read (file_unit, iostat=ierr) ix, iy, iz, ik, nbnd end if if (ierr /= 0) then - errmsg_read = 'plot_wannier: error reading file '//wfnname - ierr_read = code_file + call set_base_error(error, 'plot_wannier: error reading file '//wfnname, code_file) close (file_unit) exit kpt_loop end if @@ -1797,8 +1791,7 @@ subroutine plot_wannier(wannier_plot, wvfn_read, wannier_data, print_output, u_m write (stdout, '(1x,a,a)') 'WARNING: mismatch in file', trim(wfnname) write (stdout, '(1x,5(a6,I5))') ' ix=', ix, ' iy=', iy, ' iz=', iz, ' ik=', ik, ' nbnd=', nbnd write (stdout, '(1x,5(a6,I5))') ' ngx=', ngx, ' ngy=', ngy, ' ngz=', ngz, ' kpt=', loop_kpt, 'bands=', num_bands - errmsg_read = 'plot_wannier: mismatch in file '//wfnname - ierr_read = code_file + call set_base_error(error, 'plot_wannier: mismatch in file '//wfnname, code_file) close (file_unit) exit kpt_loop end if @@ -1871,8 +1864,7 @@ subroutine plot_wannier(wannier_plot, wvfn_read, wannier_data, print_output, u_m close (file_unit) if (ierr /= 0) then - errmsg_read = 'plot_wannier: error reading file '//wfnname - ierr_read = code_file + call set_base_error(error, 'plot_wannier: error reading file '//wfnname, code_file) exit kpt_loop end if @@ -1967,15 +1959,12 @@ subroutine plot_wannier(wannier_plot, wvfn_read, wannier_data, print_output, u_m end do kpt_loop !loop over kpoints - ! Failures above are rank-local (k-points are distributed), but - ! set_error_file is collective. Here we direct succeeding ranks to enter - ! the same synchronisation (comms_sync_error) as the failing ones rather - ! than continuing to the comms_reduce below. - if (ierr_read /= 0) then - call set_error_file(error, trim(errmsg_read), comm) - else - call comms_sync_error(comm, error, 0) - end if + ! Read failures in the loop above are rank-local (each rank reads only + ! its own UNK files), so some might pass and others fail. Synchronise + ! the error here. + sync_code = 0 + if (allocated(error)) sync_code = error%code + call comms_sync_error(comm, error, sync_code) if (allocated(error)) return if (spinors) then From 9832a37424417dc40cd1db233beabd6642856810 Mon Sep 17 00:00:00 2001 From: Edward Linscott Date: Mon, 13 Jul 2026 10:38:29 +0200 Subject: [PATCH 3/4] Factor the per-k-point UNK read into plot_read_unk Extract the inquire/open/header-check/band-read sequence into a private helper. Because the helper is purely rank-local, every failure site can now set the error (set_base_error) and return immediately; the caller exits the k-point loop on an allocated error and the single collective comms_sync_error after the loop is unchanged. The disentangled and direct read paths collapse into one loop (the direct case is inc_band all-true with num_inc = num_bands), and an internal plot_read_unk_band handles one band's grid sweep, removing the eight near-identical read blocks and their iostat cascades. Also add status='old'/iostat to the UNK00001 grid-dimension probe, which previously aborted with a raw EOF backtrace on a truncated file; that path is executed by all ranks, so the collective set_error_file is safe there. Verified (gfortran-12, OpenMPI): np=2 control cube byte-identical to serial; missing UNK00005.1 (np=2), truncated body (np=4), truncated header (np=2) and truncated UNK00001 (np=2) all exit cleanly with the proper werr message and no empty file created. Co-Authored-By: Claude Fable 5 --- src/plot.F90 | 260 +++++++++++++++++++++++++++++---------------------- 1 file changed, 149 insertions(+), 111 deletions(-) diff --git a/src/plot.F90 b/src/plot.F90 index 302f2812..387917c9 100644 --- a/src/plot.F90 +++ b/src/plot.F90 @@ -1595,7 +1595,7 @@ subroutine plot_wannier(wannier_plot, wvfn_read, wannier_data, print_output, u_m ! local variables real(kind=dp) :: tmax, tmaxx, x_0ang, y_0ang, z_0ang - real(kind=dp) :: fxcry(3), dirl(3, 3), w_real, w_imag, ratmax, ratio + real(kind=dp) :: fxcry(3), dirl(3, 3), ratmax, ratio real(kind=dp) :: upspinor, dnspinor, upphase, dnphase complex(kind=dp), allocatable :: wann_func(:, :, :, :) @@ -1609,8 +1609,8 @@ subroutine plot_wannier(wannier_plot, wvfn_read, wannier_data, print_output, u_m logical :: have_file, on_root integer :: num_nodes, my_node_id - integer :: i, j, nsp, nat, nbnd, counter, ierr - integer :: loop_kpt, ik, ix, iy, iz, nk, ngx, ngy, ngz, nxx, nyy, nzz + integer :: i, j, nsp, nat, nbnd, ierr + integer :: loop_kpt, nk, ngx, ngy, ngz, nxx, nyy, nzz integer :: loop_b, nx, ny, nz, npoint, file_unit, loop_w, num_inc integer :: wann_plot_num @@ -1654,13 +1654,24 @@ subroutine plot_wannier(wannier_plot, wvfn_read, wannier_data, print_output, u_m end if if (wvfn_read%formatted) then - open (newunit=file_unit, file=wfnname, form='formatted') - read (file_unit, *) ngx, ngy, ngz, nk, nbnd + open (newunit=file_unit, file=wfnname, form='formatted', status='old', iostat=ierr) else - open (newunit=file_unit, file=wfnname, form='unformatted') - read (file_unit) ngx, ngy, ngz, nk, nbnd + open (newunit=file_unit, file=wfnname, form='unformatted', status='old', iostat=ierr) + end if + if (ierr /= 0) then + call set_error_file(error, 'plot_wannier: could not open file '//wfnname, comm) + return + end if + if (wvfn_read%formatted) then + read (file_unit, *, iostat=ierr) ngx, ngy, ngz, nk, nbnd + else + read (file_unit, iostat=ierr) ngx, ngy, ngz, nk, nbnd end if close (file_unit) + if (ierr /= 0) then + call set_error_file(error, 'plot_wannier: error reading file '//wfnname, comm) + return + end if 200 format('UNK', i5.5, '.', i1) 199 format('UNK', i5.5, '.', 'NC') @@ -1760,113 +1771,16 @@ subroutine plot_wannier(wannier_plot, wvfn_read, wannier_data, print_output, u_m write (wfnname, 199) loop_kpt end if - ! A missing UNK file must be detected here rather than silently - ! (re)created by the open below (status='old' forbids creation). - inquire (file=wfnname, exist=have_file) - if (.not. have_file) then - call set_base_error(error, 'plot_wannier: file '//wfnname//' not found', code_file) - exit kpt_loop - end if - if (wvfn_read%formatted) then - open (newunit=file_unit, file=wfnname, form='formatted', status='old', iostat=ierr) - else - open (newunit=file_unit, file=wfnname, form='unformatted', status='old', iostat=ierr) - end if - if (ierr /= 0) then - call set_base_error(error, 'plot_wannier: could not open file '//wfnname, code_file) - exit kpt_loop - end if - if (wvfn_read%formatted) then - read (file_unit, *, iostat=ierr) ix, iy, iz, ik, nbnd - else - read (file_unit, iostat=ierr) ix, iy, iz, ik, nbnd - end if - if (ierr /= 0) then - call set_base_error(error, 'plot_wannier: error reading file '//wfnname, code_file) - close (file_unit) - exit kpt_loop - end if - - if ((ix /= ngx) .or. (iy /= ngy) .or. (iz /= ngz) .or. (ik /= loop_kpt)) then - write (stdout, '(1x,a,a)') 'WARNING: mismatch in file', trim(wfnname) - write (stdout, '(1x,5(a6,I5))') ' ix=', ix, ' iy=', iy, ' iz=', iz, ' ik=', ik, ' nbnd=', nbnd - write (stdout, '(1x,5(a6,I5))') ' ngx=', ngx, ' ngy=', ngy, ' ngz=', ngz, ' kpt=', loop_kpt, 'bands=', num_bands - call set_base_error(error, 'plot_wannier: mismatch in file '//wfnname, code_file) - close (file_unit) - exit kpt_loop - end if - if (have_disentangled) then - counter = 1 - do loop_b = 1, num_bands - if (counter > num_inc) exit - if (wvfn_read%formatted) then - do nx = 1, ngx*ngy*ngz - read (file_unit, *, iostat=ierr) w_real, w_imag - if (ierr /= 0) exit - if (.not. spinors) then - r_wvfn_tmp(nx, counter) = cmplx(w_real, w_imag, kind=dp) - else - r_wvfn_tmp_nc(nx, counter, 1) = cmplx(w_real, w_imag, kind=dp) ! up-spinor - end if - end do - if (ierr == 0 .and. spinors) then - do nx = 1, ngx*ngy*ngz - read (file_unit, *, iostat=ierr) w_real, w_imag - if (ierr /= 0) exit - r_wvfn_tmp_nc(nx, counter, 2) = cmplx(w_real, w_imag, kind=dp) ! down-spinor - end do - end if - else - if (.not. spinors) then - read (file_unit, iostat=ierr) (r_wvfn_tmp(nx, counter), nx=1, ngx*ngy*ngz) - else - read (file_unit, iostat=ierr) (r_wvfn_tmp_nc(nx, counter, 1), nx=1, ngx*ngy*ngz) ! up-spinor - if (ierr == 0) & - read (file_unit, iostat=ierr) (r_wvfn_tmp_nc(nx, counter, 2), nx=1, ngx*ngy*ngz) ! down-spinor - end if - end if - if (ierr /= 0) exit - if (inc_band(loop_b)) counter = counter + 1 - end do + call plot_read_unk(wfnname, wvfn_read%formatted, spinors, inc_band, num_inc, & + num_bands, loop_kpt, ngx, ngy, ngz, r_wvfn_tmp, r_wvfn_tmp_nc, & + stdout, error) else - do loop_b = 1, num_bands - if (wvfn_read%formatted) then - do nx = 1, ngx*ngy*ngz - read (file_unit, *, iostat=ierr) w_real, w_imag - if (ierr /= 0) exit - if (.not. spinors) then - r_wvfn(nx, loop_b) = cmplx(w_real, w_imag, kind=dp) - else - r_wvfn_nc(nx, loop_b, 1) = cmplx(w_real, w_imag, kind=dp) ! up-spinor - end if - end do - if (ierr == 0 .and. spinors) then - do nx = 1, ngx*ngy*ngz - read (file_unit, *, iostat=ierr) w_real, w_imag - if (ierr /= 0) exit - r_wvfn_nc(nx, loop_b, 2) = cmplx(w_real, w_imag, kind=dp) ! down-spinor - end do - end if - else - if (.not. spinors) then - read (file_unit, iostat=ierr) (r_wvfn(nx, loop_b), nx=1, ngx*ngy*ngz) - else - read (file_unit, iostat=ierr) (r_wvfn_nc(nx, loop_b, 1), nx=1, ngx*ngy*ngz) ! up-spinor - if (ierr == 0) & - read (file_unit, iostat=ierr) (r_wvfn_nc(nx, loop_b, 2), nx=1, ngx*ngy*ngz) ! down-spinor - end if - end if - if (ierr /= 0) exit - end do - end if - - close (file_unit) - - if (ierr /= 0) then - call set_base_error(error, 'plot_wannier: error reading file '//wfnname, code_file) - exit kpt_loop + call plot_read_unk(wfnname, wvfn_read%formatted, spinors, inc_band, num_bands, & + num_bands, loop_kpt, ngx, ngy, ngz, r_wvfn, r_wvfn_nc, & + stdout, error) end if + if (allocated(error)) exit kpt_loop if (have_disentangled) then if (.not. spinors) then @@ -2527,6 +2441,130 @@ end subroutine internal_xsf_format end subroutine plot_wannier + subroutine plot_read_unk(wfnname, formatted, spinors, inc_band, num_inc, num_bands, & + kpt, ngx, ngy, ngz, wvfn, wvfn_nc, stdout, error) + !! Read a single UNK file into `wvfn` (or `wvfn_nc` for spinors), keeping + !! the first `num_inc` bands flagged in `inc_band` (bands not flagged are + !! read and discarded). + !! + !! Failures are reported with the non-collective set_base_error and an + !! immediate return: the caller distributes k-points over ranks, so a + !! failure here is rank-local and must not enter a collective. The caller + !! is responsible for synchronising the error across ranks afterwards. + + use w90_constants, only: dp + use w90_error, only: w90_error_type, set_base_error, code_file + + implicit none + + character(len=*), intent(in) :: wfnname + !! Name of the UNK file to read + logical, intent(in) :: formatted + !! Whether the UNK file is formatted + logical, intent(in) :: spinors + !! Whether the wavefunctions are spinors + logical, intent(in) :: inc_band(:) + !! Bands to keep + integer, intent(in) :: num_inc + !! Number of bands to keep + integer, intent(in) :: num_bands + !! Total number of bands in the file + integer, intent(in) :: kpt + !! Expected k-point index (checked against the file header) + integer, intent(in) :: ngx, ngy, ngz + !! Expected grid dimensions (checked against the file header) + complex(kind=dp), allocatable, intent(inout) :: wvfn(:, :) + !! Destination, band as second index (caller-allocated; if .not. spinors) + complex(kind=dp), intent(inout), allocatable :: wvfn_nc(:, :, :) + !! Spinor destination, spin as third index (caller-allocated; if spinors) + integer, intent(in) :: stdout + type(w90_error_type), allocatable, intent(out) :: error + + integer :: file_unit, ierr, ix, iy, iz, ik, nbnd, counter, loop_b, ngpts + + logical :: have_file + + ngpts = ngx*ngy*ngz + + ! A missing UNK file must be detected here rather than silently + ! (re)created by the open below (status='old' forbids creation). + inquire (file=wfnname, exist=have_file) + if (.not. have_file) then + call set_base_error(error, 'plot_wannier: file '//wfnname//' not found', code_file) + return + end if + + if (formatted) then + open (newunit=file_unit, file=wfnname, form='formatted', status='old', iostat=ierr) + else + open (newunit=file_unit, file=wfnname, form='unformatted', status='old', iostat=ierr) + end if + if (ierr /= 0) then + call set_base_error(error, 'plot_wannier: could not open file '//wfnname, code_file) + return + end if + + if (formatted) then + read (file_unit, *, iostat=ierr) ix, iy, iz, ik, nbnd + else + read (file_unit, iostat=ierr) ix, iy, iz, ik, nbnd + end if + if (ierr /= 0) then + call set_base_error(error, 'plot_wannier: error reading file '//wfnname, code_file) + close (file_unit) + return + end if + + if ((ix /= ngx) .or. (iy /= ngy) .or. (iz /= ngz) .or. (ik /= kpt)) then + write (stdout, '(1x,a,a)') 'WARNING: mismatch in file', trim(wfnname) + write (stdout, '(1x,5(a6,I5))') ' ix=', ix, ' iy=', iy, ' iz=', iz, ' ik=', ik, ' nbnd=', nbnd + write (stdout, '(1x,5(a6,I5))') ' ngx=', ngx, ' ngy=', ngy, ' ngz=', ngz, ' kpt=', kpt, 'bands=', num_bands + call set_base_error(error, 'plot_wannier: mismatch in file '//wfnname, code_file) + close (file_unit) + return + end if + + counter = 1 + do loop_b = 1, num_bands + if (counter > num_inc) exit + if (.not. spinors) then + call plot_read_unk_band(wvfn(:, counter)) + else + call plot_read_unk_band(wvfn_nc(:, counter, 1)) ! up-spinor + if (ierr == 0) call plot_read_unk_band(wvfn_nc(:, counter, 2)) ! down-spinor + end if + if (ierr /= 0) then + call set_base_error(error, 'plot_wannier: error reading file '//wfnname, code_file) + close (file_unit) + return + end if + if (inc_band(loop_b)) counter = counter + 1 + end do + + close (file_unit) + + contains + + subroutine plot_read_unk_band(band) + !! Read one band's worth of grid values, leaving any failure in `ierr` + complex(kind=dp), intent(out) :: band(:) + + real(kind=dp) :: w_real, w_imag + integer :: nx + + if (formatted) then + do nx = 1, ngpts + read (file_unit, *, iostat=ierr) w_real, w_imag + if (ierr /= 0) return + band(nx) = cmplx(w_real, w_imag, kind=dp) + end do + else + read (file_unit, iostat=ierr) (band(nx), nx=1, ngpts) + end if + end subroutine plot_read_unk_band + + end subroutine plot_read_unk + !================================================! subroutine plot_u_matrices(u_matrix_opt, u_matrix, kpt_latt, dis_manifold, & have_disentangled, num_wann, num_kpts, num_bands, seedname, error, comm) From 4b65dcd8cfaa6c19f355e219693f556ee92dfc35 Mon Sep 17 00:00:00 2001 From: Edward Linscott Date: Thu, 16 Jul 2026 22:14:05 +0200 Subject: [PATCH 4/4] Use the designed error idiom: set_error_file at the site, no manual sync Review follow-up correcting an earlier misdiagnosis. The comms layer is two-tier: every synchronised collective (comms_reduce etc.) opens with the same one-integer comms_sync_error handshake that set_error_* ends with, so a single rank erroring into set_error_file is matched by the healthy ranks' next collective and the error propagates by design - there is no mismatched-collective deadlock, as verified by driving a UNK header mismatch on one rank through the pre-fix code (clean exit, correct message). What the pre-fix code actually suffered from was rank death before any error call: a missing UNK file was silently created empty by the unguarded open and the subsequent read aborted with a raw Fortran EOF runtime error. Accordingly, drop the manual comms_sync_error after the k-point loop and the set_base_error bookkeeping: each failure site in plot_read_unk now calls the ordinary collective set_error_file and returns immediately, and the caller simply returns on an allocated error. Verified (OpenMPI, gfortran-12): np=2 control byte-identical to serial; missing UNK, truncated UNK (np=4), header mismatch, and two ranks failing simultaneously all exit cleanly with the proper werr message and no empty file created. Co-Authored-By: Claude Fable 5 --- src/plot.F90 | 49 +++++++++++++++++++++---------------------------- 1 file changed, 21 insertions(+), 28 deletions(-) diff --git a/src/plot.F90 b/src/plot.F90 index 387917c9..02c37b8a 100644 --- a/src/plot.F90 +++ b/src/plot.F90 @@ -1558,9 +1558,9 @@ subroutine plot_wannier(wannier_plot, wvfn_read, wannier_data, print_output, u_m use w90_types, only: wannier_data_type, atom_data_type, dis_manifold_type, print_output_type, & timer_list_type use w90_wannier90_types, only: wvfn_read_type, wannier_plot_type - use w90_comms, only: w90_comm_type, comms_sync_error + use w90_comms, only: w90_comm_type use w90_error, only: w90_error_type, set_error_alloc, set_error_dealloc, set_error_file, & - set_error_warn, set_base_error, code_file + set_error_warn implicit none @@ -1614,8 +1614,6 @@ subroutine plot_wannier(wannier_plot, wvfn_read, wannier_data, print_output, u_m integer :: loop_b, nx, ny, nz, npoint, file_unit, loop_w, num_inc integer :: wann_plot_num - integer :: sync_code - character(len=11) :: wfnname character(len=60) :: wanxsf, wancube character(len=9) :: cdate, ctime @@ -1755,7 +1753,7 @@ subroutine plot_wannier(wannier_plot, wvfn_read, wannier_data, print_output, u_m end if call io_date(cdate, ctime) - kpt_loop: do loop_kpt = 1, num_kpts + do loop_kpt = 1, num_kpts if (dist_k(loop_kpt) /= my_node_id) cycle inc_band = .true. @@ -1774,13 +1772,13 @@ subroutine plot_wannier(wannier_plot, wvfn_read, wannier_data, print_output, u_m if (have_disentangled) then call plot_read_unk(wfnname, wvfn_read%formatted, spinors, inc_band, num_inc, & num_bands, loop_kpt, ngx, ngy, ngz, r_wvfn_tmp, r_wvfn_tmp_nc, & - stdout, error) + stdout, error, comm) else call plot_read_unk(wfnname, wvfn_read%formatted, spinors, inc_band, num_bands, & num_bands, loop_kpt, ngx, ngy, ngz, r_wvfn, r_wvfn_nc, & - stdout, error) + stdout, error, comm) end if - if (allocated(error)) exit kpt_loop + if (allocated(error)) return if (have_disentangled) then if (.not. spinors) then @@ -1871,15 +1869,7 @@ subroutine plot_wannier(wannier_plot, wvfn_read, wannier_data, print_output, u_m end do end do - end do kpt_loop !loop over kpoints - - ! Read failures in the loop above are rank-local (each rank reads only - ! its own UNK files), so some might pass and others fail. Synchronise - ! the error here. - sync_code = 0 - if (allocated(error)) sync_code = error%code - call comms_sync_error(comm, error, sync_code) - if (allocated(error)) return + end do !loop over kpoints if (spinors) then call comms_reduce(wann_func_nc(nxx_lo, nyy_lo, nzz_lo, 1, 1), & @@ -2442,18 +2432,20 @@ end subroutine internal_xsf_format end subroutine plot_wannier subroutine plot_read_unk(wfnname, formatted, spinors, inc_band, num_inc, num_bands, & - kpt, ngx, ngy, ngz, wvfn, wvfn_nc, stdout, error) + kpt, ngx, ngy, ngz, wvfn, wvfn_nc, stdout, error, comm) !! Read a single UNK file into `wvfn` (or `wvfn_nc` for spinors), keeping !! the first `num_inc` bands flagged in `inc_band` (bands not flagged are !! read and discarded). !! - !! Failures are reported with the non-collective set_base_error and an - !! immediate return: the caller distributes k-points over ranks, so a - !! failure here is rank-local and must not enter a collective. The caller - !! is responsible for synchronising the error across ranks afterwards. + !! Failures set the error and return immediately. This is safe even though + !! the caller distributes k-points over ranks: set_error_file synchronises + !! the failing rank via comms_sync_error, and the other ranks pick the + !! error up in the matching handshake at their next synchronised + !! collective (e.g. the comms_reduce after the caller's k-point loop). use w90_constants, only: dp - use w90_error, only: w90_error_type, set_base_error, code_file + use w90_comms, only: w90_comm_type + use w90_error, only: w90_error_type, set_error_file implicit none @@ -2479,6 +2471,7 @@ subroutine plot_read_unk(wfnname, formatted, spinors, inc_band, num_inc, num_ban !! Spinor destination, spin as third index (caller-allocated; if spinors) integer, intent(in) :: stdout type(w90_error_type), allocatable, intent(out) :: error + type(w90_comm_type), intent(in) :: comm integer :: file_unit, ierr, ix, iy, iz, ik, nbnd, counter, loop_b, ngpts @@ -2490,7 +2483,7 @@ subroutine plot_read_unk(wfnname, formatted, spinors, inc_band, num_inc, num_ban ! (re)created by the open below (status='old' forbids creation). inquire (file=wfnname, exist=have_file) if (.not. have_file) then - call set_base_error(error, 'plot_wannier: file '//wfnname//' not found', code_file) + call set_error_file(error, 'plot_wannier: file '//wfnname//' not found', comm) return end if @@ -2500,7 +2493,7 @@ subroutine plot_read_unk(wfnname, formatted, spinors, inc_band, num_inc, num_ban open (newunit=file_unit, file=wfnname, form='unformatted', status='old', iostat=ierr) end if if (ierr /= 0) then - call set_base_error(error, 'plot_wannier: could not open file '//wfnname, code_file) + call set_error_file(error, 'plot_wannier: could not open file '//wfnname, comm) return end if @@ -2510,7 +2503,7 @@ subroutine plot_read_unk(wfnname, formatted, spinors, inc_band, num_inc, num_ban read (file_unit, iostat=ierr) ix, iy, iz, ik, nbnd end if if (ierr /= 0) then - call set_base_error(error, 'plot_wannier: error reading file '//wfnname, code_file) + call set_error_file(error, 'plot_wannier: error reading file '//wfnname, comm) close (file_unit) return end if @@ -2519,7 +2512,7 @@ subroutine plot_read_unk(wfnname, formatted, spinors, inc_band, num_inc, num_ban write (stdout, '(1x,a,a)') 'WARNING: mismatch in file', trim(wfnname) write (stdout, '(1x,5(a6,I5))') ' ix=', ix, ' iy=', iy, ' iz=', iz, ' ik=', ik, ' nbnd=', nbnd write (stdout, '(1x,5(a6,I5))') ' ngx=', ngx, ' ngy=', ngy, ' ngz=', ngz, ' kpt=', kpt, 'bands=', num_bands - call set_base_error(error, 'plot_wannier: mismatch in file '//wfnname, code_file) + call set_error_file(error, 'plot_wannier: mismatch in file '//wfnname, comm) close (file_unit) return end if @@ -2534,7 +2527,7 @@ subroutine plot_read_unk(wfnname, formatted, spinors, inc_band, num_inc, num_ban if (ierr == 0) call plot_read_unk_band(wvfn_nc(:, counter, 2)) ! down-spinor end if if (ierr /= 0) then - call set_base_error(error, 'plot_wannier: error reading file '//wfnname, code_file) + call set_error_file(error, 'plot_wannier: error reading file '//wfnname, comm) close (file_unit) return end if