module errors

!! cleanup before shutdown on error, preserving data if possible

!! We use interface error_stop to work with GCC < 10 instead of "select rank".

!! NOTE: To keep procedures Fortran 2003 TKR-distinct requires

!! at least one TKR-distinct non-optional variable

use, intrinsic :: iso_fortran_env, only : stderr=>error_unit

use h5fortran, only : hdf5_file

use phys_consts, only : wp

implicit none (type, external)

interface error_stop

!! polymorphic error handling

procedure dump_worker, dump_root, dump_input, dump_mag, dump_J, dump_step, dump_perturb

end interface error_stop

private

public :: error_stop

contains

subroutine dump_mag(filename, info, Br, Btheta, Bphi)

character(*), intent(in) :: filename, info

real(wp), dimension(:), intent(in) :: Br, Btheta, Bphi

type (hdf5_file) :: h

call h%open(filename, action="w")

call h%write("/Br", Br)

call h%write("/Btheta", Btheta)

call h%write("/Bphi", Bphi)

call h%write("/info", info)

call h%close()

error stop info // " dumped to " // filename

end subroutine dump_mag

subroutine dump_J(filename, info, J1, J2, J3)

character(*), intent(in) :: filename, info

real(wp), dimension(:,:,:), intent(in) :: J1, J2, J3

type (hdf5_file) :: h

call h%open(filename, action="w")

call h%write("/J1", J1)

call h%write("/J2", J2)

call h%write("/J3", J3)

call h%write("/info", info)

call h%close()

error stop info // " dumped to " // filename

end subroutine dump_J

subroutine dump_perturb(filename, info, t_elapsed, worker_id, nn, Tn, vn1, vn2, vn3)

character(*), intent(in) :: filename, info

real(wp), intent(in) :: t_elapsed

integer, intent(in) :: worker_id

real(wp), dimension(:,:,:,:), intent(in) :: nn

real(wp), dimension(:,:,:), intent(in) :: Tn, vn1, vn2, vn3

character(6) :: wid

type (hdf5_file) :: h

call h%open(filename, action="w")

call h%write("/worker_id", worker_id)

call h%write("/time/elapsed_seconds", t_elapsed)

call h%write("/nn", nn)

call h%write("/Tn", Tn)

call h%write("/vn1", vn1)

call h%write("/vn2", vn2)

call h%write("/vn3", vn3)

call h%write("/info", info)

call h%close()

write(wid, "(I0)") worker_id

error stop info // " worker " // trim(wid) // " dumped to " // filename

end subroutine dump_perturb

subroutine dump_input(filename, info, ns, vs1, Ts)

character(*), intent(in) :: filename, info

real(wp), dimension(:,:,:,:), intent(in) :: ns, vs1, Ts

type (hdf5_file) :: h

call h%open(filename, action="w")

call h%write("/vs1", vs1)

call h%write("/ns", ns)

call h%write("/Ts", Ts)

call h%write("/info", info)

call h%close()

error stop info // " dumped to " // filename

end subroutine dump_input

subroutine dump_step(filename,info, t_elapsed, worker_id, vs2,vs3,ns,vs1,Ts,Phi,J1,J2,J3)

character(*), intent(in) :: filename, info

real(wp), intent(in) :: t_elapsed

integer, intent(in) :: worker_id

real(wp), intent(in), dimension(:,:,:,:) :: vs2, vs3, ns, vs1, Ts

real(wp), intent(in), dimension(:,:,:) :: Phi, J1, J2, J3

type (hdf5_file) :: h

character(6) :: wid

call h%open(filename, action="w")

call h%write("/worker_id", worker_id)

call h%write("/time/elapsed_seconds", t_elapsed)

call h%write("/vs2", vs2)

call h%write("/vs3", vs3)

call h%write("/ns", ns)

call h%write("/vs1", vs1)

call h%write("/Ts", Ts)

call h%write("/Phi", Phi)

call h%write("/J1", J1)

call h%write("/J2", J2)

call h%write("/J3", J3)

call h%write("/info", info)

call h%close()

write(wid, "(I0)") worker_id

error stop info // " worker " // trim(wid) // " dumped to " // filename

end subroutine dump_step

subroutine dump_worker(filename, info, vs2,vs3,ns,vs1,Ts,J1,J2,J3)

character(*), intent(in) :: filename, info

real(wp), dimension(-1:,-1:,-1:,:), intent(in) :: vs2,vs3,ns,vs1,Ts

real(wp), dimension(:,:,:), intent(in) :: J1,J2,J3

type (hdf5_file) :: h

call h%open(filename, action="w")

call h%write("/vs1", vs1)

call h%write("/vs2", vs2)

call h%write("/vs3", vs3)

call h%write("/ns", ns)

call h%write("/Ts", Ts)

call h%write("/J1", J1)

call h%write("/J2", J2)

call h%write("/J3", J3)

call h%write("/info", info)

call h%close()

error stop info // " dumped to " // filename

end subroutine dump_worker

subroutine dump_root(filename,info,flagoutput,ymd,UTsec,v2avgall,v3avgall,nsall,vs1all,Tsall, &

Phiall,J1all,J2all,J3all,neall,v1avgall,Tavgall,Teall)

character(*), intent(in) :: filename, info

integer, intent(in) :: flagoutput

integer, dimension(3), intent(in) :: ymd

real(wp), intent(in) :: UTsec

real(wp), dimension(:,:,:), intent(in) :: v2avgall,v3avgall

real(wp), dimension(-1:,-1:,-1:,:), intent(in) :: nsall,vs1all,Tsall

real(wp), dimension(:,:,:), intent(in) :: Phiall

real(wp), dimension(:,:,:), intent(in) :: J1all,J2all,J3all

real(wp), dimension(:,:,:), intent(in) :: neall,v1avgall,Tavgall,Teall

type (hdf5_file) :: h

call h%open(filename, action="w")

call h%write("/flagoutput", flagoutput)

call h%write("/time/ymd", ymd)

call h%write("/time/UTsec", UTsec)

call h%write("/v2avgall", v2avgall)

call h%write("/v3avgall", v3avgall)

call h%write("/nsall", nsall)

call h%write("/vs1all", vs1all)

call h%write("/Tsall", Tsall)

call h%write("/Phiall", Phiall)

call h%write("/J1all", J1all)

call h%write("/J2all", J2all)

call h%write("/J3all", J3all)

call h%write("/neall", neall)

call h%write("/v1avgall", v1avgall)

call h%write("/Tavgall", Tavgall)

call h%write("/Teall", Teall)

call h%write("/info", info)

call h%close()

error stop info // " dumped to " // filename

end subroutine dump_root

end module errors