diff --git a/cmake/source_list_KKRhost.txt b/cmake/source_list_KKRhost.txt
index 62ccdffe998b3f9f19457c719e1a92e5ff4879ec..a4c9d117019d3b320921a09fe6e799adec725e62 100644
--- a/cmake/source_list_KKRhost.txt
+++ b/cmake/source_list_KKRhost.txt
@@ -389,6 +389,7 @@ add_library(lib_kkrhost STATIC
source/KKRhost/wrmoms.f90
source/KKRhost/wunfiles.F90
source/KKRhost/ylag.f90
+ source/KKRhost/write_gflle_npy.f90
)
# disable cmake auto add of 'lib' prefix to .so file
SET_TARGET_PROPERTIES(lib_kkrhost PROPERTIES PREFIX "")
diff --git a/source/KKRhost/rhovalnew.F90 b/source/KKRhost/rhovalnew.F90
index 8c4f9c3d8b06da3011e5b9a61a4a826c351fe633..fe02e44e4b7f429adac9112e72543c16b9e308ac 100644
--- a/source/KKRhost/rhovalnew.F90
+++ b/source/KKRhost/rhovalnew.F90
@@ -41,7 +41,7 @@ contains
use :: mod_save_wavefun, only: t_wavefunctions, read_wavefunc
use :: mod_runoptions, only: calc_exchange_couplings, calc_gmat_lm_full, disable_tmat_sratrick, fix_nonco_angles, &
use_qdos, write_complex_qdos, write_pkkr_operators, write_DOS_lm, set_cheby_nospeedup, &
- decouple_spins_cheby, disable_print_serialnumber
+ decouple_spins_cheby, disable_print_serialnumber, gflle_to_npy
use :: mod_version_info, only: version_print_header
use :: global_variables, only: lmmaxd, iemxd, ncleb, lmxspd, irmd, ntotd, nrmaxd, lmpotd, nspotd, nfund, korbit, mmaxd, nspind, angles_cutoff
use :: mod_constants, only: czero, cvlight, cone, pi, ci
@@ -62,6 +62,7 @@ contains
use :: mod_wunfiles, only: t_params
use :: mod_bfield, only: add_bfield
use :: mod_torque, only: calc_torque
+ use mod_write_gflle, only: write_gflle_to_npy
implicit none
@@ -400,7 +401,7 @@ contains
#else
i1_myrank = i1 ! lmlm-dos ruess
#endif
- if ((calc_gmat_lm_full) .and. (i1_myrank==1)) then ! lmlm-dos ruess
+ if ((calc_gmat_lm_full) .and. (i1_myrank==1) .and..not.gflle_to_npy) then ! lmlm-dos ruess
lrecgflle = nspin*(1+korbit)*lmmaxd*lmmaxd*ielast*nqdos ! lmlm-dos ruess
open (91, access='direct', recl=lrecgflle, file='gflle' & ! lmlm-dos ruess
, form='unformatted', status='replace', err=110, iostat=ierr) ! lmlm-dos ruess
@@ -984,7 +985,11 @@ contains
if (t_inc%i_write>0) then ! lmlm-dos
write (1337, *) 'gflle:', shape(gflle), shape(gflle_part), lrecgflle ! lmlm-dos
end if ! lmlm-dos
- write (91, rec=i1) gflle ! lmlm-dos
+ if (gflle_to_npy) then
+ call write_gflle_to_npy(lmmaxd, ielast, nqdos, i1, gflle)
+ else
+ write (91, rec=i1) gflle ! lmlm-dos
+ end if
end if ! lmlm-dos
allocate (rhotemp(irmdnew,lmpotd), stat=i_stat)
diff --git a/source/KKRhost/write_gflle_npy.f90 b/source/KKRhost/write_gflle_npy.f90
new file mode 100644
index 0000000000000000000000000000000000000000..91f4ce59a9bbef38a0e09417ee4c24396e8d53d5
--- /dev/null
+++ b/source/KKRhost/write_gflle_npy.f90
@@ -0,0 +1,1083 @@
+module m_npy
+ implicit none
+
+ integer(4), parameter :: p_un = 23
+ character, parameter :: magic_num = achar(147) ! x93
+ character, parameter :: major = achar(2) !major *.npy version
+ character, parameter :: minor = achar(0) !minor *.npy version
+ character(len=*), parameter :: zip_flag = "-q0"
+ character(len=*), parameter :: magic_str = "NUMPY"
+
+ interface save_npy
+ module procedure write_int64_vec, write_int64_mtx, &
+ write_int32_vec, write_int32_mtx, write_int32_3d, &
+ write_int16_vec, write_int16_mtx, &
+ write_int8_vec, write_int8_mtx, write_int8_3d, &
+ write_dbl_vec, write_dbl_mtx, &
+ write_sng_vec, write_sng_mtx, &
+ write_cmplx_sgn_vec, write_cmplx_sgn_mtx, &
+ write_cmplx_dbl_vec, write_cmplx_dbl_mtx, &
+ write_sng_3dT, write_dbl_3dT, &
+ write_sng_4dT, write_dbl_4dT, &
+ write_dbl_5dT, &
+ write_cmplx_dbl_3dT, &
+ write_cmplx_dbl_4dT, &
+ write_cmplx_dbl_5dT, &
+ write_cmplx_dbl_6dT
+
+ end interface save_npy
+ interface add_npz
+ module procedure addrpl_int8_vec, addrpl_int8_mtx, &
+ addrpl_int16_vec, addrpl_int16_mtx, &
+ addrpl_int32_vec, addrpl_int32_mtx, &
+ addrpl_int64_vec, addrpl_int64_mtx, &
+ addrpl_sng_vec, addrpl_sng_mtx, &
+ addrpl_dbl_vec, addrpl_dbl_mtx, &
+ addrpl_cmplx_dbl_vec, addrpl_cmplx_dbl_mtx, &
+ addrpl_cmplx_sng_vec, addrpl_cmplx_sng_mtx
+ end interface add_npz
+
+contains
+ subroutine run_sys(cmd, stat)
+ implicit none
+ character(len=*), intent(in) :: cmd
+ integer(4), intent(out) :: stat
+
+ call execute_command_line(cmd, wait=.True., exitstat=stat)
+ end subroutine run_sys
+
+ subroutine addrpl_cmplx_sng_vec(zipfile, var_name, vec)
+ implicit none
+ complex(4), intent(in) :: vec(:)
+ character(len=*), intent(in) :: zipfile, var_name
+ character(len=:), allocatable :: npy_name
+ integer(4) :: succ
+
+ npy_name = var_name//".npy"
+
+ call save_npy(npy_name, vec)
+ ! just store and be quite while zipping
+ call run_sys("zip "//zip_flag//" "//zipfile &
+ //" "//npy_name, succ)
+ if (succ /= 0) then
+ write (*, *) "Can't execute zip command"
+ endif
+
+ call run_sys("rm "//npy_name, succ)
+ if (succ /= 0) then
+ write (*, *) "Can't execute rm command"
+ endif
+ end subroutine addrpl_cmplx_sng_vec
+
+ subroutine addrpl_cmplx_sng_mtx(zipfile, var_name, mtx)
+ implicit none
+ complex(4), intent(in) :: mtx(:, :)
+ character(len=*), intent(in) :: zipfile, var_name
+ character(len=:), allocatable :: npy_name
+ integer(4) :: succ
+
+ npy_name = var_name//".npy"
+
+ call save_npy(npy_name, mtx)
+ ! just store and be quite while zipping
+ call run_sys("zip "//zip_flag//" "//zipfile &
+ //" "//npy_name, succ)
+ if (succ /= 0) then
+ write (*, *) "Can't execute zip command"
+ endif
+
+ call run_sys("rm "//npy_name, succ)
+ if (succ /= 0) then
+ write (*, *) "Can't execute rm command"
+ endif
+ end subroutine addrpl_cmplx_sng_mtx
+
+ subroutine addrpl_cmplx_dbl_vec(zipfile, var_name, vec)
+ implicit none
+ complex(8), intent(in) :: vec(:)
+ character(len=*), intent(in) :: zipfile, var_name
+ character(len=:), allocatable :: npy_name
+ integer(4) :: succ
+
+ npy_name = var_name//".npy"
+
+ call save_npy(npy_name, vec)
+ ! just store and be quite while zipping
+ call run_sys("zip "//zip_flag//" "//zipfile &
+ //" "//npy_name, succ)
+ if (succ /= 0) then
+ write (*, *) "Can't execute zip command"
+ endif
+
+ call run_sys("rm "//npy_name, succ)
+ if (succ /= 0) then
+ write (*, *) "Can't execute rm command"
+ endif
+ end subroutine addrpl_cmplx_dbl_vec
+
+ subroutine addrpl_cmplx_dbl_mtx(zipfile, var_name, mtx)
+ implicit none
+ complex(8), intent(in) :: mtx(:, :)
+ character(len=*), intent(in) :: zipfile, var_name
+ character(len=:), allocatable :: npy_name
+ integer(4) :: succ
+
+ npy_name = var_name//".npy"
+
+ call save_npy(npy_name, mtx)
+ ! just store and be quite while zipping
+ call run_sys("zip "//zip_flag//" "//zipfile &
+ //" "//npy_name, succ)
+ if (succ /= 0) then
+ write (*, *) "Can't execute zip command"
+ endif
+
+ call run_sys("rm "//npy_name, succ)
+ if (succ /= 0) then
+ write (*, *) "Can't execute rm command"
+ endif
+ end subroutine addrpl_cmplx_dbl_mtx
+
+ subroutine addrpl_dbl_vec(zipfile, var_name, vec)
+ implicit none
+ real(8), intent(in) :: vec(:)
+ character(len=*), intent(in) :: zipfile, var_name
+ character(len=:), allocatable :: npy_name
+ integer(4) :: succ
+
+ npy_name = var_name//".npy"
+
+ call save_npy(npy_name, vec)
+ ! just store and be quite while zipping
+ call run_sys("zip "//zip_flag//" "//zipfile &
+ //" "//npy_name, succ)
+ if (succ /= 0) then
+ write (*, *) "Can't execute zip command"
+ endif
+
+ call run_sys("rm "//npy_name, succ)
+ if (succ /= 0) then
+ write (*, *) "Can't execute rm command"
+ endif
+ end subroutine addrpl_dbl_vec
+
+ subroutine addrpl_dbl_mtx(zipfile, var_name, mtx)
+ implicit none
+ real(8), intent(in) :: mtx(:, :)
+ character(len=*), intent(in) :: zipfile, var_name
+ character(len=:), allocatable :: npy_name
+ integer(4) :: succ
+
+ npy_name = var_name//".npy"
+
+ call save_npy(npy_name, mtx)
+ ! just store and be quite while zipping
+ call run_sys("zip "//zip_flag//" "//zipfile &
+ //" "//npy_name, succ)
+ if (succ /= 0) then
+ write (*, *) "Can't execute zip command"
+ endif
+
+ call run_sys("rm "//npy_name, succ)
+ if (succ /= 0) then
+ write (*, *) "Can't execute rm command"
+ endif
+ end subroutine addrpl_dbl_mtx
+
+ subroutine addrpl_sng_vec(zipfile, var_name, vec)
+ implicit none
+ real(4), intent(in) :: vec(:)
+ character(len=*), intent(in) :: zipfile, var_name
+ character(len=:), allocatable :: npy_name
+ integer(4) :: succ
+
+ npy_name = var_name//".npy"
+
+ call save_npy(npy_name, vec)
+ ! just store and be quite while zipping
+ call run_sys("zip "//zip_flag//" "//zipfile &
+ //" "//npy_name, succ)
+ if (succ /= 0) then
+ write (*, *) "Can't execute zip command"
+ endif
+
+ call run_sys("rm "//npy_name, succ)
+ if (succ /= 0) then
+ write (*, *) "Can't execute rm command"
+ endif
+ end subroutine addrpl_sng_vec
+
+ subroutine addrpl_sng_mtx(zipfile, var_name, mtx)
+ implicit none
+ real(4), intent(in) :: mtx(:, :)
+ character(len=*), intent(in) :: zipfile, var_name
+ character(len=:), allocatable :: npy_name
+ integer(4) :: succ
+
+ npy_name = var_name//".npy"
+
+ call save_npy(npy_name, mtx)
+ ! just store and be quite while zipping
+ call run_sys("zip "//zip_flag//" "//zipfile &
+ //" "//npy_name, succ)
+ if (succ /= 0) then
+ write (*, *) "Can't execute zip command"
+ endif
+
+ call run_sys("rm "//npy_name, succ)
+ if (succ /= 0) then
+ write (*, *) "Can't execute rm command"
+ endif
+ end subroutine addrpl_sng_mtx
+
+ subroutine addrpl_int8_vec(zipfile, var_name, vec)
+ implicit none
+ integer(1), intent(in) :: vec(:)
+ character(len=*), intent(in) :: zipfile, var_name
+ character(len=:), allocatable :: npy_name
+ integer(4) :: succ
+
+ npy_name = var_name//".npy"
+
+ call save_npy(npy_name, vec)
+ ! just store and be quite while zipping
+ call run_sys("zip "//zip_flag//" "//zipfile &
+ //" "//npy_name, succ)
+ if (succ /= 0) then
+ write (*, *) "Can't execute zip command"
+ endif
+
+ call run_sys("rm "//npy_name, succ)
+ if (succ /= 0) then
+ write (*, *) "Can't execute rm command"
+ endif
+ end subroutine addrpl_int8_vec
+
+ subroutine addrpl_int8_mtx(zipfile, var_name, mtx)
+ implicit none
+ integer(1), intent(in) :: mtx(:, :)
+ character(len=*), intent(in) :: zipfile, var_name
+ character(len=:), allocatable :: npy_name
+ integer(4) :: succ
+
+ npy_name = var_name//".npy"
+
+ call save_npy(npy_name, mtx)
+ ! just store and be quite while zipping
+ call run_sys("zip "//zip_flag//" "//zipfile &
+ //" "//npy_name, succ)
+ if (succ /= 0) then
+ write (*, *) "Can't execute zip command"
+ endif
+
+ call run_sys("rm "//npy_name, succ)
+ if (succ /= 0) then
+ write (*, *) "Can't execute rm command"
+ endif
+ end subroutine addrpl_int8_mtx
+
+ subroutine addrpl_int16_vec(zipfile, var_name, vec)
+ implicit none
+ integer(2), intent(in) :: vec(:)
+ character(len=*), intent(in) :: zipfile, var_name
+ character(len=:), allocatable :: npy_name
+ integer(4) :: succ
+
+ npy_name = var_name//".npy"
+
+ call save_npy(npy_name, vec)
+ ! just store and be quite while zipping
+ call run_sys("zip "//zip_flag//" "//zipfile &
+ //" "//npy_name, succ)
+ if (succ /= 0) then
+ write (*, *) "Can't execute zip command"
+ endif
+
+ call run_sys("rm "//npy_name, succ)
+ if (succ /= 0) then
+ write (*, *) "Can't execute rm command"
+ endif
+ end subroutine addrpl_int16_vec
+
+ subroutine addrpl_int16_mtx(zipfile, var_name, mtx)
+ implicit none
+ integer(2), intent(in) :: mtx(:, :)
+ character(len=*), intent(in) :: zipfile, var_name
+ character(len=:), allocatable :: npy_name
+ integer(4) :: succ
+
+ npy_name = var_name//".npy"
+
+ call save_npy(npy_name, mtx)
+ ! just store and be quite while zipping
+ call run_sys("zip "//zip_flag//" "//zipfile &
+ //" "//npy_name, succ)
+ if (succ /= 0) then
+ write (*, *) "Can't execute zip command"
+ endif
+
+ call run_sys("rm "//npy_name, succ)
+ if (succ /= 0) then
+ write (*, *) "Can't execute rm command"
+ endif
+ end subroutine addrpl_int16_mtx
+
+ subroutine addrpl_int32_vec(zipfile, var_name, vec)
+ implicit none
+ integer(4), intent(in) :: vec(:)
+ character(len=*), intent(in) :: zipfile, var_name
+ character(len=:), allocatable :: npy_name
+ integer(4) :: succ
+
+ npy_name = var_name//".npy"
+
+ call save_npy(npy_name, vec)
+ ! just store and be quite while zipping
+ call run_sys("zip "//zip_flag//" "//zipfile &
+ //" "//npy_name, succ)
+ if (succ /= 0) then
+ write (*, *) "Can't execute zip command"
+ endif
+
+ call run_sys("rm "//npy_name, succ)
+ if (succ /= 0) then
+ write (*, *) "Can't execute rm command"
+ endif
+ end subroutine addrpl_int32_vec
+
+ subroutine addrpl_int32_mtx(zipfile, var_name, mtx)
+ implicit none
+ integer(4), intent(in) :: mtx(:, :)
+ character(len=*), intent(in) :: zipfile, var_name
+ character(len=:), allocatable :: npy_name
+ integer(4) :: succ
+
+ npy_name = var_name//".npy"
+
+ call save_npy(npy_name, mtx)
+ ! just store and be quite while zipping
+ call run_sys("zip "//zip_flag//" "//zipfile &
+ //" "//npy_name, succ)
+ if (succ /= 0) then
+ write (*, *) "Can't execute zip command"
+ endif
+
+ call run_sys("rm "//npy_name, succ)
+ if (succ /= 0) then
+ write (*, *) "Can't execute rm command"
+ endif
+ end subroutine addrpl_int32_mtx
+
+ subroutine addrpl_int64_vec(zipfile, var_name, vec)
+ implicit none
+ integer(8), intent(in) :: vec(:)
+ character(len=*), intent(in) :: zipfile, var_name
+ character(len=:), allocatable :: npy_name
+ integer(4) :: succ
+
+ npy_name = var_name//".npy"
+
+ call save_npy(npy_name, vec)
+ ! just store and be quite while zipping
+ call run_sys("zip "//zip_flag//" "//zipfile &
+ //" "//npy_name, succ)
+ if (succ /= 0) then
+ write (*, *) "Can't execute zip command"
+ endif
+
+ call run_sys("rm "//npy_name, succ)
+ if (succ /= 0) then
+ write (*, *) "Can't execute rm command"
+ endif
+ end subroutine addrpl_int64_vec
+
+ subroutine addrpl_int64_mtx(zipfile, var_name, mtx)
+ implicit none
+ integer(8), intent(in) :: mtx(:, :)
+ character(len=*), intent(in) :: zipfile, var_name
+ character(len=:), allocatable :: npy_name
+ integer(4) :: succ
+
+ npy_name = var_name//".npy"
+
+ call save_npy(npy_name, mtx)
+ ! just store and be quite while zipping
+ call run_sys("zip "//zip_flag//" "//zipfile &
+ //" "//npy_name, succ)
+ if (succ /= 0) then
+ write (*, *) "Can't execute zip command"
+ endif
+
+ call run_sys("rm "//npy_name, succ)
+ if (succ /= 0) then
+ write (*, *) "Can't execute rm command"
+ endif
+ end subroutine addrpl_int64_mtx
+
+ Subroutine write_cmplx_sgn_mtx(filename, mtx)
+ Implicit None
+ character(len=*), intent(in) :: filename
+ complex(4), intent(in) :: mtx(:, :)
+ character(len=*), parameter :: var_type = "<c8"
+ integer(4) :: header_len, s_mtx(2), i, j
+
+ s_mtx = shape(mtx)
+ header_len = len(dict_str(var_type, s_mtx))
+
+ open (unit=p_un, file=filename, form="unformatted", &
+ access="stream")
+ write (p_un) magic_num, magic_str, major, minor
+ write (p_un) header_len
+ write (p_un) dict_str(var_type, s_mtx)
+
+ write (p_un) mtx
+
+ close (unit=p_un)
+ End Subroutine write_cmplx_sgn_mtx
+
+ Subroutine write_cmplx_sgn_vec(filename, vec)
+ Implicit None
+ character(len=*), intent(in) :: filename
+ complex(4), intent(in) :: vec(:)
+ character(len=*), parameter :: var_type = "<c8"
+ integer(4) :: header_len, s_vec(1), i
+
+ s_vec = shape(vec)
+ header_len = len(dict_str(var_type, s_vec))
+
+ open (unit=p_un, file=filename, form="unformatted", &
+ access="stream")
+ write (p_un) magic_num, magic_str, major, minor
+ write (p_un) header_len
+
+ write (p_un) dict_str(var_type, s_vec)
+
+ write (p_un) vec
+
+ close (unit=p_un)
+ End Subroutine write_cmplx_sgn_vec
+
+ Subroutine write_cmplx_dbl_6dT(filename, tensor)
+ Implicit None
+ character(len=*), intent(in) :: filename
+ complex(8), intent(in) :: tensor(:, :, :, :, :, :)
+ character(len=*), parameter :: var_type = "<c16"
+ integer(4) :: header_len, i, j, k
+
+ header_len = len(dict_str(var_type, shape(tensor)))
+
+ open (unit=p_un, file=filename, form="unformatted", &
+ access="stream")
+ write (p_un) magic_num, magic_str, major, minor
+
+ write (p_un) header_len
+
+ write (p_un) dict_str(var_type, shape(tensor))
+ write (p_un) tensor
+ close (unit=p_un)
+ End Subroutine write_cmplx_dbl_6dT
+
+ Subroutine write_cmplx_dbl_5dT(filename, tensor)
+ Implicit None
+ character(len=*), intent(in) :: filename
+ complex(8), intent(in) :: tensor(:, :, :, :, :)
+ character(len=*), parameter :: var_type = "<c16"
+ integer(4) :: header_len, i, j, k
+
+ header_len = len(dict_str(var_type, shape(tensor)))
+
+ open (unit=p_un, file=filename, form="unformatted", &
+ access="stream")
+ write (p_un) magic_num, magic_str, major, minor
+
+ write (p_un) header_len
+
+ write (p_un) dict_str(var_type, shape(tensor))
+ write (p_un) tensor
+ close (unit=p_un)
+ End Subroutine write_cmplx_dbl_5dT
+
+ Subroutine write_cmplx_dbl_4dT(filename, tensor)
+ Implicit None
+ character(len=*), intent(in) :: filename
+ complex(8), intent(in) :: tensor(:, :, :, :)
+ character(len=*), parameter :: var_type = "<c16"
+ integer(4) :: header_len, i, j, k
+
+ header_len = len(dict_str(var_type, shape(tensor)))
+
+ open (unit=p_un, file=filename, form="unformatted", &
+ access="stream")
+ write (p_un) magic_num, magic_str, major, minor
+
+ write (p_un) header_len
+
+ write (p_un) dict_str(var_type, shape(tensor))
+ write (p_un) tensor
+ close (unit=p_un)
+ End Subroutine write_cmplx_dbl_4dT
+
+ Subroutine write_cmplx_dbl_3dT(filename, tensor)
+ Implicit None
+ character(len=*), intent(in) :: filename
+ complex(8), intent(in) :: tensor(:, :, :)
+ character(len=*), parameter :: var_type = "<c16"
+ integer(4) :: header_len, i, j, k
+
+ header_len = len(dict_str(var_type, shape(tensor)))
+
+ open (unit=p_un, file=filename, form="unformatted", &
+ access="stream")
+ write (p_un) magic_num, magic_str, major, minor
+
+ write (p_un) header_len
+
+ write (p_un) dict_str(var_type, shape(tensor))
+ write (p_un) tensor
+ close (unit=p_un)
+ End Subroutine write_cmplx_dbl_3dT
+
+ Subroutine write_cmplx_dbl_mtx(filename, mtx)
+ Implicit None
+ character(len=*), intent(in) :: filename
+ complex(8), intent(in) :: mtx(:, :)
+ character(len=*), parameter :: var_type = "<c16"
+ integer(4) :: header_len, s_mtx(2), i, j
+
+ s_mtx = shape(mtx)
+ header_len = len(dict_str(var_type, s_mtx))
+
+ open (unit=p_un, file=filename, form="unformatted", &
+ access="stream")
+ write (p_un) magic_num, magic_str, major, minor
+
+ write (p_un) header_len
+
+ write (p_un) dict_str(var_type, s_mtx)
+
+ write (p_un) mtx
+
+ close (unit=p_un)
+ End Subroutine write_cmplx_dbl_mtx
+
+ Subroutine write_cmplx_dbl_vec(filename, vec)
+ Implicit None
+ character(len=*), intent(in) :: filename
+ complex(8), intent(in) :: vec(:)
+ character(len=*), parameter :: var_type = "<c16"
+ integer(4) :: header_len, s_vec(1), i
+
+ s_vec = shape(vec)
+ header_len = len(dict_str(var_type, s_vec))
+
+ open (unit=p_un, file=filename, form="unformatted", &
+ access="stream")
+ write (p_un) magic_num, magic_str, major, minor
+
+ write (p_un) header_len
+
+ write (p_un) dict_str(var_type, s_vec)
+
+ write (p_un) vec
+
+ close (unit=p_un)
+ End Subroutine write_cmplx_dbl_vec
+
+ Subroutine write_sng_3dT(filename, tensor)
+ Implicit None
+ character(len=*), intent(in) :: filename
+ real(4), intent(in) :: tensor(:, :, :)
+ character(len=*), parameter :: var_type = "<f4"
+ integer(4) :: header_len, i, j, k
+
+ header_len = len(dict_str(var_type, shape(tensor)))
+
+ open (unit=p_un, file=filename, form="unformatted", &
+ access="stream")
+ write (p_un) magic_num, magic_str, major, minor
+
+ write (p_un) header_len
+
+ write (p_un) dict_str(var_type, shape(tensor))
+ write (p_un) tensor
+ close (unit=p_un)
+ End Subroutine write_sng_3dT
+
+ Subroutine write_sng_4dT(filename, tensor)
+ Implicit None
+ character(len=*), intent(in) :: filename
+ real(4), intent(in) :: tensor(:, :, :, :)
+ character(len=*), parameter :: var_type = "<f4"
+ integer(4) :: header_len
+
+ header_len = len(dict_str(var_type, shape(tensor)))
+
+ open (unit=p_un, file=filename, form="unformatted", &
+ access="stream")
+ write (p_un) magic_num, magic_str, major, minor
+
+ write (p_un) header_len
+
+ write (p_un) dict_str(var_type, shape(tensor))
+ write (p_un) tensor
+ close (unit=p_un)
+ End Subroutine write_sng_4dT
+
+ Subroutine write_sng_mtx(filename, mtx)
+ Implicit None
+ character(len=*), intent(in) :: filename
+ real(4), intent(in) :: mtx(:, :)
+ character(len=*), parameter :: var_type = "<f4"
+ integer(4) :: header_len, s_mtx(2), i, j
+
+ s_mtx = shape(mtx)
+ header_len = len(dict_str(var_type, s_mtx))
+
+ open (unit=p_un, file=filename, form="unformatted", &
+ access="stream")
+ write (p_un) magic_num, magic_str, major, minor
+
+ write (p_un) header_len
+
+ write (p_un) dict_str(var_type, s_mtx)
+
+ write (p_un) mtx
+
+ close (unit=p_un)
+ End Subroutine write_sng_mtx
+
+ Subroutine write_sng_vec(filename, vec)
+ Implicit None
+ character(len=*), intent(in) :: filename
+ real(4), intent(in) :: vec(:)
+ character(len=*), parameter :: var_type = "<f4"
+ integer(4) :: header_len, s_vec(1), i
+
+ s_vec = shape(vec)
+ header_len = len(dict_str(var_type, s_vec))
+
+ open (unit=p_un, file=filename, form="unformatted", &
+ access="stream")
+ write (p_un) magic_num, magic_str, major, minor
+
+ write (p_un) header_len
+
+ write (p_un) dict_str(var_type, s_vec)
+
+ write (p_un) vec
+
+ close (unit=p_un)
+ End Subroutine write_sng_vec
+
+ Subroutine write_dbl_3dT(filename, tensor)
+ Implicit None
+ character(len=*), intent(in) :: filename
+ real(8), intent(in) :: tensor(:, :, :)
+ character(len=*), parameter :: var_type = "<f8"
+ integer(4) :: header_len, i, j, k
+
+ header_len = len(dict_str(var_type, shape(tensor)))
+
+ open (unit=p_un, file=filename, form="unformatted", &
+ access="stream")
+ write (p_un) magic_num, magic_str, major, minor
+
+ write (p_un) header_len
+
+ write (p_un) dict_str(var_type, shape(tensor))
+ write (p_un) tensor
+ close (unit=p_un)
+ End Subroutine write_dbl_3dT
+
+ Subroutine write_dbl_4dT(filename, tensor4)
+ Implicit None
+ character(len=*), intent(in) :: filename
+ real(8), intent(in) :: tensor4(:, :, :, :)
+ character(len=*), parameter :: var_type = "<f8"
+ integer(4) :: header_len, i, j, k
+
+ header_len = len(dict_str(var_type, shape(tensor4)))
+
+ open (unit=p_un, file=filename, form="unformatted", &
+ access="stream")
+ write (p_un) magic_num, magic_str, major, minor
+
+ write (p_un) header_len
+
+ write (p_un) dict_str(var_type, shape(tensor4))
+ write (p_un) tensor4
+ close (unit=p_un)
+ End Subroutine write_dbl_4dT
+
+ Subroutine write_dbl_5dT(filename, tensor5)
+ Implicit None
+ character(len=*), intent(in) :: filename
+ real(8), intent(in) :: tensor5(:, :, :, :, :)
+ character(len=*), parameter :: var_type = "<f8"
+ integer(4) :: header_len, i, j, k
+
+ header_len = len(dict_str(var_type, shape(tensor5)))
+
+ open (unit=p_un, file=filename, form="unformatted", &
+ access="stream")
+ write (p_un) magic_num, magic_str, major, minor
+
+ write (p_un) header_len
+
+ write (p_un) dict_str(var_type, shape(tensor5))
+ write (p_un) tensor5
+ close (unit=p_un)
+ End Subroutine write_dbl_5dT
+
+ Subroutine write_dbl_mtx(filename, mtx)
+ Implicit None
+ character(len=*), intent(in) :: filename
+ real(8), intent(in) :: mtx(:, :)
+ character(len=*), parameter :: var_type = "<f8"
+ integer(4) :: header_len, s_mtx(2), i, j
+
+ s_mtx = shape(mtx)
+ header_len = len(dict_str(var_type, s_mtx))
+
+ open (unit=p_un, file=filename, form="unformatted", &
+ access="stream")
+ write (p_un) magic_num, magic_str, major, minor
+
+ write (p_un) header_len
+
+ write (p_un) dict_str(var_type, s_mtx)
+
+ write (p_un) mtx
+
+ close (unit=p_un)
+ End Subroutine write_dbl_mtx
+
+ Subroutine write_dbl_vec(filename, vec)
+ Implicit None
+ character(len=*), intent(in) :: filename
+ real(8), intent(in) :: vec(:)
+ character(len=*), parameter :: var_type = "<f8"
+ integer(4) :: header_len, s_vec(1), i
+
+ s_vec = shape(vec)
+ header_len = len(dict_str(var_type, s_vec))
+
+ open (unit=p_un, file=filename, form="unformatted", &
+ access="stream")
+ write (p_un) magic_num, magic_str, major, minor
+
+ write (p_un) header_len
+
+ write (p_un) dict_str(var_type, s_vec)
+
+ write (p_un) vec
+
+ close (unit=p_un)
+ End Subroutine write_dbl_vec
+
+ Subroutine write_int64_mtx(filename, mtx)
+ Implicit None
+ character(len=*), intent(in) :: filename
+ integer(8), intent(in) :: mtx(:, :)
+ character(len=*), parameter :: var_type = "<i8"
+ integer(4) :: header_len, s_mtx(2), i, j
+
+ s_mtx = shape(mtx)
+ header_len = len(dict_str(var_type, s_mtx))
+
+ open (unit=p_un, file=filename, form="unformatted", &
+ access="stream")
+ write (p_un) magic_num, magic_str, major, minor
+
+ write (p_un) header_len
+
+ write (p_un) dict_str(var_type, s_mtx)
+
+ write (p_un) mtx
+
+ close (unit=p_un)
+ End Subroutine write_int64_mtx
+
+ Subroutine write_int64_vec(filename, vec)
+ Implicit None
+ character(len=*), intent(in) :: filename
+ integer(8), intent(in) :: vec(:)
+ character(len=*), parameter :: var_type = "<i8"
+ integer(4) :: header_len, s_vec(1), i
+
+ s_vec = shape(vec)
+ header_len = len(dict_str(var_type, s_vec))
+
+ open (unit=p_un, file=filename, form="unformatted", &
+ access="stream")
+ write (p_un) magic_num, magic_str, major, minor
+
+ write (p_un) header_len
+
+ write (p_un) dict_str(var_type, s_vec)
+
+ write (p_un) vec
+
+ close (unit=p_un)
+ End Subroutine write_int64_vec
+
+ Subroutine write_int32_mtx(filename, mtx)
+ Implicit None
+ character(len=*), intent(in) :: filename
+ integer(4), intent(in) :: mtx(:, :)
+ character(len=*), parameter :: var_type = "<i4"
+ integer(4) :: header_len, s_mtx(2), i, j
+
+ s_mtx = shape(mtx)
+ header_len = len(dict_str(var_type, s_mtx))
+
+ open (unit=p_un, file=filename, form="unformatted", &
+ access="stream")
+ write (p_un) magic_num, magic_str, major, minor
+
+ write (p_un) header_len
+
+ write (p_un) dict_str(var_type, s_mtx)
+
+ write (p_un) mtx
+
+ close (unit=p_un)
+ End Subroutine write_int32_mtx
+
+ Subroutine write_int32_3d(filename, mtx)
+ Implicit None
+ character(len=*), intent(in) :: filename
+ integer(4), intent(in) :: mtx(:,:,:)
+ character(len=*), parameter :: var_type = "<i4"
+ integer(4) :: header_len, s_mtx(3), i, j
+
+ s_mtx = shape(mtx)
+ header_len = len(dict_str(var_type, s_mtx))
+
+ open (unit=p_un, file=filename, form="unformatted", &
+ access="stream")
+ write (p_un) magic_num, magic_str, major, minor
+
+ write (p_un) header_len
+
+ write (p_un) dict_str(var_type, s_mtx)
+
+ write (p_un) mtx
+
+ close (unit=p_un)
+ End Subroutine write_int32_3d
+
+ Subroutine write_int32_vec(filename, vec)
+ Implicit None
+ character(len=*), intent(in) :: filename
+ integer(4), intent(in) :: vec(:)
+ character(len=*), parameter :: var_type = "<i4"
+ integer(4) :: header_len, s_vec(1), i
+
+ s_vec = shape(vec)
+ header_len = len(dict_str(var_type, s_vec))
+
+ open (unit=p_un, file=filename, form="unformatted", &
+ access="stream")
+ write (p_un) magic_num, magic_str, major, minor
+
+ write (p_un) header_len
+
+ write (p_un) dict_str(var_type, s_vec)
+
+ write (p_un) vec
+
+ close (unit=p_un)
+ End Subroutine write_int32_vec
+
+ Subroutine write_int16_mtx(filename, mtx)
+ Implicit None
+ character(len=*), intent(in) :: filename
+ integer(2), intent(in) :: mtx(:, :)
+ character(len=*), parameter :: var_type = "<i2"
+ integer(4) :: header_len, s_mtx(2), i, j
+
+ s_mtx = shape(mtx)
+ header_len = len(dict_str(var_type, s_mtx))
+
+ open (unit=p_un, file=filename, form="unformatted", &
+ access="stream")
+ write (p_un) magic_num, magic_str, major, minor
+
+ write (p_un) header_len
+
+ write (p_un) dict_str(var_type, s_mtx)
+
+ write (p_un) mtx
+
+ close (unit=p_un)
+ End Subroutine write_int16_mtx
+
+ Subroutine write_int16_vec(filename, vec)
+ Implicit None
+ character(len=*), intent(in) :: filename
+ integer(2), intent(in) :: vec(:)
+ character(len=*), parameter :: var_type = "<i2"
+ integer(4) :: header_len, s_vec(1), i
+
+ s_vec = shape(vec)
+ header_len = len(dict_str(var_type, s_vec))
+
+ open (unit=p_un, file=filename, form="unformatted", &
+ access="stream")
+ write (p_un) magic_num, magic_str, major, minor
+
+ write (p_un) header_len
+
+ write (p_un) dict_str(var_type, s_vec)
+
+ write (p_un) vec
+
+ close (unit=p_un)
+ End Subroutine write_int16_vec
+
+ Subroutine write_int8_mtx(filename, mtx)
+ Implicit None
+ character(len=*), intent(in) :: filename
+ integer(1), intent(in) :: mtx(:, :)
+ character(len=*), parameter :: var_type = "<i1"
+ integer(4) :: header_len, s_mtx(2), i, j
+
+ s_mtx = shape(mtx)
+ header_len = len(dict_str(var_type, s_mtx))
+
+ open (unit=p_un, file=filename, form="unformatted", &
+ access="stream")
+ write (p_un) magic_num, magic_str, major, minor
+
+ write (p_un) header_len
+
+ write (p_un) dict_str(var_type, s_mtx)
+
+ write (p_un) mtx
+
+ close (unit=p_un)
+ End Subroutine write_int8_mtx
+
+ Subroutine write_int8_3d(filename, mtx)
+ Implicit None
+ character(len=*), intent(in) :: filename
+ integer(1), intent(in) :: mtx(:,:,:)
+ character(len=*), parameter :: var_type = "<i1"
+ integer(4) :: header_len, s_mtx(3), i, j
+
+ s_mtx = shape(mtx)
+ header_len = len(dict_str(var_type, s_mtx))
+
+ open (unit=p_un, file=filename, form="unformatted", &
+ access="stream")
+ write (p_un) magic_num, magic_str, major, minor
+
+ write (p_un) header_len
+
+ write (p_un) dict_str(var_type, s_mtx)
+
+ write (p_un) mtx
+
+ close (unit=p_un)
+ End Subroutine write_int8_3d
+
+ Subroutine write_int8_vec(filename, vec)
+ Implicit None
+ character(len=*), intent(in) :: filename
+ integer(1), intent(in) :: vec(:)
+ character(len=*), parameter :: var_type = "<i1"
+ integer(4) :: header_len, s_vec(1), i
+
+ s_vec = shape(vec)
+ header_len = len(dict_str(var_type, s_vec))
+
+ open (unit=p_un, file=filename, form="unformatted", &
+ access="stream")
+ write (p_un) magic_num, magic_str, major, minor
+
+ write (p_un) header_len
+
+ write (p_un) dict_str(var_type, s_vec)
+
+ write (p_un) vec
+
+ close (unit=p_un)
+ End Subroutine write_int8_vec
+
+ function dict_str(var_type, var_shape) result(str)
+ implicit none
+ character(len=*), intent(in) :: var_type
+ integer(4), intent(in) :: var_shape(:)
+ character(len=:), allocatable :: str
+ integer(4) :: cnt
+
+ cnt = len("{'descr': '")
+ cnt = cnt + len(var_type)
+ cnt = cnt + len("', 'fortran_order': True, 'shape': (")
+ cnt = cnt + len(shape_str(var_shape))
+ cnt = cnt + len(",), }")
+ do while (mod(cnt + 10, 16) /= 0)
+ cnt = cnt + 1
+ enddo
+
+ allocate (character(cnt) :: str)
+
+ str = "{'descr': '"//var_type// &
+ "', 'fortran_order': True, 'shape': ("// &
+ shape_str(var_shape)//"), }"
+
+ do while (mod(len(str) + 11, 16) /= 0)
+ str = str//" "
+ enddo
+
+ str = str//achar(10)
+
+ end function dict_str
+
+ function shape_str(var_shape) result(fin_str)
+ implicit none
+ integer(4), intent(in) :: var_shape(:)
+ character(len=:), allocatable :: str, small_str, fin_str
+ integer(4) :: i, length, start, halt
+
+ length = 14*size(var_shape)
+ allocate (character(length) :: str)
+ allocate (character(14) :: small_str)
+ str = " "
+
+ do i = 1, size(var_shape)
+ start = (i - 1)*length + 1
+ halt = i*length + 1
+ write (small_str, "(I13,A)") var_shape(i), ","
+ str = trim(str)//adjustl(small_str)
+ enddo
+
+ fin_str = trim(str)
+ end function shape_str
+end module m_npy
+
+
+module mod_write_gflle
+
+ implicit none
+
+contains
+
+ subroutine write_gflle_to_npy(lmmaxd, ielast, nqdos, i1, gflle)
+
+ use mod_datatypes, only: dp
+ use m_npy, only: save_npy
+ implicit none
+ integer, intent(in) :: lmmaxd, ielast, nqdos, i1
+ complex (kind=dp) :: gflle(lmmaxd,lmmaxd,ielast,nqdos)
+ character (len=100) :: filename
+ integer :: ie
+ do ie = 1, ielast
+ write(filename, "(A,1I0.3,A,1I0.3,A)") "gllke.", I1, ".", IE, ".npy"
+ call save_npy(trim(filename), gflle(:,:,ie, :))
+ end do
+
+ end subroutine write_gflle_to_npy
+
+end module mod_write_gflle
diff --git a/source/common/runoptions.F90 b/source/common/runoptions.F90
index df8995987389a42c5e6646a4b3088ed9afe2a800..09e112ac86c155c5be29b9243713a66252bf894a 100644
--- a/source/common/runoptions.F90
+++ b/source/common/runoptions.F90
@@ -25,6 +25,7 @@ module mod_runoptions
logical :: calc_exchange_couplings = .false. !!calculate magnetic exchange coupling parameters (former: 'XCPL')
logical :: calc_exchange_couplings_energy = .false. !!write energy-resolved Jij-files also if npol/=0 (former: 'Jijenerg')
logical :: calc_gmat_lm_full = .false. !!calculate all lm-lm components of systems greens function and store to file `gflle` (former: 'lmlm-dos')
+ logical :: gflle_to_npy = .false. !!write gflle file to npy instead of to gflle file (contains G(k,e)LL'
logical :: dirac_scale_SpeefOfLight = .false. !!scale the speed of light for Dirac solver (former: 'CSCALE')
logical :: disable_charge_neutrality = .false. !!no charge neutrailty required: leaving Fermi level unaffected (former: 'no-neutr')
logical :: disable_print_serialnumber = .false. !!deactivate writing of serial number and version information to files (for backwards compatibility) (former: 'noserial')
@@ -155,6 +156,7 @@ module mod_runoptions
call set_runoption(write_lloyd_tralpha_file , '<write_lloyd_tralpha_file>' , '<wrttral>' )
call set_runoption(write_lloyd_cdos_file , '<write_lloyd_cdos_file>' , '<wrtcdos>' )
call set_runoption(calc_gmat_lm_full , '<calc_gmat_lm_full>' , '<lmlm-dos>')
+ call set_runoption(gflle_to_npy , '<gflle_to_npy>')
call set_runoption(simulate_asa , '<simulate_asa>' , '<simulasa>')
call set_runoption(use_readcpa , '<use_readcpa>' , '<readcpa>' )
call set_runoption(print_kpoints , '<print_kpoints>' , '<BZKP>' )
@@ -694,6 +696,7 @@ module mod_runoptions
call mpi_bcast(write_lloyd_tralpha_file , 1, mpi_logical, master, mpi_comm_world, ierr)
call mpi_bcast(write_lloyd_cdos_file , 1, mpi_logical, master, mpi_comm_world, ierr)
call mpi_bcast(calc_gmat_lm_full , 1, mpi_logical, master, mpi_comm_world, ierr)
+ call mpi_bcast(gflle_to_npy , 1, mpi_logical, master, mpi_comm_world, ierr)
call mpi_bcast(simulate_asa , 1, mpi_logical, master, mpi_comm_world, ierr)
call mpi_bcast(use_readcpa , 1, mpi_logical, master, mpi_comm_world, ierr)
call mpi_bcast(print_kpoints , 1, mpi_logical, master, mpi_comm_world, ierr)
@@ -800,6 +803,7 @@ module mod_runoptions
write(iounit, '(A35,1x,1L,3x,A)') '<calc_exchange_couplings>=', calc_exchange_couplings, "calculate magnetic exchange coupling parameters (former: 'XCPL')"
write(iounit, '(A35,1x,1L,3x,A)') '<calc_exchange_couplings_energy>=', calc_exchange_couplings_energy, "write energy-resolved Jij-files also if npol/=0 (former: 'Jijenerg')"
write(iounit, '(A35,1x,1L,3x,A)') '<calc_gmat_lm_full>=', calc_gmat_lm_full, "calculate all lm-lm components of systems greens function and store to file `gflle` (former: 'lmlm-dos')"
+ write(iounit, '(A35,1x,1L,3x,A)') '<gflle_to_npy>=', gflle_to_npy, "Write G_LL'(k,E) to npy files, one file per atom and energy"
write(iounit, '(A35,1x,1L,3x,A)') '<dirac_scale_SpeefOfLight>=', dirac_scale_SpeefOfLight, "scale the speed of light for Dirac solver (former: 'CSCALE')"
write(iounit, '(A35,1x,1L,3x,A)') '<disable_charge_neutrality>=', disable_charge_neutrality, "no charge neutrailty required: leaving Fermi level unaffected (former: 'no-neutr')"
write(iounit, '(A35,1x,1L,3x,A)') '<disable_print_serialnumber>=', disable_print_serialnumber, "deactivate writing of serial number and version information to files (for backwards compatibility) (former: 'noserial')"