Debugged DiagModule.f90

Debugged DiagModule.f90 and add minor changes (some comments) to ScalapackFormat.f90 and DiagModule.f90
(Main bug in DiagModule.f90 was in PrepareRecv.

src/DiagModule.f90

@@ -1035,6 +1035,8 @@ contains
   !!   2017/06/22 dave
   !!   Made descriptors module variables
   !!   Moved many operations out to new routines so this contains only work needed each time
+  !!   2023/07/24 tsuyoshi
+  !!   - Change for padding H and S matrices
   !!  SOURCE
   !!
   subroutine initDiag
@@ -1071,15 +1073,15 @@ contains
 
     allocate(w(matrix_size_padH,nkp,nspin), occ(matrix_size,nkp,nspin), STAT=stat)
     if (stat /= 0) call cq_abort('initDiag: failed to allocate w and occ', stat)
-    call reg_alloc_mem(area_DM, 2 * matrix_size * nkp * nspin, type_dbl)
+    call reg_alloc_mem(area_DM, (matrix_size+matrix_size_padH) * nkp * nspin, type_dbl)
 
     allocate(local_w(matrix_size_padH, nspin), STAT=stat)
     if (stat /= 0) call cq_abort('initDiag: failed to allocate local_w', stat)
-    call reg_alloc_mem(area_DM, matrix_size * nspin, type_dbl)
+    call reg_alloc_mem(area_DM, matrix_size_padH * nspin, type_dbl)
 
     allocate(ifail(matrix_size_padH), iclustr(2 * proc_rows * proc_cols), STAT=stat)
     if (stat /= 0) call cq_abort("initDiag: failed to allocate ifail and iclustr", stat)
-    call reg_alloc_mem(area_DM, matrix_size + 2 * proc_rows * proc_cols, type_int)
+    call reg_alloc_mem(area_DM, matrix_size_padH + 2 * proc_rows * proc_cols, type_int)
 
     allocate(gap(proc_rows * proc_cols), STAT=stat)
     if (stat /= 0) call cq_abort("initDiag: failed to allocate gap", stat)
@@ -1120,6 +1122,8 @@ contains
   !! CREATION DATE
   !!   2012/03/08
   !! MODIFICATION HISTORY
+  !!   2023/07/24 tsuyoshi
+  !!   - Change for padding H and S matrices
   !! SOURCE
   !!
   subroutine endDiag
@@ -1128,7 +1132,7 @@ contains
          reg_dealloc_mem
     use global_module,   only: numprocs, nspin
     use ScalapackFormat, only: deallocate_arrays, proc_rows,  &
-         proc_cols, matrix_size
+         proc_cols, matrix_size, matrix_size_padH
 
     implicit none
 
@@ -1143,11 +1147,11 @@ contains
 
     deallocate(w, occ, STAT=stat)
     if (stat /= 0) call cq_abort('endDiag: failed to deallocate w and occ', stat)
-    call reg_dealloc_mem(area_DM, 2 * matrix_size * nkp * nspin, type_dbl)
+    call reg_dealloc_mem(area_DM, (matrix_size_padH+matrix_size) * nkp * nspin, type_dbl)
 
     deallocate(local_w, STAT=stat)
     if (stat /= 0) call cq_abort('endDiag: failed to allocate local_w', stat)
-    call reg_dealloc_mem(area_DM, matrix_size * nspin, type_dbl)
+    call reg_dealloc_mem(area_DM, matrix_size_padH * nspin, type_dbl)
 
     ! Shut down BLACS
 
@@ -1157,7 +1161,7 @@ contains
     deallocate(ifail, iclustr, STAT=stat)
     if (stat /= 0) &
          call cq_abort("endDiag: failed to deallocate ifail and iclustr", stat)
-    call reg_dealloc_mem(area_DM, matrix_size + 2 * proc_rows * &
+    call reg_dealloc_mem(area_DM, matrix_size_padH + 2 * proc_rows * &
          proc_cols, type_int)
 
     deallocate(gap, STAT=stat)
@@ -1222,6 +1226,8 @@ contains
   !!    Changed nsf to come from maxima, not common
   !!   2006/08/30 16:49 dave
   !!    Added allocate for arrays in Distrib
+  !!   2023/07/24 tsuyoshi
+  !!   - Change for padding H and S matrices
   !!  SOURCE
   !!
   subroutine PrepareRecv(Distrib)
@@ -1255,6 +1261,7 @@ contains
     do rowblock=1,blocks_r
        if(my_row(rowblock)>0) then ! If this row block is part of my chunk
           do row = 1,block_size_r
+             if(SC_row_block_atom(row,rowblock)%part==0) cycle    ! for padding H and S matrices (padded part)
              if(iprint_DM>=5.AND.myid==0) write(io_lun,4) myid,i,rowblock,row
              ! Find processor and increment processors and rows from proc
              proc = parts%i_cc2node(SC_row_block_atom(row,rowblock)%part) ! find proc on which the partition containing the row is stored

src/ScalapackFormat.f90

@@ -284,6 +284,7 @@ contains
      blocks_c = (matrix_size/block_size_c)
      matrix_size_padH = matrix_size
     endif
+    if(myid==0.AND.iprint_DM>3) write(io_lun,*) "matrix_size & matrix_size_padH = ",matrix_size, matrix_size_padH
     if(myid==0.AND.iprint_DM>3) write(io_lun,1) blocks_r,blocks_c
     maxrow = floor(real(blocks_r/proc_rows))+1
     maxcol = floor(real(blocks_c/proc_cols))+1
@@ -1004,6 +1005,9 @@ contains
 
     ! for padding H matrix, we need to initialise SC_col_block_atom
           SC_col_block_atom(:,:)%part = 0
+     ! for safety other members are also initialised.
+          SC_col_block_atom(:,:)%atom = 0
+          SC_col_block_atom(:,:)%support_fn = 0
          
     if(iprint_DM>3.AND.myid==0) write(io_lun,fmt='(10x,i5, a)') myid,' Starting Find SC Col Atoms'
     ! Loop over SC blocks
@@ -1013,7 +1017,7 @@ contains
        do blockcol = 1,block_size_c
           part = ref_col_block_atom(blockcol,refc)%part  
           ! for the padded part (padding Hmatrix version)
-          if(part == 0) cycle
+          if(part == 0) cycle    ! for padding H and S matrices  (for padded part)
           seq  = ref_col_block_atom(blockcol,refc)%atom  
           supfn  = ref_col_block_atom(blockcol,refc)%support_fn
           SC_col_block_atom(blockcol,cb)%part = part