Commit edb402d8 authored by Gregor Michalicek's avatar Gregor Michalicek

Some cleanup in eig66 routines

I removed some stuff related to DOS storage.
parent e1e66a44
......@@ -38,7 +38,7 @@ IMPLICIT NONE
CONTAINS
SUBROUTINE init_chase(mpi,dimension,input,atoms,kpts,noco,vacuum,banddos,l_real)
SUBROUTINE init_chase(mpi,dimension,atoms,kpts,noco,vacuum,l_real)
USE m_types
USE m_types_mpi
......@@ -49,12 +49,10 @@ IMPLICIT NONE
TYPE(t_mpi), INTENT(IN) :: mpi
TYPE(t_dimension), INTENT(IN) :: dimension
TYPE(t_input), INTENT(IN) :: input
TYPE(t_atoms), INTENT(IN) :: atoms
TYPE(t_kpts), INTENT(IN) :: kpts
TYPE(t_noco), INTENT(IN) :: noco
TYPE(t_vacuum), INTENT(IN) :: vacuum
TYPE(t_banddos), INTENT(IN) :: banddos
LOGICAL, INTENT(IN) :: l_real
......@@ -66,8 +64,7 @@ IMPLICIT NONE
chase_eig_id=open_eig(mpi%mpi_comm,DIMENSION%nbasfcn,nevd+nexd,kpts%nkpt,DIMENSION%jspd,atoms%lmaxd,&
atoms%nlod,atoms%ntype,atoms%nlotot,noco%l_noco,.TRUE.,l_real,noco%l_soc,.FALSE.,&
mpi%n_size,layers=vacuum%layers,nstars=vacuum%nstars,ncored=DIMENSION%nstd,&
nsld=atoms%nat,nat=atoms%nat,l_dos=banddos%dos.OR.input%cdinf,l_mcd=banddos%l_mcd,&
l_orb=banddos%l_orb)
nsld=atoms%nat,nat=atoms%nat)
END IF
END SUBROUTINE init_chase
......
......@@ -119,8 +119,7 @@ CONTAINS
mpi%mpi_comm,DIMENSION%nbasfcn,DIMENSION%neigd,kpts%nkpt,DIMENSION%jspd,atoms%lmaxd,&
atoms%nlod,atoms%ntype,atoms%nlotot,noco%l_noco,.TRUE.,l_real,noco%l_soc,.FALSE.,&
mpi%n_size,layers=vacuum%layers,nstars=vacuum%nstars,ncored=DIMENSION%nstd,&
nsld=atoms%nat,nat=atoms%nat,l_dos=banddos%dos.OR.input%cdinf,l_mcd=banddos%l_mcd,&
l_orb=banddos%l_orb)
nsld=atoms%nat,nat=atoms%nat)
!---> set up and solve the eigenvalue problem
!---> loop over spins
......
MODULE m_calc_hybrid
USE m_judft
CONTAINS
SUBROUTINE calc_hybrid(hybrid,kpts,atoms,input,DIMENSION,mpi,noco,cell,vacuum,oneD,banddos,results,sym,xcpot,v,it )
SUBROUTINE calc_hybrid(hybrid,kpts,atoms,input,DIMENSION,mpi,noco,cell,vacuum,oneD,results,sym,xcpot,v,it )
USE m_types
USE m_mixedbasis
USE m_coulombmatrix
......@@ -19,7 +19,6 @@ CONTAINS
TYPE(t_input),INTENT(IN) :: input
TYPE(t_vacuum),INTENT(IN) :: vacuum
TYPE(t_noco),INTENT(IN) :: noco
TYPE(t_banddos),INTENT(IN) :: banddos
TYPE(t_results),INTENT(INOUT):: results
TYPE(t_sym),INTENT(IN) :: sym
TYPE(t_cell),INTENT(IN) :: cell
......@@ -104,8 +103,7 @@ CONTAINS
mpi%mpi_comm,dimension%nbasfcn,dimension%neigd,kpts%nkpt,dimension%jspd,atoms%lmaxd,atoms%nlod,atoms%ntype,atoms%nlotot&
,noco%l_noco,.FALSE.,sym%invs.AND..NOT.noco%l_noco,noco%l_soc,.FALSE.,&
mpi%n_size,layers=vacuum%layers,nstars=vacuum%nstars,ncored=DIMENSION%nstd,&
nsld=atoms%nat,nat=atoms%nat,l_dos=banddos%dos.OR.input%cdinf,l_mcd=banddos%l_mcd,&
l_orb=banddos%l_orb)
nsld=atoms%nat,nat=atoms%nat)
!construct the mixed-basis
CALL timestart("generation of mixed basis")
......
......@@ -34,15 +34,14 @@ CONTAINS
END SELECT
END SUBROUTINE priv_find_data
SUBROUTINE open_eig(id,nmat,neig,nkpts,jspins,lmax,nlo,ntype,nlotot,create,l_real,l_soc,l_dos,l_mcd,l_orb,filename,layers,nstars,ncored,nsld,nat)
SUBROUTINE open_eig(id,nmat,neig,nkpts,jspins,lmax,nlo,ntype,nlotot,create,l_real,l_soc,filename,layers,nstars,ncored,nsld,nat)
INTEGER, INTENT(IN) :: id,nmat,neig,nkpts,jspins,nlo,ntype,lmax,nlotot
LOGICAL, INTENT(IN) :: create,l_real,l_soc
LOGICAL,INTENT(IN),OPTIONAL :: l_dos,l_mcd,l_orb
CHARACTER(LEN=*),INTENT(IN),OPTIONAL :: filename
INTEGER,INTENT(IN),OPTIONAL :: layers,nstars,ncored,nsld,nat
!locals
LOGICAL :: l_file
INTEGER :: i1,recl_z,recl_eig,recl_dos
INTEGER :: i1,recl_z,recl_eig
REAL :: r1,r3(3)
COMPLEX :: c1
TYPE(t_data_DA),POINTER:: d
......@@ -50,7 +49,7 @@ CONTAINS
CALL priv_find_data(id,d)
IF (PRESENT(filename)) d%fname=filename
CALL eig66_data_storedefault(d,jspins,nkpts,nmat,neig,lmax,nlotot,nlo,ntype,l_real,l_soc,l_dos,l_mcd,l_orb)
CALL eig66_data_storedefault(d,jspins,nkpts,nmat,neig,lmax,nlotot,nlo,ntype,l_real,l_soc)
!Calculate the record length
......@@ -67,28 +66,6 @@ CONTAINS
d%recl_vec=recl_eig+recl_z
IF (d%l_dos) THEN
IF (.NOT.(PRESENT(layers).AND.PRESENT(nstars).AND.PRESENT(ncored).AND.PRESENT(nsld).AND.PRESENT(nat))) &
CALL judft_error("BUG:Could not open file for DOS-data",calledby="eig66_da")
INQUIRE(IOLENGTH=i1) i1
recl_dos=i1*2*neig !ksym&jsym
INQUIRE(IOLENGTH=i1) r1
recl_dos=recl_dos+i1*3*neig !qvac&qis
recl_dos=recl_dos+i1*4*ntype*neig !qal
recl_dos=recl_dos+i1*neig*2*max(1,layers) !qvlay
IF (l_orb) THEN
recl_dos=recl_dos+i1*2*nsld*neig !qintsl,qmtsl
recl_dos=recl_dos+i1*24*neig*nat !qmtp,orbcomp
ENDIF
INQUIRE(IOLENGTH=i1) c1
recl_dos=recl_dos+i1*nstars*neig*max(1,layers)*2 !qstars
IF (l_mcd) recl_dos=recl_dos+i1*3*ntype*ncored*neig !mcd
ELSE
recl_dos=-1
ENDIF
d%recl_dos=recl_dos
IF (create) THEN
INQUIRE(file=TRIM(d%fname),opened=l_file)
DO WHILE(l_file)
......@@ -100,20 +77,11 @@ CONTAINS
OPEN(d%file_io_id_vec,FILE=TRIM(d%fname),ACCESS='direct',FORM='unformatted',RECL=d%recl_vec,STATUS='unknown')
d%file_io_id_wiks=priv_free_uid()
OPEN(d%file_io_id_wiks,FILE=TRIM(d%fname)//".wiks",ACCESS='direct',FORM='unformatted',RECL=d%recl_wiks,STATUS='unknown')
IF(d%recl_dos>0) THEN
d%file_io_id_dos=priv_free_uid()
OPEN(d%file_io_id_dos,FILE=TRIM(d%fname)//".dos",ACCESS='direct',FORM='unformatted',RECL=d%recl_dos,STATUS='unknown')
ENDIF
ELSE
d%file_io_id_vec=priv_free_uid()
OPEN(d%file_io_id_vec,FILE=TRIM(d%fname),ACCESS='direct',FORM='unformatted',RECL=d%recl_vec,STATUS='old')
d%file_io_id_wiks=priv_free_uid()
OPEN(d%file_io_id_wiks,FILE=TRIM(d%fname)//".wiks",ACCESS='direct',FORM='unformatted',RECL=d%recl_wiks,STATUS='old')
IF(d%recl_dos>0) THEN
d%file_io_id_dos=priv_free_uid()
OPEN(d%file_io_id_dos,FILE=TRIM(d%fname)//".dos",ACCESS='direct',FORM='unformatted',RECL=d%recl_dos,STATUS='old')
ENDIF
ENDIF
CONTAINS
INTEGER FUNCTION priv_free_uid() RESULT(uid)
......
......@@ -14,30 +14,24 @@ module m_eig66_data
TYPE :: t_data
INTEGER:: io_mode
INTEGER:: jspins,nkpts,nmat,neig,lmax,nlotot,nlo,ntype
LOGICAL:: l_dos,l_mcd,l_orb,l_real,l_soc
LOGICAL:: l_real,l_soc
END TYPE
TYPE,EXTENDS(t_data):: t_data_DA
INTEGER :: recl_vec=0,recl_dos,recl_wiks
INTEGER :: recl_vec=0,recl_wiks
CHARACTER(LEN=20) :: fname="eig"
INTEGER :: file_io_id_vec,file_io_id_dos,file_io_id_wiks
INTEGER :: file_io_id_vec,file_io_id_wiks
END TYPE
TYPE,extends(t_data):: t_data_MPI
INTEGER :: n_size=1
INTEGER :: size_k,size_el,size_ello,size_eig
INTEGER :: eig_handle,zr_handle,zc_handle,neig_handle,w_iks_handle
INTEGER :: qal_handle,qvac_handle,qis_handle,qvlay_handle,qintsl_handle,qmtsl_handle
INTEGER :: qmtp_handle,orbcomp_handle,qstars_handle,mcd_handle,jsym_handle,ksym_handle
INTEGER,ALLOCATABLE :: pe_basis(:,:),slot_basis(:,:)
INTEGER,ALLOCATABLE :: pe_ev(:,:,:),slot_ev(:,:,:)
INTEGER :: irank
INTEGER,POINTER :: neig_data(:)
REAL,POINTER :: eig_data(:),zr_data(:), w_iks_data(:)
REAL,POINTER :: qal_data(:),qvac_data(:),qis_data(:),qvlay_data(:)
REAL,POINTER :: qintsl_data(:),qmtsl_data(:),qmtp_data(:),orbcomp_data(:),mcd_data(:)
COMPLEX,POINTER :: qstars_data(:)
INTEGER,POINTER :: jsym_data(:),ksym_data(:)
COMPLEX,POINTER :: zc_data(:)
END TYPE
TYPE,EXTENDS(t_data):: t_data_hdf
......@@ -45,9 +39,6 @@ module m_eig66_data
INTEGER(HID_T) :: fid
INTEGER(HID_T) :: neigsetid
INTEGER(HID_T) :: energysetid,wikssetid,evsetid
INTEGER(HID_T) :: qalsetid,qvacsetid,qissetid,qvlaysetid
INTEGER(HID_T) :: qstarssetid,ksymsetid,jsymsetid,mcdsetid
INTEGER(HID_T) :: qintslsetid,qmtslsetid,qmtpsetid,orbcompsetid
CHARACTER(LEN=20) :: fname="eig"
#endif
END TYPE
......@@ -57,18 +48,6 @@ module m_eig66_data
REAL,ALLOCATABLE :: eig_eig(:,:,:)
REAL,ALLOCATABLE :: eig_vecr(:,:)
COMPLEX,ALLOCATABLE :: eig_vecc(:,:)
REAL,ALLOCATABLE :: qal(:,:,:,:)
REAL,ALLOCATABLE :: qvac(:,:,:)
REAL,ALLOCATABLE :: qis(:,:)
REAL,ALLOCATABLE :: qvlay(:,:,:,:)
COMPLEX,ALLOCATABLE :: qstars(:,:,:,:,:)
INTEGER,ALLOCATABLE :: ksym(:,:)
INTEGER,ALLOCATABLE :: jsym(:,:)
REAL,ALLOCATABLE :: mcd(:,:,:,:)
REAL,ALLOCATABLE :: qintsl(:,:,:)
REAL,ALLOCATABLE :: qmtsl(:,:,:)
REAL,ALLOCATABLE :: qmtp(:,:,:)
REAL,ALLOCATABLE :: orbcomp(:,:,:,:)
END TYPE
TYPE t_list
......@@ -85,11 +64,10 @@ module m_eig66_data
contains
subroutine eig66_data_storedefault(d,jspins,nkpts,nmat,neig,lmax,nlotot,nlo,ntype,l_real,l_soc,l_dos,l_mcd,l_orb)
subroutine eig66_data_storedefault(d,jspins,nkpts,nmat,neig,lmax,nlotot,nlo,ntype,l_real,l_soc)
CLASS(t_data)::d
INTEGER,INTENT(IN)::jspins,nkpts,nmat,neig,lmax,nlotot,nlo,ntype
LOGICAL,INTENT(IN):: l_real,l_soc
LOGICAL,INTENT(IN),OPTIONAL::l_dos,l_mcd,l_orb
d%jspins=jspins
d%nkpts=nkpts
d%nmat=nmat
......@@ -100,15 +78,6 @@ module m_eig66_data
d%ntype=ntype
d%l_real=l_real
d%l_soc=l_soc
if (present(l_dos)) THEN
d%l_dos=l_dos
d%l_mcd=l_mcd
d%l_orb=l_orb
else
d%l_dos=.false.
d%l_mcd=.false.
d%l_orb=.false.
endif
END SUBROUTINE
subroutine eig66_find_data(d,id,io_mode)
......
......@@ -57,7 +57,7 @@ CONTAINS
END SELECT
END SUBROUTINE priv_find_data
!----------------------------------------------------------------------
SUBROUTINE open_eig(id,mpi_comm,nmat,neig,nkpts,jspins,lmax,nlo,ntype,create,l_real,l_soc,nlotot,readonly,l_dos,l_mcd,l_orb,filename,layers,nstars,ncored,nsld,nat)
SUBROUTINE open_eig(id,mpi_comm,nmat,neig,nkpts,jspins,lmax,nlo,ntype,create,l_real,l_soc,nlotot,readonly,filename,layers,nstars,ncored,nsld,nat)
!*****************************************************************
! opens hdf-file for eigenvectors+values
......@@ -67,7 +67,6 @@ CONTAINS
INTEGER, INTENT(IN) :: id,mpi_comm
INTEGER, INTENT(IN) :: nmat,neig,nkpts,jspins,nlo,ntype,lmax,nlotot
LOGICAL, INTENT(IN) :: create,readonly,l_real,l_soc
LOGICAL, INTENT(IN),OPTIONAL ::l_dos,l_mcd,l_orb
CHARACTER(LEN=*),OPTIONAL :: filename
INTEGER,INTENT(IN),OPTIONAL :: layers,nstars,ncored,nsld,nat
......@@ -97,7 +96,7 @@ CONTAINS
#endif
CALL priv_find_data(id,d)
IF (PRESENT(filename)) d%fname=filename
CALL eig66_data_storedefault(d,jspins,nkpts,nmat,neig,lmax,nlotot,nlo,ntype,l_real,l_soc,l_dos,l_mcd,l_orb)
CALL eig66_data_storedefault(d,jspins,nkpts,nmat,neig,lmax,nlotot,nlo,ntype,l_real,l_soc)
!set access_flags according
IF (readonly) THEN
access_mode=H5F_ACC_RDONLY_F
......@@ -131,61 +130,6 @@ CONTAINS
CALL h5screate_simple_f(5,dims(:5),spaceid,hdferr)
CALL h5dcreate_f(d%fid, "ev", H5T_NATIVE_DOUBLE, spaceid, d%evsetid, hdferr)
CALL h5sclose_f(spaceid,hdferr)
!stuff for dos etc
IF (d%l_dos) THEN
dims(:5)=(/4,ntype,neig,nkpts,jspins/)
CALL h5screate_simple_f(5,dims(:5),spaceid,hdferr)
CALL h5dcreate_f(d%fid, "qal", H5T_NATIVE_DOUBLE, spaceid, d%qalsetid, hdferr)
CALL h5sclose_f(spaceid,hdferr)
dims(:4)=(/neig,2,nkpts,jspins/)
CALL h5screate_simple_f(4,dims(:4),spaceid,hdferr)
CALL h5dcreate_f(d%fid, "qvac", H5T_NATIVE_DOUBLE, spaceid, d%qvacsetid, hdferr)
CALL h5sclose_f(spaceid,hdferr)
dims(:3)=(/neig,nkpts,jspins/)
CALL h5screate_simple_f(3,dims(:3),spaceid,hdferr)
CALL h5dcreate_f(d%fid, "qis", H5T_NATIVE_DOUBLE, spaceid, d%qissetid, hdferr)
CALL h5sclose_f(spaceid,hdferr)
dims(:5)=(/neig,layers,2,nkpts,jspins/)
CALL h5screate_simple_f(5,dims(:5),spaceid,hdferr)
CALL h5dcreate_f(d%fid, "qvlay", H5T_NATIVE_DOUBLE, spaceid, d%qvlaysetid, hdferr)
CALL h5sclose_f(spaceid,hdferr)
dims(:7)=(/2,nstars,neig,layers,2,nkpts,jspins/)
CALL h5screate_simple_f(7,dims(:7),spaceid,hdferr)
CALL h5dcreate_f(d%fid, "qstars", H5T_NATIVE_DOUBLE, spaceid, d%qstarssetid, hdferr)
CALL h5sclose_f(spaceid,hdferr)
dims(:3)=(/neig,nkpts,jspins/)
CALL h5screate_simple_f(3,dims(:3),spaceid,hdferr)
CALL h5dcreate_f(d%fid, "ksym", H5T_NATIVE_DOUBLE, spaceid, d%ksymsetid, hdferr)
CALL h5sclose_f(spaceid,hdferr)
dims(:3)=(/neig,nkpts,jspins/)
CALL h5screate_simple_f(3,dims(:3),spaceid,hdferr)
CALL h5dcreate_f(d%fid, "jsym", H5T_NATIVE_DOUBLE, spaceid, d%jsymsetid, hdferr)
CALL h5sclose_f(spaceid,hdferr)
IF (d%l_mcd) THEN
dims(:5)=(/3*ntype,ncored,neig,nkpts,jspins/)
CALL h5screate_simple_f(5,dims(:5),spaceid,hdferr)
CALL h5dcreate_f(d%fid, "mcd", H5T_NATIVE_DOUBLE, spaceid, d%mcdsetid, hdferr)
CALL h5sclose_f(spaceid,hdferr)
ENDIF
IF (d%l_orb) THEN
dims(:4)=(/nsld,neig,nkpts,jspins/)
CALL h5screate_simple_f(4,dims(:4),spaceid,hdferr)
CALL h5dcreate_f(d%fid, "qintsl", H5T_NATIVE_DOUBLE, spaceid, d%qintslsetid, hdferr)
CALL h5sclose_f(spaceid,hdferr)
dims(:4)=(/nsld,neig,nkpts,jspins/)
CALL h5screate_simple_f(4,dims(:4),spaceid,hdferr)
CALL h5dcreate_f(d%fid, "qmtsl", H5T_NATIVE_DOUBLE, spaceid, d%qmtslsetid, hdferr)
CALL h5sclose_f(spaceid,hdferr)
dims(:4)=(/neig,nat,nkpts,jspins/)
CALL h5screate_simple_f(4,dims(:4),spaceid,hdferr)
CALL h5dcreate_f(d%fid, "qmtp", H5T_NATIVE_DOUBLE, spaceid, d%qmtpsetid, hdferr)
CALL h5sclose_f(spaceid,hdferr)
dims(:5)=(/neig,23,nat,nkpts,jspins/)
CALL h5screate_simple_f(5,dims(:5),spaceid,hdferr)
CALL h5dcreate_f(d%fid, "orbcomp", H5T_NATIVE_DOUBLE, spaceid, d%orbcompsetid, hdferr)
CALL h5sclose_f(spaceid,hdferr)
ENDIF
ENDIF
ELSE
CALL h5fopen_f (TRIM(d%fname)//'.hdf', access_Mode, d%fid, hdferr,access_prp)
!get dataset-ids
......@@ -193,24 +137,6 @@ CONTAINS
CALL h5dopen_f(d%fid, 'w_iks', d%wikssetid, hdferr)
CALL h5dopen_f(d%fid, 'neig', d%neigsetid, hdferr)
CALL h5dopen_f(d%fid, 'ev', d%evsetid, hdferr)
IF (d%l_dos) THEN
CALL h5dopen_f(d%fid, 'qal', d%qalsetid, hdferr)
CALL h5dopen_f(d%fid, 'qvac', d%qvacsetid, hdferr)
CALL h5dopen_f(d%fid, 'qis', d%qissetid, hdferr)
CALL h5dopen_f(d%fid, 'qvlay', d%qvlaysetid, hdferr)
CALL h5dopen_f(d%fid, 'qstars', d%qstarssetid, hdferr)
CALL h5dopen_f(d%fid, 'ksym', d%ksymsetid, hdferr)
CALL h5dopen_f(d%fid, 'jsym', d%jsymsetid, hdferr)
IF (d%l_mcd) THEN
CALL h5dopen_f(d%fid, 'mcd', d%mcdsetid, hdferr)
ENDIF
IF (d%l_orb) THEN
CALL h5dopen_f(d%fid, 'qintsl', d%qintslsetid, hdferr)
CALL h5dopen_f(d%fid, 'qmtsl', d%qmtslsetid, hdferr)
CALL h5dopen_f(d%fid, 'qmtp', d%qmtpsetid, hdferr)
CALL h5dopen_f(d%fid, 'orbcomp', d%orbcompsetid, hdferr)
ENDIF
ENDIF
endif
IF (.NOT.access_prp==H5P_DEFAULT_f) CALL H5Pclose_f(access_prp&
& ,hdferr)
......@@ -238,24 +164,6 @@ CONTAINS
CALL h5dclose_f(d%wikssetid,hdferr)
CALL h5dclose_f(d%neigsetid,hdferr)
CALL h5dclose_f(d%evsetid,hdferr)
IF (d%l_dos) THEN
CALL h5dclose_f(d%qalsetid, hdferr)
CALL h5dclose_f(d%qvacsetid, hdferr)
CALL h5dclose_f(d%qissetid, hdferr)
CALL h5dclose_f(d%qvlaysetid, hdferr)
CALL h5dclose_f(d%qstarssetid, hdferr)
CALL h5dclose_f(d%ksymsetid, hdferr)
CALL h5dclose_f(d%jsymsetid, hdferr)
IF (d%l_mcd) THEN
CALL h5dclose_f(d%mcdsetid, hdferr)
ENDIF
IF (d%l_orb) THEN
CALL h5dclose_f(d%qintslsetid, hdferr)
CALL h5dclose_f(d%qmtslsetid, hdferr)
CALL h5dclose_f(d%qmtpsetid, hdferr)
CALL h5dclose_f(d%orbcompsetid, hdferr)
ENDIF
ENDIF
!close file
CALL h5fclose_f(d%fid,hdferr)
!If a filename was given and the name is not the current filename
......
......@@ -17,7 +17,7 @@ CONTAINS
FUNCTION open_eig(mpi_comm,nmat,neig,nkpts,jspins,lmax,nlo,ntype,nlotot,&
l_noco,l_create,l_real,l_soc,l_readonly,n_size,mode_in,&
filename,layers,nstars,ncored,nsld,nat,l_dos,l_mcd,l_orb)&
filename,layers,nstars,ncored,nsld,nat)&
RESULT(id)
USE m_eig66_hdf,ONLY:open_eig_hdf=>open_eig
USE m_eig66_DA ,ONLY:open_eig_DA=>open_eig
......@@ -27,7 +27,6 @@ CONTAINS
INTEGER,INTENT(IN) :: nmat,neig,nkpts,jspins,lmax,nlo,ntype,nlotot,mpi_comm
LOGICAL,INTENT(IN) :: l_noco,l_readonly,l_create,l_real,l_soc
INTEGER,INTENT(IN),OPTIONAL :: n_size,mode_in
LOGICAL,INTENT(IN),OPTIONAL :: l_dos,l_mcd,l_orb
CHARACTER(LEN=*),INTENT(IN),OPTIONAL :: filename
INTEGER,INTENT(IN),OPTIONAL :: layers,nstars,ncored,nsld,nat
INTEGER:: id,mode
......@@ -73,13 +72,13 @@ CONTAINS
CALL timestart("Open file/memory for IO of eig66")
SELECT CASE (eig66_data_mode(id))
CASE (DA_mode)
CALL open_eig_DA(id,nmat,neig_local,nkpts,jspins,lmax,nlo,ntype,nlotot,l_create,l_real,l_soc,l_dos,l_mcd,l_orb,filename,layers,nstars,ncored,nsld,nat)
CALL open_eig_DA(id,nmat,neig_local,nkpts,jspins,lmax,nlo,ntype,nlotot,l_create,l_real,l_soc,filename,layers,nstars,ncored,nsld,nat)
CASE (hdf_mode)
CALL open_eig_HDF(id,mpi_comm,nmat,neig_local,nkpts,jspins,lmax,nlo,ntype,l_create,l_real,l_soc,nlotot,l_readonly,l_dos,l_mcd,l_orb,filename,layers,nstars,ncored,nsld,nat)
CALL open_eig_HDF(id,mpi_comm,nmat,neig_local,nkpts,jspins,lmax,nlo,ntype,l_create,l_real,l_soc,nlotot,l_readonly,filename,layers,nstars,ncored,nsld,nat)
CASE (mem_mode)
CALL open_eig_MEM(id,nmat,neig_local,nkpts,jspins,lmax,nlo,ntype,l_create,l_real,l_soc,nlotot,l_noco,l_dos,l_mcd,l_orb,filename,layers,nstars,ncored,nsld,nat)
CALL open_eig_MEM(id,nmat,neig_local,nkpts,jspins,lmax,nlo,ntype,l_create,l_real,l_soc,nlotot,l_noco,filename,layers,nstars,ncored,nsld,nat)
CASE (mpi_mode)
CALL open_eig_MPI(id,mpi_comm,nmat,neig_local,nkpts,jspins,lmax,nlo,ntype,l_create,l_real,l_soc,nlotot,l_noco,n_size,l_dos,l_mcd,l_orb,filename,layers,nstars,ncored,nsld,nat)
CALL open_eig_MPI(id,mpi_comm,nmat,neig_local,nkpts,jspins,lmax,nlo,ntype,l_create,l_real,l_soc,nlotot,l_noco,n_size,filename,layers,nstars,ncored,nsld,nat)
CASE DEFAULT
CALL juDFT_error("Invalid IO-mode in eig66_io")
END SELECT
......
......@@ -25,10 +25,9 @@ CONTAINS
END SELECT
END SUBROUTINE priv_find_data
SUBROUTINE open_eig(id,nmat,neig,nkpts,jspins,lmax,nlo,ntype,l_create,l_real,l_soc,nlotot,l_noco,l_dos,l_mcd,l_orb,filename,layers,nstars,ncored,nsld,nat)
SUBROUTINE open_eig(id,nmat,neig,nkpts,jspins,lmax,nlo,ntype,l_create,l_real,l_soc,nlotot,l_noco,filename,layers,nstars,ncored,nsld,nat)
INTEGER, INTENT(IN) :: id,nmat,neig,nkpts,jspins,nlo,ntype,lmax,nlotot
LOGICAL, INTENT(IN) :: l_noco,l_create,l_real,l_soc
LOGICAL,INTENT(IN),OPTIONAL::l_dos,l_mcd,l_orb
CHARACTER(LEN=*),INTENT(IN),OPTIONAL :: filename
INTEGER,INTENT(IN),OPTIONAL :: layers,nstars,ncored,nsld,nat
!locals
......@@ -45,7 +44,7 @@ CONTAINS
ENDIF
CALL eig66_data_storedefault(d,jspins,nkpts,nmat,neig,lmax,nlotot,nlo,ntype,l_real,l_soc,l_dos,l_mcd,l_orb)
CALL eig66_data_storedefault(d,jspins,nkpts,nmat,neig,lmax,nlotot,nlo,ntype,l_real,l_soc)
!d%eig_int
ALLOCATE(d%eig_int(jspins*nkpts))
......@@ -61,22 +60,6 @@ CONTAINS
ALLOCATE(d%eig_vecc(nmat*neig,length*nkpts))
endif
length=length*nkpts
IF (d%l_dos) THEN
ALLOCATE(d%qal(0:3,ntype,neig,length))
ALLOCATE(d%qvac(neig,2,length))
ALLOCATE(d%qis(neig,length))
ALLOCATE(d%qvlay(neig,max(layers,1),2,length))
ALLOCATE(d%qstars(nstars,neig,max(layers,1),2,length))
ALLOCATE(d%ksym(neig,length))
ALLOCATE(d%jsym(neig,length))
IF (l_mcd) ALLOCATE(d%mcd(3*ntype,ncored,neig,length))
IF (l_orb) THEN
ALLOCATE(d%qintsl(nsld,neig,length))
ALLOCATE(d%qmtsl(nsld,neig,length))
ALLOCATE(d%qmtp(neig,nat,length))
ALLOCATE(d%orbcomp(neig,23,nat,length))
ENDIF
ENDIF
IF (PRESENT(filename)) CALL priv_readfromfile()
CONTAINS
SUBROUTINE priv_readfromfile()
......@@ -92,8 +75,7 @@ CONTAINS
ALLOCATE(zmat%data_r(nmat,neig),zmat%data_c(nmat,neig))
tmp_id=eig66_data_newid(DA_mode)
IF (d%l_dos) CPP_error("Can not read DOS-data")
CALL open_eig_IO(tmp_id,nmat,neig,nkpts,jspins,d%lmax,d%nlo,d%ntype,nlotot,.FALSE.,.FALSE.,l_real,l_soc,.FALSE.,.FALSE.,filename)
CALL open_eig_IO(tmp_id,nmat,neig,nkpts,jspins,d%lmax,d%nlo,d%ntype,nlotot,.FALSE.,l_real,l_soc,filename)
DO jspin=1,jspins
DO nk=1,nkpts
CALL read_eig_IO(tmp_id,nk,jspin,i,eig,w_iks,zmat=zmat)
......@@ -136,8 +118,7 @@ CONTAINS
zmat%matsize2=SIZE(d%eig_eig,1)
ALLOCATE(zmat%data_r(d%nmat,SIZE(d%eig_eig,1)),zmat%data_c(d%nmat,SIZE(d%eig_eig,1)))
tmp_id=eig66_data_newid(DA_mode)
IF (d%l_dos) CPP_error("Could not write DOS data")
CALL open_eig_DA(tmp_id,d%nmat,d%neig,d%nkpts,d%jspins,d%lmax,d%nlo,d%ntype,d%nlotot,.FALSE.,.FALSE.,d%l_real,d%l_soc,.FALSE.,.FALSE.,filename)
CALL open_eig_DA(tmp_id,d%nmat,d%neig,d%nkpts,d%jspins,d%lmax,d%nlo,d%ntype,d%nlotot,.FALSE.,d%l_real,d%l_soc,filename)
DO jspin=1,d%jspins
DO nk=1,d%nkpts
!TODO this code is no longer working
......
......@@ -25,13 +25,12 @@ CONTAINS
END SUBROUTINE priv_find_data
SUBROUTINE open_eig(id,mpi_comm,nmat,neig,nkpts,jspins,lmax,nlo,ntype,create,l_real,l_soc,nlotot,l_noco,n_size_opt,l_dos,l_mcd,l_orb,filename,layers,nstars,ncored,nsld,nat)
SUBROUTINE open_eig(id,mpi_comm,nmat,neig,nkpts,jspins,lmax,nlo,ntype,create,l_real,l_soc,nlotot,l_noco,n_size_opt,filename,layers,nstars,ncored,nsld,nat)
USE,INTRINSIC::iso_c_binding
IMPLICIT NONE
INTEGER, INTENT(IN) :: id,mpi_comm,nmat,neig,nkpts,jspins,nlo,ntype,lmax,nlotot
LOGICAL, INTENT(IN) :: l_noco,create,l_real,l_soc
INTEGER,INTENT(IN),OPTIONAL:: n_size_opt
LOGICAL,INTENT(IN),OPTIONAL ::l_dos,l_mcd,l_orb
CHARACTER(LEN=*),INTENT(IN),OPTIONAL :: filename
INTEGER,INTENT(IN),OPTIONAL :: layers,nstars,ncored,nsld,nat
#ifdef CPP_MPI
......@@ -40,7 +39,7 @@ CONTAINS
TYPE(t_data_MPI),POINTER :: d
CALL priv_find_data(id,d)
CALL eig66_data_storedefault(d,jspins,nkpts,nmat,neig,lmax,nlotot,nlo,ntype,l_real.and..not.l_soc,l_soc,l_dos,l_mcd,l_orb)
CALL eig66_data_storedefault(d,jspins,nkpts,nmat,neig,lmax,nlotot,nlo,ntype,l_real.and..not.l_soc,l_soc)
IF (PRESENT(n_size_opt)) d%n_size=n_size_opt
IF (ALLOCATED(d%pe_ev)) THEN
......@@ -53,17 +52,6 @@ CONTAINS
else
d%zc_data=0.0
endif
d%qal_data=0.0
d%qvac_data=0.0
d%qvlay_data=0.0
d%qstars_data=0.0
d%ksym_data=0.0
d%jsym_data=0.0
d%mcd_data=0.0
d%qintsl_data=0.0
d%qmtsl_data=0.0
d%qmtp_data=0.0
d%orbcomp_data=0.0
ENDIF
IF (PRESENT(filename)) CALL priv_readfromfile()
RETURN !everything already done!
......@@ -99,28 +87,6 @@ CONTAINS
else
CALL priv_create_memory(slot_size,local_slots,d%zc_handle,cmplx_data_ptr=d%zc_data)
endif
!Data for DOS etc
IF (d%l_dos) THEN
local_slots=COUNT(d%pe_basis==d%irank)
CALL priv_create_memory(4*ntype*neig,local_slots,d%qal_handle,real_data_ptr=d%qal_data)
CALL priv_create_memory(neig*2,local_slots,d%qvac_handle,real_data_ptr=d%qvac_data)
CALL priv_create_memory(neig,local_slots,d%qis_handle,real_data_ptr=d%qis_data)
CALL priv_create_memory(neig*max(1,layers)*2,local_slots,d%qvlay_handle,real_data_ptr=d%qvlay_data)
CALL priv_create_memory(max(1,nstars)*neig*max(1,layers)*2,local_slots,d%qstars_handle,cmplx_data_ptr=d%qstars_data)
CALL priv_create_memory(neig,local_slots,d%jsym_handle,d%jsym_data)
CALL priv_create_memory(neig,local_slots,d%ksym_handle,d%ksym_data)
IF (l_mcd) CALL priv_create_memory(3*ntype*mcored*neig,local_slots,d%mcd_handle,real_data_ptr=d%mcd_data)
IF (l_orb) THEN
CALL priv_create_memory(nsld*neig,local_slots,d%qintsl_handle,real_data_ptr=d%qintsl_data)
CALL priv_create_memory(nsld*neig,local_slots,d%qmtsl_handle,real_data_ptr=d%qmtsl_data)
CALL priv_create_memory(nat*neig,local_slots,d%qmtp_handle,real_data_ptr=d%qmtp_data)
CALL priv_create_memory(23*nat*neig,local_slots,d%orbcomp_handle,real_data_ptr=d%orbcomp_data)
ENDIF
ELSE
ALLOCATE(d%qal_data(1),d%qvac_data(1),d%qis_data(1),d%qvlay_data(1),d%qstars_data(1),&
d%jsym_data(1),d%ksym_data(1),d%mcd_data(1),d%qintsl_data(1),d%qmtsl_data(1),&
d%qmtp_data(1),d%orbcomp_data(1))
ENDIF
IF (PRESENT(filename).AND..NOT.create) CALL priv_readfromfile()
CALL MPI_BARRIER(MPI_COMM,e)
CALL timestop("create data spaces in ei66_mpi")
......@@ -186,8 +152,7 @@ CONTAINS
!only do this with PE=0
IF (d%irank==0) THEN
tmp_id=eig66_data_newid(DA_mode)
IF (d%l_dos) CPP_error("Could not read DOS data")
CALL open_eig_DA(tmp_id,nmat,neig,nkpts,jspins,lmax,nlo,ntype,nlotot,.FALSE.,.FALSE.,d%l_real,l_soc,.FALSE.,.FALSE.,filename)
CALL open_eig_DA(tmp_id,nmat,neig,nkpts,jspins,lmax,nlo,ntype,nlotot,.FALSE.,d%l_real,l_soc,filename)
DO jspin=1,jspins
DO nk=1,nkpts
!CALL read_eig_DA(tmp_id,nk,jspin,nv,i,bk3,wk,ii,eig,w_iks,el,ello,evac,zmat=zmat)
......@@ -228,8 +193,7 @@ CONTAINS
IF (d%irank==0) THEN
tmp_id=eig66_data_newid(DA_mode)
IF (d%l_dos) CPP_error("Could not write DOS data")
CALL open_eig_DA(tmp_id,d%nmat,d%neig,d%nkpts,d%jspins,d%lmax,d%nlo,d%ntype,d%nlotot,.FALSE.,.FALSE.,d%l_real,d%l_soc,.FALSE.,.FALSE.,filename)
CALL open_eig_DA(tmp_id,d%nmat,d%neig,d%nkpts,d%jspins,d%lmax,d%nlo,d%ntype,d%nlotot,.FALSE.,d%l_real,d%l_soc,filename)
DO jspin=1,d%jspins
DO nk=1,d%nkpts
!CALL read_eig(id,nk,jspin,nv,i,bk3,wk,ii,eig,w_iks,el,ello,evac,zmat=zmat)
......
......@@ -135,7 +135,7 @@ CONTAINS
!-Wannier
#ifdef CPP_CHASE
CALL init_chase(mpi,dimension,input,atoms,kpts,noco,vacuum,banddos,sym%invs.AND..NOT.noco%l_noco)
CALL init_chase(mpi,dimension,atoms,kpts,noco,vacuum,sym%invs.AND..NOT.noco%l_noco)
#endif
it = 0
......@@ -214,8 +214,8 @@ CONTAINS
IF (hybrid%l_hybrid) THEN
SELECT TYPE(xcpot)
TYPE IS(t_xcpot_inbuild)
CALL calc_hybrid(hybrid,kpts,atoms,input,DIMENSION,mpi,noco,&
cell,vacuum,oneD,banddos,results,sym,xcpot,vTot,it)
CALL calc_hybrid(hybrid,kpts,atoms,input,DIMENSION,mpi,noco,&
cell,vacuum,oneD,results,sym,xcpot,vTot,it)
END SELECT
ENDIF
!#endif
......
Markdown is supported
0% or . <