Merge the new library interface

.github/workflows/config/make.inc.gfort

@@ -8,8 +8,8 @@ F90 = gfortran
 #MPIF90 = mpgfortran #mpif90
 
 # Options for debugging  When we move to 4.9 add -fsanitize=leak
-FCOPTS = -fprofile-arcs -ftest-coverage  -fstrict-aliasing  -fno-omit-frame-pointer -fno-realloc-lhs -fcheck=bounds,do,recursion,pointer -ffree-form -Wall -Waliasing -Wsurprising -Wline-truncation -Wno-tabs -Wno-uninitialized -Wno-unused-dummy-argument -Wno-unused -Wno-character-truncation -O1 -g -fbacktrace -std=f2008
-LDOPTS = -fprofile-arcs -ftest-coverage -fstrict-aliasing  -fno-omit-frame-pointer -fno-realloc-lhs -fcheck=bounds,do,recursion,pointer -ffree-form -Wall -Waliasing -Wsurprising -Wline-truncation -Wno-tabs -Wno-uninitialized -Wno-unused-dummy-argument -Wno-unused -Wno-character-truncation -O1 -g -fbacktrace -std=f2008
+FCOPTS = -fprofile-arcs -ftest-coverage  -fstrict-aliasing  -fno-omit-frame-pointer -fcheck=bounds,do,recursion,pointer -ffree-form -Wall -Waliasing -Wsurprising -Wline-truncation -Wno-tabs -Wno-uninitialized -Wno-unused-dummy-argument -Wno-unused -Wno-character-truncation -O1 -g -fbacktrace -std=f2008 -DW90DEV
+LDOPTS = -fprofile-arcs -ftest-coverage -fstrict-aliasing  -fno-omit-frame-pointer -fcheck=bounds,do,recursion,pointer -ffree-form -Wall -Waliasing -Wsurprising -Wline-truncation -Wno-tabs -Wno-uninitialized -Wno-unused-dummy-argument -Wno-unused -Wno-character-truncation -O1 -g -fbacktrace -std=f2008
 
 #=======================
 # System LAPACK and BLAS

.github/workflows/config/make.inc.gfort+openmpi

@@ -8,8 +8,8 @@ COMMS  = mpi
 MPIF90 = mpif90 
 
 # Options for debugging  When we move to 4.9 add -fsanitize=leak
-FCOPTS = -fprofile-arcs -ftest-coverage  -fstrict-aliasing  -fno-omit-frame-pointer -fno-realloc-lhs -fcheck=bounds,do,recursion,pointer -ffree-form -Wall -Waliasing -Wsurprising -Wline-truncation -Wno-tabs -Wno-uninitialized -Wno-unused-dummy-argument -Wno-unused -Wno-character-truncation -O1 -g -fbacktrace 
-LDOPTS = -fprofile-arcs -ftest-coverage -fstrict-aliasing  -fno-omit-frame-pointer -fno-realloc-lhs -fcheck=bounds,do,recursion,pointer -ffree-form -Wall -Waliasing -Wsurprising -Wline-truncation -Wno-tabs -Wno-uninitialized -Wno-unused-dummy-argument -Wno-unused -Wno-character-truncation -O1 -g -fbacktrace 
+FCOPTS = -fprofile-arcs -ftest-coverage  -fstrict-aliasing  -fno-omit-frame-pointer -fcheck=bounds,do,recursion,pointer -ffree-form -Wall -Waliasing -Wsurprising -Wline-truncation -Wno-tabs -Wno-uninitialized -Wno-unused-dummy-argument -Wno-unused -Wno-character-truncation -O1 -g -fbacktrace -DW90DEV
+LDOPTS = -fprofile-arcs -ftest-coverage -fstrict-aliasing  -fno-omit-frame-pointer -fcheck=bounds,do,recursion,pointer -ffree-form -Wall -Waliasing -Wsurprising -Wline-truncation -Wno-tabs -Wno-uninitialized -Wno-unused-dummy-argument -Wno-unused -Wno-character-truncation -O1 -g -fbacktrace 
 
 #=======================
 # System LAPACK and BLAS

.github/workflows/run_tests.sh

@@ -6,22 +6,6 @@ TESTDIR=$(pwd)/test-suite/
 echo $TESTDIR
 cd "$TESTDIR"
 
-echo "****************************************"
-echo "* RUNNING SERIAL TEST FOR LIBRARY MODE *"
-echo "****************************************"
-cd library-mode-test
-# Create the binary for testing
-make
-# remove the output file from old runs, if there
-rm -f results.dat
-# Run it - if it crashes it should give a non-zero error
-./test_library_serial.x
-# Check the output values
-./compare_results.py
-
-## Going back to the test dir
-cd "$TESTDIR"
-
 # Default: serial, no mpirun. Run these in any case
 echo "************************"
 echo "* RUNNING SERIAL TESTS *"

README.rst

@@ -95,6 +95,12 @@ The Wannier90 Developer Group includes:
 * Arash A. Mostofi  (Imperial College London, GB)
 * Jonathan R. Yates (University of Oxford, GB)
 
+In addition to the Wannier90 Developer Group, the other authors of Wannier90 v.4.x are:
+
+* Jerome Jackson    (STFC Daresbury Laboratory, UK): CCP9 code restructuring and parallel library design
+* Leon Petit        (STFC Daresbury Laboratory, UK): CCP9 code restructuring and parallel library design
+* Barry G. Searle   (STFC Daresbury Laboratory, UK): CCP9 code restructuring and parallel library design, python interface
+
 In addition to the Wannier90 Developer Group, the other authors of Wannier90 v.3.x are:
 
 * Ryotaro Arita (Riken and U. Tokyo, JP): Symmetry-adapted Wannier functions

src/Makefile.2

@@ -93,6 +93,16 @@ $(DYNLIBRARY): $(OBJS) $(OBJS) $(OBJS_LIBV1)
 clean:
 	rm -f *.o *.mod *.MOD *.obj
 
+library_interface.o : ../library_interface.F90 \
+	comms.o constants.o error_base.o io.o kmesh.o overlap.o plot.o transport.o \
+	types.o wannier90_readwrite.o wannier90_types.o wannierise.o
+	 $(COMPILER) $(POSTOPTS) $(FCOPTS) -c ../library_interface.F90
+
+c_interface.o : ../c_interface.F90 \
+	library_interface.o comms.o constants.o error_base.o io.o kmesh.o overlap.o plot.o transport.o \
+	types.o wannier90_readwrite.o wannier90_types.o wannierise.o
+	 $(COMPILER) $(POSTOPTS) $(FCOPTS) -c ../c_interface.F90
+
 constants.o: ../constants.F90
 	 $(COMPILER) $(POSTOPTS) $(FCOPTS) -c ../constants.F90
 
@@ -189,12 +199,5 @@ postw90_types.o: $(POSTDIR)postw90_types.F90 comms.o types.o utility.o constants
 postw90_readwrite.o: $(POSTDIR)postw90_readwrite.F90 comms.o postw90_types.o types.o utility.o constants.o io.o error.o
 	$(COMPILER) $(POSTOPTS) $(FCOPTS) -c $(POSTDIR)postw90_readwrite.F90
 
-wannier_lib.o: ./constants.o ./io.o ./utility.o ./types.o \
-	./hamiltonian.o ./kmesh.o ./overlap.o ./disentangle.o \
-	./wannierise.o ./plot.o ./transport.o ./wannier90_types.o \
-	./wannier90_readwrite.o ../wannier_lib.F90
-	 $(COMPILER) $(POSTOPTS) $(FCOPTS) -c ../wannier_lib.F90
-
-
 .PHONY: wannier libs post clean mpi_test w90spn2spn
 

src/Makefile.header

@@ -1,15 +1,12 @@
 OBJS  =  constants.o io.o utility.o types.o hamiltonian.o overlap.o kmesh.o disentangle.o \
         ws_distance.o wannierise.o plot.o transport.o sitesym.o comms.o wannier90_types.o \
-        wannier90_readwrite.o readwrite.o error.o error_base.o
-
-OBJS_LIBV1 = wannier_lib.o
+        wannier90_readwrite.o readwrite.o error.o error_base.o library_interface.o #c_interface.o
 
 OBJS_POST  = ws_distance.o types.o kmesh.o io.o comms.o utility.o get_oper.o constants.o \
         postw90_common.o wan_ham.o spin.o dos.o berry.o gyrotropic.o kpath.o kslice.o \
         boltzwann.o geninterp.o postw90_types.o postw90_readwrite.o readwrite.o \
 	error.o error_base.o
 
-LIBRARY = ../../libwannier.a
 LIBRARYV2 = ../../libwan2.a
 
 ## Dynamic library section

src/c_interface.F90

@@ -0,0 +1,249 @@
+
+module w90_library_c
+
+!Fortran 2018: Assumed-length character dummy argument ‘keyword’ at (1) of procedure ‘cset_option_int’ with BIND(C) attribute
+  use iso_c_binding
+  use w90_library
+  implicit none
+  public
+contains
+  type(c_ptr) function w90_create() bind(c)
+! return a c-pointer to a instance of the wannier90 library data structure
+    type(lib_common_type), pointer :: common_data
+    allocate (common_data)
+    w90_create = c_loc(common_data)
+  end function
+
+  subroutine w90_delete(common_cptr) bind(c)
+! deallocates/clears a c-pointer to a instance of the wannier90 library data structure
+    implicit none
+    type(c_ptr), value :: common_cptr
+    type(lib_common_type), pointer :: common_fptr
+    call c_f_pointer(common_cptr, common_fptr)
+    deallocate (common_fptr)
+    common_cptr = C_NULL_PTR
+  end subroutine w90_delete
+
+  subroutine cdisentangle(common_cptr, ierr) bind(c)
+    implicit none
+    type(c_ptr), value :: common_cptr
+    type(lib_common_type), pointer :: common_fptr
+    integer(kind=c_int) :: istdout, istderr, ierr
+    call w90_get_fortran_stderr(istderr)
+    call w90_get_fortran_stdout(istdout)
+    call c_f_pointer(common_cptr, common_fptr)
+    call w90_disentangle(common_fptr, istdout, istderr, ierr)
+  end subroutine cdisentangle
+
+  subroutine cwannierise(common_cptr, ierr) bind(c)
+    implicit none
+    type(c_ptr), value :: common_cptr
+    type(lib_common_type), pointer :: common_fptr
+    integer(kind=c_int) :: istdout, istderr, ierr
+    call w90_get_fortran_stderr(istderr)
+    call w90_get_fortran_stdout(istdout)
+    call c_f_pointer(common_cptr, common_fptr)
+    call w90_wannierise(common_fptr, istdout, istderr, ierr)
+  end subroutine cwannierise
+
+  subroutine cinput_setopt(common_cptr, seedname, ierr, comm) bind(c)
+! specify parameters through the library interface
+#ifdef MPI08
+    use mpi_f08
+#endif
+    implicit none
+    type(c_ptr), value :: common_cptr
+    character(*, kind=c_char) :: seedname
+    type(lib_common_type), pointer :: common_fptr
+    integer(kind=c_int) :: istderr, istdout, ierr
+#ifdef MPI08
+    type(mpi_comm), value :: comm
+#else
+    integer(kind=c_int), value :: comm
+#endif
+    call w90_get_fortran_stderr(istderr)
+    call w90_get_fortran_stdout(istdout)
+    call c_f_pointer(common_cptr, common_fptr)
+    call w90_input_setopt(common_fptr, seedname, comm, istdout, istderr, ierr)
+  end subroutine cinput_setopt
+
+  subroutine cinput_reader(common_cptr, ierr) bind(c)
+! read (optional) parameters from .win file
+    implicit none
+    type(c_ptr), value :: common_cptr
+    type(lib_common_type), pointer :: common_fptr
+    integer(kind=c_int) :: istderr, istdout, ierr
+    call w90_get_fortran_stderr(istderr)
+    call w90_get_fortran_stdout(istdout)
+    call c_f_pointer(common_cptr, common_fptr)
+    call w90_input_reader(common_fptr, istdout, istderr, ierr)
+  end subroutine cinput_reader
+
+  subroutine cset_eigval(common_cptr, eigval_cptr) bind(c)
+! copy a pointer to eigenvalue data
+    implicit none
+    type(c_ptr), value :: common_cptr, eigval_cptr
+    real(8), pointer :: eigval_fptr(:, :)
+    type(lib_common_type), pointer :: common_fptr
+    call c_f_pointer(common_cptr, common_fptr)
+    call c_f_pointer(eigval_cptr, eigval_fptr, [common_fptr%num_bands, common_fptr%num_kpts])
+    call w90_set_eigval(common_fptr, eigval_fptr)
+  end subroutine cset_eigval
+
+  subroutine cset_m_local(common_cptr, m_cptr) bind(c)
+! copy a pointer to m-matrix data
+    implicit none
+    type(c_ptr), value :: common_cptr, m_cptr
+    complex(8), pointer :: m_fptr(:, :, :, :)
+    type(lib_common_type), pointer :: common_fptr
+    call c_f_pointer(common_cptr, common_fptr)
+    call c_f_pointer(m_cptr, m_fptr, [common_fptr%num_bands, common_fptr%num_bands, &
+                                      common_fptr%kmesh_info%nntot, common_fptr%num_kpts])
+    call w90_set_m_local(common_fptr, m_fptr)
+  end subroutine cset_m_local
+
+  subroutine cset_u_matrix(common_cptr, a_cptr) bind(c)
+! copy pointer to u-matrix
+    implicit none
+    type(c_ptr), value :: common_cptr, a_cptr
+    complex(8), pointer :: a_fptr(:, :, :)
+    type(lib_common_type), pointer :: common_fptr
+    call c_f_pointer(common_cptr, common_fptr)
+    call c_f_pointer(a_cptr, a_fptr, [common_fptr%num_wann, common_fptr%num_wann, &
+                                      common_fptr%num_kpts]) ! these are reversed wrt c
+    call w90_set_u_matrix(common_fptr, a_fptr)
+  end subroutine cset_u_matrix
+
+  subroutine cset_u_opt(common_cptr, a_cptr) bind(c)
+! copy pointer to u-matrix (also used for initial projections)
+    implicit none
+    type(c_ptr), value :: common_cptr, a_cptr
+    complex(kind=8), pointer :: a_fptr(:, :, :)
+    type(lib_common_type), pointer :: common_fptr
+    call c_f_pointer(common_cptr, common_fptr)
+    call c_f_pointer(a_cptr, a_fptr, [common_fptr%num_bands, common_fptr%num_wann, &
+                                      common_fptr%num_kpts]) ! these are reversed wrt c
+    call w90_set_u_opt(common_fptr, a_fptr)
+  end subroutine cset_u_opt
+
+  subroutine cget_nn(common_cptr, n) bind(c)
+! return the number of adjacent k-points in finite difference scheme
+    implicit none
+    type(c_ptr), value :: common_cptr, n
+    type(lib_common_type), pointer :: common_fptr
+    integer(kind=c_int), pointer :: ndat
+    integer(kind=c_int) :: istderr, istdout, ierr
+    call w90_get_fortran_stderr(istderr)
+    call w90_get_fortran_stdout(istdout)
+    call c_f_pointer(common_cptr, common_fptr)
+    call c_f_pointer(n, ndat)
+    call w90_get_nn(common_fptr, ndat, istdout, istderr, ierr)
+  end subroutine cget_nn
+
+  subroutine cget_nnkp(common_cptr, nnkp) bind(c)
+! return the indexing of adjacent k-points in finite difference scheme
+    implicit none
+    type(c_ptr), value :: common_cptr, nnkp
+    type(lib_common_type), pointer :: common_fptr
+    integer(kind=c_int), pointer :: nfptr(:, :)
+    integer(kind=c_int) :: istderr, istdout, ierr
+    call w90_get_fortran_stderr(istderr)
+    call w90_get_fortran_stdout(istdout)
+    call c_f_pointer(common_cptr, common_fptr)
+    call c_f_pointer(nnkp, nfptr, [common_fptr%num_kpts, common_fptr%kmesh_info%nntot])
+    call w90_get_nnkp(common_fptr, nfptr, istdout, istderr, ierr)
+  end subroutine cget_nnkp
+
+  subroutine cget_spreads(common_cptr, spreads) bind(c)
+! returns the spreads of calulated mlwfs
+    implicit none
+    type(c_ptr), value :: common_cptr, spreads
+    type(lib_common_type), pointer :: common_fptr
+    real(kind=8), pointer :: fspreads(:)
+    call c_f_pointer(common_cptr, common_fptr)
+    call c_f_pointer(spreads, fspreads, [common_fptr%num_wann])
+    call w90_get_spreads(common_fptr, fspreads)
+  end subroutine cget_spreads
+
+  subroutine cget_centres(common_cptr, centres) bind(c)
+! returns the centres of calulated mlwfs
+    implicit none
+    type(c_ptr), value :: common_cptr, centres
+    type(lib_common_type), pointer :: common_fptr
+    real(kind=8), pointer :: fcentres(:, :)
+    call c_f_pointer(common_cptr, common_fptr)
+    call c_f_pointer(centres, fcentres, [3, common_fptr%num_wann])
+    call w90_get_centres(common_fptr, fcentres)
+  end subroutine cget_centres
+
+  subroutine cset_option_int(common_cptr, keyword, ival) bind(c)
+    implicit none
+    type(c_ptr), value :: common_cptr
+    character(*, kind=c_char) :: keyword
+    integer(kind=c_int), value  :: ival
+    type(lib_common_type), pointer :: common_fptr
+    call c_f_pointer(common_cptr, common_fptr)
+    call w90_set_option(common_fptr, keyword, ival)
+  end subroutine cset_option_int
+
+  subroutine cset_option_int3(common_cptr, keyword, ival) bind(c)
+    implicit none
+    type(c_ptr), value :: common_cptr
+    type(c_ptr) ::  ival
+    integer(kind=c_int), pointer :: m_fptr(:)
+    character(*, kind=c_char) :: keyword
+    type(lib_common_type), pointer :: common_fptr
+    call c_f_pointer(common_cptr, common_fptr)
+    call c_f_pointer(ival, m_fptr, [3])
+    call w90_set_option(common_fptr, keyword, m_fptr)
+  end subroutine cset_option_int3
+
+  subroutine cset_option_intx(common_cptr, keyword, ival, ict) bind(c)
+    implicit none
+    type(c_ptr), value :: common_cptr
+    type(c_ptr), value ::  ival
+    character(*, kind=c_char) :: keyword
+    integer(kind=c_int), value  :: ict
+    integer(kind=c_int), pointer :: m_fptr(:)
+    type(lib_common_type), pointer :: common_fptr
+    call c_f_pointer(common_cptr, common_fptr)
+    call c_f_pointer(ival, m_fptr, [ict])
+    call w90_set_option(common_fptr, keyword, m_fptr)
+  end subroutine cset_option_intx
+
+  subroutine cset_option_float(common_cptr, keyword, ival) bind(c)
+    implicit none
+    type(c_ptr), value :: common_cptr
+    character(*, kind=c_char) :: keyword
+    real(kind=c_double), value  :: ival
+    type(lib_common_type), pointer :: common_fptr
+    call c_f_pointer(common_cptr, common_fptr)
+    call w90_set_option(common_fptr, keyword, ival)
+  end subroutine cset_option_float
+
+  subroutine cset_option_float33(common_cptr, keyword, ival) bind(c)
+    implicit none
+    type(c_ptr), value :: common_cptr
+    character(*, kind=c_char) :: keyword
+    type(c_ptr)  :: ival
+    type(lib_common_type), pointer :: common_fptr
+    real(kind=8), pointer :: m_fptr(:, :)
+    call c_f_pointer(ival, m_fptr, [3, 3])
+    call c_f_pointer(common_cptr, common_fptr)
+    call w90_set_option(common_fptr, keyword, m_fptr)
+  end subroutine cset_option_float33
+
+  subroutine cset_option_floatxy(common_cptr, keyword, ival, x, y) bind(c)
+    implicit none
+    type(c_ptr), value :: common_cptr
+    character(*, kind=c_char) :: keyword
+    type(c_ptr), value  :: ival
+    integer(kind=c_int), value :: x, y
+    type(lib_common_type), pointer :: common_fptr
+    real(kind=8), pointer :: m_fptr(:, :)
+    call c_f_pointer(ival, m_fptr, [y, x]) ! these are reversed wrt c
+    call c_f_pointer(common_cptr, common_fptr)
+    call w90_set_option(common_fptr, keyword, m_fptr)
+  end subroutine cset_option_floatxy
+
+end module w90_library_c