Bugfixes for MPI&FFN

eigen/hsmt_mtNocoPot_offdiag.F90

@@ -47,7 +47,7 @@ CONTAINS
     !The spin1,2 matrix is calculated(real part of potential)
     CALL hsmt_nonsph(n,mpi,sym,atoms,3,1,1,chi_one,noco,nococonv,cell,lapw,td,fj(:,0:,1,:),gj(:,0:,1,:),hmat_tmp)
     CALL hsmt_lo(input,atoms,sym,cell,mpi,noco,nococonv,lapw,ud,td,fj(:,0:,1,:),gj(:,0:,1,:),n,chi_one,3,1,1,hmat_tmp)
-    call hmat_tmp%generate_full_matrix()
+    !call hmat_tmp%generate_full_matrix()
     CALL hsmt_spinor(3,n,nococonv,chi) !spinor for off-diagonal part
     CALL hsmt_distspins(chi,hmat_tmp,hmat)
 
@@ -63,7 +63,7 @@ CONTAINS
     CALL hsmt_nonsph(n,mpi,sym,atoms,4,1,1,chi_one,noco,nococonv,cell,lapw,td,&
          fj(:,0:,1,:),gj(:,0:,1,:),hmat_tmp)
     CALL hsmt_lo(input,atoms,sym,cell,mpi,noco,nococonv,lapw,ud,td,fj(:,0:,1,:),gj(:,0:,1,:),n,chi_one,4,1,1,hmat_tmp)
-    call hmat_tmp%generate_full_matrix()
+    !call hmat_tmp%generate_full_matrix()
 
     CALL hsmt_spinor(3,n,nococonv,chi)
     CALL hsmt_distspins(chi,hmat_tmp,hmat)

eigen/hsmt_nonsph.F90

@@ -253,7 +253,7 @@ CONTAINS
 
     INTEGER:: nn,na,ab_size,l,ll,m,i,ii
     COMPLEX,ALLOCATABLE:: ab(:,:),ab1(:,:),ab_select(:,:)
-    real :: rchi
+    complex :: cchi
 
     ALLOCATE(ab(MAXVAL(lapw%nv),2*atoms%lnonsph(n)*(atoms%lnonsph(n)+2)+2),ab1(lapw%nv(jintsp),2*atoms%lnonsph(n)*(atoms%lnonsph(n)+2)+2),ab_select(lapw%num_local_cols(jintsp),2*atoms%lnonsph(n)*(atoms%lnonsph(n)+2)+2))
 
@@ -270,7 +270,7 @@ CONTAINS
     DO nn = 1,atoms%neq(n)
        na = SUM(atoms%neq(:n-1))+nn
        IF ((sym%invsat(na)==0) .OR. (sym%invsat(na)==1)) THEN
-          rchi=MERGE(REAL(chi),REAL(chi)*2,(sym%invsat(na)==0))
+          cchi=MERGE(chi,chi*2,(sym%invsat(na)==0))
 
           CALL hsmt_ab(sym,atoms,noco,nococonv,isp,jintsp,n,na,cell,lapw,fj,gj,ab,ab_size,.TRUE.)
           !Calculate Hamiltonian
@@ -279,7 +279,12 @@ CONTAINS
           !Cut out of ab1 only the needed elements here
           ab_select=ab1(mpi%n_rank+1:lapw%nv(jintsp):mpi%n_size,:)
           IF (iintsp==jintsp) THEN
-             CALL zgemm("N","T",lapw%nv(iintsp),lapw%num_local_cols(iintsp),ab_size,CMPLX(rchi,0.0),CONJG(ab1),SIZE(ab1,1),ab_select,lapw%num_local_cols(iintsp),CMPLX(1.,0.0),hmat%data_c,SIZE(hmat%data_c,1))
+            if (isp>2) then
+              CALL hsmt_ab(sym,atoms,noco,nococonv,isp,2,n,na,cell,lapw,fj,gj,ab,ab_size,.TRUE.)
+              CALL zgemm("N","T",lapw%nv(iintsp),lapw%num_local_cols(iintsp),ab_size,cchi,CONJG(ab),SIZE(ab,1),ab_select,lapw%num_local_cols(iintsp),CMPLX(1.,0.0),hmat%data_c,SIZE(hmat%data_c,1))
+            ELSE
+              CALL zgemm("N","T",lapw%nv(iintsp),lapw%num_local_cols(iintsp),ab_size,cchi,CONJG(ab1),SIZE(ab1,1),ab_select,lapw%num_local_cols(iintsp),CMPLX(1.,0.0),hmat%data_c,SIZE(hmat%data_c,1))
+            ENDIF
           ELSE
              !Second set of ab is needed
              CALL hsmt_ab(sym,atoms,noco,nococonv,isp,iintsp,n,na,cell,lapw,fj,gj,ab,ab_size,.TRUE.)

io/iomatrix_hdf.F90

@@ -7,7 +7,7 @@ MODULE m_iomatrix_hdf
   IMPLICIT NONE
   PRIVATE
   PUBLIC iomatrix_hdf_close,iomatrix_hdf_open,iomatrix_hdf_write,iomatrix_hdf_read
-  
+
 CONTAINS
   SUBROUTINE  iomatrix_hdf_read(mat,nrec,did)
     CLASS(t_Mat),INTENT(INOUT)  :: mat
@@ -16,7 +16,7 @@ CONTAINS
 
     INTEGER::mpi_comm,dim(4)
 
-   
+
     INTEGER(HID_t) :: memspace,fspace,trans
     INTEGER(hsize_t):: dims(4)
     INTEGER        :: err
@@ -38,17 +38,17 @@ CONTAINS
        END IF
     TYPE is (t_mpimat)
        ALLOCATE(dat(MERGE(1,2,mat%l_real),mat%matsize1,mat%matsize2,1))
-       
+
        CALL h5dget_space_f(did,fspace,err)
        CALL priv_create_hyperslab_from_blacsdesc(mat%l_real,nrec,fspace,mat%blacsdata%blacs_desc)
        dims=SHAPE(dat)
        CALL h5screate_simple_f(4,dims,memspace,err)
        trans=gettransprop()
        CALL h5dread_f(did,H5T_NATIVE_DOUBLE,dat,dims,err,memspace,fspace,trans)
-       CALL h5sclose_f(memspace,err)                                  
+       CALL h5sclose_f(memspace,err)
        CALL h5sclose_f(fspace,err)
-       CALL cleartransprop(trans) 
-       IF (mat%l_real) THEN 
+       CALL cleartransprop(trans)
+       IF (mat%l_real) THEN
           mat%data_r=dat(1,:,:,1)
        ELSE
          mat%data_c=CMPLX(dat(1,:,:,1),dat(2,:,:,1))
@@ -60,13 +60,13 @@ CONTAINS
     CLASS(t_Mat),INTENT(IN)  :: mat
     INTEGER,INTENT(IN)       :: rec
     INTEGER(HID_t),INTENT(in)::did
-    
+
     INTEGER(HID_t) :: memspace,fspace,trans
     INTEGER(HSIZE_t):: dims(4)
     INTEGER :: err
     REAL,ALLOCATABLE :: dat(:,:,:,:)
 
-    
+
     SELECT TYPE(mat)
     TYPE is (t_mat)
        IF (mat%l_real) THEN
@@ -77,11 +77,11 @@ CONTAINS
        END IF
     TYPE is (t_mpimat)
        ALLOCATE(dat(MERGE(1,2,mat%l_real),mat%matsize1,mat%matsize2,1))
-       IF (mat%l_real) THEN 
+       IF (mat%l_real) THEN
           dat(1,:,:,1)=mat%data_r
        ELSE
          dat(1,:,:,1)=REAL(mat%data_c)
-         dat(2,:,:,1)=REAL(mat%data_c)
+         dat(2,:,:,1)=AIMAG(mat%data_c)
       ENDIF
       CALL h5dget_space_f(did,fspace,err)
       CALL priv_create_hyperslab_from_blacsdesc(mat%l_real,rec,fspace,mat%blacsdata%blacs_desc)
@@ -89,9 +89,9 @@ CONTAINS
       CALL h5screate_simple_f(4,dims,memspace,err)
       trans=gettransprop()
       CALL h5dwrite_f(did,H5T_NATIVE_DOUBLE,dat,dims,err,memspace,fspace,trans)
