Commit 8f992f55 authored by Daniel Wortmann's avatar Daniel Wortmann

Bugfixes for MPI&FFN

parent fbe26fef
......@@ -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)
......
......@@ -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.)
......
......@@ -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
......
......@@ -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
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment