1.2.0 UPDATE + minor REGRESSION

The code has been updated by removing any use of "select rank".

This was initially introduced by me (AA) as a way to extend the
code to handle systems with correlated and uncorrelated orbitals
(e.g. p-d models). This required a thorough update of +libdmft and
in turn also an update of the interface (I/O) of this code.
To this end I exploited one latest development of F08 using generic
rank array (dimension(..) + select rank statement).
Yet this apparently is still weakly supported by different compilers
and definitively not available on some HPC platforms using old
compiler version.

SOLUTION:
I opted for the good old function overload using explicit interfaces
for each case previously implemented in the select rank constructs.
This way the interface, although different, it should be 100% compatible.

TEST: internal tests have been all positively passed.
More tests might be required.

src/ED_AUX_FUNX.f90

@@ -12,8 +12,11 @@ MODULE ED_AUX_FUNX
 
   !> ED SET HLOC
   interface ed_set_Hloc
-     module procedure :: ed_set_Hloc_single
-     module procedure :: ed_set_Hloc_lattice
+     module procedure :: ed_set_Hloc_single_N2
+     module procedure :: ed_set_Hloc_single_N4
+     module procedure :: ed_set_Hloc_lattice_N2
+     module procedure :: ed_set_Hloc_lattice_N3
+     module procedure :: ed_set_Hloc_lattice_N5
   end interface ed_set_Hloc
 
   interface lso2nnn_reshape
@@ -164,60 +167,80 @@ end subroutine ed_set_suffix_c
 
   !+------------------------------------------------------------------+
   !PURPOSE  : Setup Himpurity, the local part of the non-interacting Hamiltonian
-    !+------------------------------------------------------------------+
-  subroutine ed_set_Hloc_single(Hloc)
-    complex(8),dimension(..),intent(in) :: Hloc
+  !+------------------------------------------------------------------+
+  subroutine ed_set_Hloc_single_N2(Hloc)
+    complex(8),dimension(:,:),intent(in) :: Hloc
 #ifdef _DEBUG
     write(Logfile,"(A)")"DEBUG ed_set_Hloc: set impHloc"
 #endif
     !
     if(allocated(impHloc))deallocate(impHloc)
     allocate(impHloc(Nspin,Nspin,Norb,Norb));impHloc=zero
     !
-    select rank(Hloc)
-    rank default;stop "ED_SET_HLOC ERROR: Hloc has a wrong rank. Accepted: [Nso,Nso] or [Nspin,Nspin,Norb,Norb]"
-    rank (2)                      !Hloc[Nso,Nso]
     call assert_shape(Hloc,[Nspin*Norb,Nspin*Norb],"ed_set_Hloc","Hloc")
     impHloc = so2nn_reshape(Hloc(1:Nspin*Norb,1:Nspin*Norb),Nspin,Norb)
-    rank (4)                      !Hloc[Nspin,Nspin,Norb,Norb]
+    if(ed_verbose>2)call print_hloc(impHloc)
+  end subroutine ed_set_Hloc_single_N2
+
+  subroutine ed_set_Hloc_single_N4(Hloc)
+    complex(8),dimension(:,:,:,:),intent(in) :: Hloc
+#ifdef _DEBUG
+    write(Logfile,"(A)")"DEBUG ed_set_Hloc: set impHloc"
+#endif
+    !
+    if(allocated(impHloc))deallocate(impHloc)
+    allocate(impHloc(Nspin,Nspin,Norb,Norb));impHloc=zero
+    !
     call assert_shape(Hloc,[Nspin,Nspin,Norb,Norb],"ed_set_Hloc","Hloc")
     impHloc = Hloc
-    end select
     if(ed_verbose>2)call print_hloc(impHloc)
-  end subroutine ed_set_Hloc_single
-
+  end subroutine ed_set_Hloc_single_N4
 
-  subroutine ed_set_Hloc_lattice(Hloc,Nlat)
-    complex(8),dimension(..),intent(in) :: Hloc
-    integer                             :: Nlat,ilat
+  subroutine ed_set_Hloc_lattice_N2(Hloc,Nlat)
+    complex(8),dimension(:,:),intent(in) :: Hloc
+    integer                              :: Nlat,ilat
 #ifdef _DEBUG
     write(Logfile,"(A)")"DEBUG ed_set_Hloc: set impHloc"
 #endif
     !
     if(allocated(Hloc_ineq))deallocate(Hloc_ineq)
     allocate(Hloc_ineq(Nlat,Nspin,Nspin,Norb,Norb));Hloc_ineq=zero
     !
-    select rank(Hloc)
-    rank default;
-    stop "ED_SET_HLOC ERROR: Hloc has a wrong rank. [Nlso,Nlso],[Nlat,Nso,Nso],[Nlat,Nspin,Nspin,Norb,Norb]"
-    !
-    rank (2)
     call assert_shape(Hloc,[Nlat*Nspin*Norb,Nlat*Nspin*Norb],'ed_set_Hloc','Hloc')
     Hloc_ineq  = lso2nnn_reshape(Hloc(1:Nlat*Nspin*Norb,1:Nlat*Nspin*Norb),Nlat,Nspin,Norb)
+  end subroutine ed_set_Hloc_lattice_N2
+
+
+  subroutine ed_set_Hloc_lattice_N3(Hloc,Nlat)
+    complex(8),dimension(:,:,:),intent(in) :: Hloc
+    integer                                :: Nlat,ilat
+#ifdef _DEBUG
+    write(Logfile,"(A)")"DEBUG ed_set_Hloc: set impHloc"
+#endif
+    !
+    if(allocated(Hloc_ineq))deallocate(Hloc_ineq)
+    allocate(Hloc_ineq(Nlat,Nspin,Nspin,Norb,Norb));Hloc_ineq=zero
     !
-    rank (3)
     call assert_shape(Hloc,[Nlat,Nspin*Norb,Nspin*Norb],'ed_set_Hloc','Hloc')
     do ilat=1,Nlat
        Hloc_ineq(ilat,:,:,:,:)  = so2nn_reshape(Hloc(ilat,1:Nspin*Norb,1:Nspin*Norb),Nspin,Norb)
     enddo
     !
-    rank (5)
+  end subroutine ed_set_Hloc_lattice_N3
+
+  subroutine ed_set_Hloc_lattice_N5(Hloc,Nlat)
+    complex(8),dimension(:,:,:,:,:),intent(in) :: Hloc
+    integer                                    :: Nlat,ilat
+#ifdef _DEBUG
+    write(Logfile,"(A)")"DEBUG ed_set_Hloc: set impHloc"
+#endif
+    !
+    if(allocated(Hloc_ineq))deallocate(Hloc_ineq)
+    allocate(Hloc_ineq(Nlat,Nspin,Nspin,Norb,Norb));Hloc_ineq=zero
+    !
     call assert_shape(Hloc,[Nlat,Nspin,Nspin,Norb,Norb],'ed_set_Hloc','Hloc')
     Hloc_ineq  = Hloc
-    end select
-  end subroutine ed_set_Hloc_lattice
-
-
+  end subroutine ed_set_Hloc_lattice_N5