M(4.1): sparsity_handling wrong var; write_subs IO list

Src/m_sparsity_handling.F90

@@ -31,9 +31,16 @@ module m_sparsity_handling
   public :: Sp_retain_region
   public :: Sp_remove_region2region
   public :: Sp_to_Spglobal
-  public :: dSpData1D_to_Sp
-  public :: dSpData2D_to_Sp
-  public :: dSpData2D_interp
+  interface SpData_to_Sp
+    module procedure dSpData1D_to_Sp
+    module procedure dSpData2D_to_Sp
+  end interface SpData_to_Sp
+  public :: SpData_to_Sp
+
+  interface SpData_interp
+    module procedure dSpData2D_interp
+  end interface SpData_interp
+  public :: SpData_interp
 
 contains
 
@@ -846,7 +853,7 @@ contains
     integer, pointer :: l_ncol(:) , l_ptr(:) , l_col(:)
     integer, pointer :: n_ncol(:), n_ptr(:), n_col(:)
     integer :: lio, io, nr, lnr, lind, rind, nind
-    integer :: dim_sp
+    integer :: sp_dim
     integer :: d
 
     ! get value and distribution
@@ -855,9 +862,9 @@ contains
     sp  => spar(A)
 
     ! Create the data array for the reduced size
-    dim_sp = spar_dim(A)
+    sp_dim = spar_dim(A)
     io = nnzs(out)
-    if ( dim_sp == 1 ) then
+    if ( sp_dim == 1 ) then
        d = size(inA,dim=2)
        call newdData2D(dat,io,d,trim(name(A))//' reduced')
     else
@@ -883,7 +890,7 @@ contains
        if ( l_ncol(lio) /= 0 ) then
        if ( n_ncol(lio) /= 0 ) then
        
-       select case ( d )
+       select case ( sp_dim )
        case ( 1 )
           do lind = l_ptr(lio) + 1 , l_ptr(lio) + l_ncol(lio)
              
@@ -920,7 +927,8 @@ contains
 !$OMP end parallel do
 
     ! copy over data
-    call newdSpData2D(out,dat,dit,B,trim(name(A))//' reduced')
+    call newdSpData2D(out,dat,dit,B,trim(name(A))//' reduced', &
+        sparsity_dim=sp_dim)
 
     ! Delete the data (we have copied it...)
     call delete(dat)
@@ -951,30 +959,38 @@ contains
     ! Get the dimensionality and the sparsity dimension
     sp_dim = spar_dim(A_2Ds(1))
     if ( sp_dim == 1 ) then
-       dim2 = size(array(1)%v(1,:))
+      dim2 = size(array(1)%v, dim=2)
     else
-       call die('How on earth should we interpolate &
-            &dependent data...')
+      dim2 = size(array(1)%v, dim=1)
     end if
     n_nzs = nnzs(A_2Ds(1))
 
-    ! figure out the sparsity dimension
 !$OMP parallel default(shared), private(j,io,i,y)
-    
-    do j = 1 , dim2
+
+    select case ( sp_dim )
+    case ( 1 )
+      do j = 1 , dim2
 !$OMP do
-       do io = 1 , n_nzs
-          
-          ! Copy over 
+        do io = 1 , n_nzs
           do i = 1 , N
-             y(i) = array(i)%v(io,j)
+            y(i) = array(i)%v(io,j)
           end do
-
           call interp_spline(N,x,y,x0, array(1)%v(io,j))
-          
-       end do
+        end do
 !$OMP end do nowait
-    end do
+      end do
+    case ( 2 )
+!$OMP do
+      do io = 1 , n_nzs
+        do j = 1 , dim2
+          do i = 1 , N
+            y(i) = array(i)%v(j,io)
+          end do
+          call interp_spline(N,x,y,x0, array(1)%v(j,io))
+        end do
+      end do
+!$OMP end do nowait
+    end select
 !$OMP end parallel
 
   end subroutine dSpData2D_interp

Src/write_subs.F

@@ -115,7 +115,6 @@
                ps = mstress + kin_stress
                write(6,'(/,a,6f12.2)')
      .   'Inter molecular stress Voigt[x,y,z,yz,xz,xy] (kbar):',
-     .           ' (kbar):',
      .           (ps(jx,jx)/kbar,jx=1,3),
      $            ps(2,3)/kbar,
      $            ps(1,3)/kbar,

Util/TS/TBtrans/m_tbt_hs.F90

@@ -337,7 +337,7 @@ contains
 !    call print_type(files(N_HS)%H_2D)
 
     ! Now we interpolate the 
-    call dSpData2D_interp(N_HS,files(:)%H_2D,tHS(:)%Volt,Volt)
+    call SpData_interp(N_HS,files(:)%H_2D,tHS(:)%Volt,Volt)
 
     ! Now files(1) contains the interpolated values
     ! copy files(1) to the original one...

Util/TS/TBtrans/tbt_init.F90

@@ -312,10 +312,10 @@ subroutine tbt_init()
   end if
 
   ! Change the data 
-  call dSpData1D_to_Sp(TSHS%S_1D,tmp_sp,tmp_1D)
+  call SpData_to_Sp(TSHS%S_1D,tmp_sp,tmp_1D)
   TSHS%S_1D = tmp_1D
   call delete(tmp_1D)
-  call dSpData2D_to_Sp(TSHS%H_2D,tmp_sp,tmp_2D)
+  call SpData_to_Sp(TSHS%H_2D,tmp_sp,tmp_2D)
   TSHS%H_2D = tmp_2D
   call delete(tmp_2D)
   TSHS%sp = tmp_sp