-      CALL h5sclose_f(memspace,err)                                  
+      CALL h5sclose_f(memspace,err)
       CALL h5sclose_f(fspace,err)
-      CALL cleartransprop(trans) 
+      CALL cleartransprop(trans)
    END SELECT
 
   END SUBROUTINE iomatrix_hdf_write
@@ -108,7 +108,7 @@ CONTAINS
     INTEGER,INTENT(in)          :: matsize,no_rec
     CHARACTER(len=*),INTENT(in) :: filename
     INTEGER(hid_t),INTENT(out)  :: fid,did
-    
+
     INTEGER :: dims(4),err
     LOGICAL :: l_exist
     INTEGER(HID_T)  :: access_prp
@@ -143,7 +143,7 @@ CONTAINS
     LOGICAL,INTENT(IN) :: l_real
     INTEGER,INTENT(in) :: nrec,blacsdesc(9)
     INTEGER(hid_t),INTENT(in):: sid
-    
+
     INTEGER(hsize_t):: start(4),COUNT(4),stride(4),bloc(4)
     INTEGER         :: nprow,npcol,myrow,mycol,block_row,block_col,matsize,blacs_ctxt,err
     LOGICAL         :: ok
@@ -168,7 +168,7 @@ CONTAINS
        !Cut to actual sizes
        start=(/0,0,0,0/)
        count=(/MERGE(1,2,l_real),matsize,matsize,int(stride(4))/)
-       CALL h5sselect_hyperslab_f(sid,H5S_SELECT_AND_F,start,count,err) 
+       CALL h5sselect_hyperslab_f(sid,H5S_SELECT_AND_F,start,count,err)
        CALL h5sselect_valid_f(sid,ok,err)
        IF (.NOT.ok) CALL judft_error("Writing of matrix failed, BUG in parallel HDF-IO")
     ENDIF

types/types_mpimat.F90

@@ -201,13 +201,13 @@ CONTAINS
                 mat%data_c(i,j) = 0.0
              ENDIF
           ENDIF
-          IF (i_glob==j_glob) THEN
-             IF (mat%l_real) THEN
-                mat%data_r(i,j) =  mat%data_r(i,j)/2.0
-             ELSE
-                mat%data_c(i,j) =  mat%data_c(i,j)/2.0
-             ENDIF
-          ENDIF
+          !IF (i_glob==j_glob) THEN
+          !   IF (mat%l_real) THEN
+          !      mat%data_r(i,j) =  mat%data_r(i,j)/2.0
+          !   ELSE
+          !      mat%data_c(i,j) =  mat%data_c(i,j)/2.0
+          !   ENDIF
+          !ENDIF
        ENDDO
     ENDDO
 
@@ -252,9 +252,11 @@ CONTAINS
           IF (mat%l_real) THEN
              mat%data_r(i+1:,ii)=0.0
              mat1%data_r(i+1:,ii)=0.0
+             mat1%data_r(i,ii)=0.0
           ELSE
              mat%data_c(i+1:,ii)=0.0
              mat1%data_c(i+1:,ii)=0.0
+             mat1%data_c(i,ii)=0.0
           ENDIF
        ENDDO
        IF (mat%l_real) THEN
@@ -267,15 +269,15 @@ CONTAINS
     END IF
     !Now multiply the diagonal of the matrix by 1/2
 
-    ii=0
-    DO i=n_rank+1,MIN(mat%global_size1,mat%global_size2),n_size
-       ii=ii+1
-       IF (mat%l_real) THEN
-          mat%data_r(i,ii)=mat%data_r(i,ii)/2
-       ELSE
-          mat%data_c(i,ii)=mat%data_c(i,ii)/2
-       END IF
-    ENDDO
+    !ii=0
+    !DO i=n_rank+1,MIN(mat%global_size1,mat%global_size2),n_size
+    !   ii=ii+1
+    !   IF (mat%l_real) THEN
+    !      mat%data_r(i,ii)=mat%data_r(i,ii)/2
+    !   ELSE
+    !      mat%data_c(i,ii)=mat%data_c(i,ii)/2
+    !   END IF
+    !ENDDO
     CLASS default
        CALL judft_error("Inconsistent types in t_mpimat_add_transpose")
     END SELECT