Commit 64580bf3 authored by Daniel Wortmann's avatar Daniel Wortmann

BUGFIX: do not use optional argument l_dos without checking

parent 7d22fe44
...@@ -30,7 +30,7 @@ CONTAINS ...@@ -30,7 +30,7 @@ CONTAINS
SUBROUTINE open_eig(id,nmat,neig,nkpts,jspins,lmax,nlo,ntype,nlotot,create,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_dos,l_mcd,l_orb,filename,layers,nstars,ncored,nsld,nat)
INTEGER, INTENT(IN) :: id,nmat,neig,nkpts,jspins,nlo,ntype,lmax,nlotot INTEGER, INTENT(IN) :: id,nmat,neig,nkpts,jspins,nlo,ntype,lmax,nlotot
LOGICAL, INTENT(IN) :: create LOGICAL, INTENT(IN) :: create
LOGICAL,INTENT(IN) :: l_dos,l_mcd,l_orb LOGICAL,INTENT(IN),OPTIONAL :: l_dos,l_mcd,l_orb
CHARACTER(LEN=*),INTENT(IN),OPTIONAL :: filename CHARACTER(LEN=*),INTENT(IN),OPTIONAL :: filename
INTEGER,INTENT(IN),OPTIONAL :: layers,nstars,ncored,nsld,nat INTEGER,INTENT(IN),OPTIONAL :: layers,nstars,ncored,nsld,nat
!locals !locals
...@@ -62,7 +62,7 @@ CONTAINS ...@@ -62,7 +62,7 @@ CONTAINS
d%recl_vec=recl_eig+recl_z d%recl_vec=recl_eig+recl_z
IF (l_dos) THEN IF (d%l_dos) THEN
IF (.NOT.(PRESENT(layers).AND.PRESENT(nstars).AND.PRESENT(ncored).AND.PRESENT(nsld).AND.PRESENT(nat))) & 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") CALL judft_error("BUG:Could not open file for DOS-data",calledby="eig66_da")
INQUIRE(IOLENGTH=i1) i1 INQUIRE(IOLENGTH=i1) i1
......
...@@ -59,7 +59,8 @@ CONTAINS ...@@ -59,7 +59,8 @@ CONTAINS
INTEGER, INTENT(IN) :: id,mpi_comm INTEGER, INTENT(IN) :: id,mpi_comm
INTEGER, INTENT(IN) :: nmat,neig,nkpts,jspins,nlo,ntype,lmax INTEGER, INTENT(IN) :: nmat,neig,nkpts,jspins,nlo,ntype,lmax
LOGICAL, INTENT(IN) :: create,readonly,l_dos,l_mcd,l_orb LOGICAL, INTENT(IN) :: create,readonly
LOGICAL, INTENT(IN),OPTIONAL ::l_dos,l_mcd,l_orb
CHARACTER(LEN=*),OPTIONAL :: filename CHARACTER(LEN=*),OPTIONAL :: filename
INTEGER,INTENT(IN),OPTIONAL :: layers,nstars,ncored,nsld,nat INTEGER,INTENT(IN),OPTIONAL :: layers,nstars,ncored,nsld,nat
...@@ -150,7 +151,7 @@ CONTAINS ...@@ -150,7 +151,7 @@ CONTAINS
CALL h5dcreate_f(d%fid, "k", H5T_NATIVE_INTEGER, spaceid, d%ksetid, hdferr) CALL h5dcreate_f(d%fid, "k", H5T_NATIVE_INTEGER, spaceid, d%ksetid, hdferr)
CALL h5sclose_f(spaceid,hdferr) CALL h5sclose_f(spaceid,hdferr)
!stuff for dos etc !stuff for dos etc
IF (l_dos) THEN IF (d%l_dos) THEN
dims(:5)=(/4,ntype,neig,nkpts,jspins/) dims(:5)=(/4,ntype,neig,nkpts,jspins/)
CALL h5screate_simple_f(5,dims(:5),spaceid,hdferr) CALL h5screate_simple_f(5,dims(:5),spaceid,hdferr)
CALL h5dcreate_f(d%fid, "qal", H5T_NATIVE_DOUBLE, spaceid, d%qalsetid, hdferr) CALL h5dcreate_f(d%fid, "qal", H5T_NATIVE_DOUBLE, spaceid, d%qalsetid, hdferr)
...@@ -218,7 +219,7 @@ CONTAINS ...@@ -218,7 +219,7 @@ CONTAINS
CALL h5dopen_f(d%fid, 'ev', d%evsetid, hdferr) CALL h5dopen_f(d%fid, 'ev', d%evsetid, hdferr)
CALL h5dopen_f(d%fid, 'nv', d%nvsetid, hdferr) CALL h5dopen_f(d%fid, 'nv', d%nvsetid, hdferr)
CALL h5dopen_f(d%fid, 'nmat', d%nmatsetid, hdferr) CALL h5dopen_f(d%fid, 'nmat', d%nmatsetid, hdferr)
IF (l_dos) THEN IF (d%l_dos) THEN
CALL h5dopen_f(d%fid, 'qal', d%qalsetid, hdferr) CALL h5dopen_f(d%fid, 'qal', d%qalsetid, hdferr)
CALL h5dopen_f(d%fid, 'qvac', d%qvacsetid, hdferr) CALL h5dopen_f(d%fid, 'qvac', d%qvacsetid, hdferr)
CALL h5dopen_f(d%fid, 'qis', d%qissetid, hdferr) CALL h5dopen_f(d%fid, 'qis', d%qissetid, hdferr)
...@@ -269,7 +270,7 @@ CONTAINS ...@@ -269,7 +270,7 @@ CONTAINS
CALL h5dclose_f(d%evsetid,hdferr) CALL h5dclose_f(d%evsetid,hdferr)
CALL h5dclose_f(d%nvsetid,hdferr) CALL h5dclose_f(d%nvsetid,hdferr)
CALL h5dclose_f(d%nmatsetid,hdferr) CALL h5dclose_f(d%nmatsetid,hdferr)
IF (l_dos) THEN IF (d%l_dos) THEN
CALL h5dclose_f(d%qalsetid, hdferr) CALL h5dclose_f(d%qalsetid, hdferr)
CALL h5dclose_f(d%qvacsetid, hdferr) CALL h5dclose_f(d%qvacsetid, hdferr)
CALL h5dclose_f(d%qissetid, hdferr) CALL h5dclose_f(d%qissetid, hdferr)
......
...@@ -27,7 +27,8 @@ CONTAINS ...@@ -27,7 +27,8 @@ CONTAINS
SUBROUTINE open_eig(id,nmat,neig,nkpts,jspins,lmax,nlo,ntype,l_create,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,nlotot,l_noco,l_dos,l_mcd,l_orb,filename,layers,nstars,ncored,nsld,nat)
INTEGER, INTENT(IN) :: id,nmat,neig,nkpts,jspins,nlo,ntype,lmax,nlotot INTEGER, INTENT(IN) :: id,nmat,neig,nkpts,jspins,nlo,ntype,lmax,nlotot
LOGICAL, INTENT(IN) :: l_noco,l_create,l_dos,l_mcd,l_orb LOGICAL, INTENT(IN) :: l_noco,l_create
LOGICAL,INTENT(IN),OPTIONAL::l_dos,l_mcd,l_orb
CHARACTER(LEN=*),INTENT(IN),OPTIONAL :: filename CHARACTER(LEN=*),INTENT(IN),OPTIONAL :: filename
INTEGER,INTENT(IN),OPTIONAL :: layers,nstars,ncored,nsld,nat INTEGER,INTENT(IN),OPTIONAL :: layers,nstars,ncored,nsld,nat
!locals !locals
...@@ -72,7 +73,7 @@ CONTAINS ...@@ -72,7 +73,7 @@ CONTAINS
ALLOCATE(d%eig_vecc(nmat*neig,length*nkpts)) ALLOCATE(d%eig_vecc(nmat*neig,length*nkpts))
#endif #endif
length=length*nkpts length=length*nkpts
IF (l_dos) THEN IF (d%l_dos) THEN
ALLOCATE(d%qal(0:3,ntype,neig,length)) ALLOCATE(d%qal(0:3,ntype,neig,length))
ALLOCATE(d%qvac(neig,2,length)) ALLOCATE(d%qvac(neig,2,length))
ALLOCATE(d%qis(neig,length)) ALLOCATE(d%qis(neig,length))
...@@ -102,7 +103,7 @@ CONTAINS ...@@ -102,7 +103,7 @@ CONTAINS
COMPLEX :: z(nmat,neig) COMPLEX :: z(nmat,neig)
#endif #endif
tmp_id=eig66_data_newid(DA_mode) tmp_id=eig66_data_newid(DA_mode)
IF (l_dos) CPP_error("Can not read DOS-data") 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.,.FALSE.,.FALSE.,filename) CALL open_eig_IO(tmp_id,nmat,neig,nkpts,jspins,d%lmax,d%nlo,d%ntype,nlotot,.FALSE.,.FALSE.,.FALSE.,.FALSE.,filename)
DO jspin=1,jspins DO jspin=1,jspins
DO nk=1,nkpts DO nk=1,nkpts
......
...@@ -34,7 +34,7 @@ CONTAINS ...@@ -34,7 +34,7 @@ CONTAINS
INTEGER, INTENT(IN) :: id,mpi_comm,nmat,neig,nkpts,jspins,nlo,ntype,lmax,nlotot INTEGER, INTENT(IN) :: id,mpi_comm,nmat,neig,nkpts,jspins,nlo,ntype,lmax,nlotot
LOGICAL, INTENT(IN) :: l_noco,create LOGICAL, INTENT(IN) :: l_noco,create
INTEGER,INTENT(IN),OPTIONAL:: n_size_opt INTEGER,INTENT(IN),OPTIONAL:: n_size_opt
LOGICAL,INTENT(IN) ::l_dos,l_mcd,l_orb LOGICAL,INTENT(IN),OPTIONAL ::l_dos,l_mcd,l_orb
CHARACTER(LEN=*),INTENT(IN),OPTIONAL :: filename CHARACTER(LEN=*),INTENT(IN),OPTIONAL :: filename
INTEGER,INTENT(IN),OPTIONAL :: layers,nstars,ncored,nsld,nat INTEGER,INTENT(IN),OPTIONAL :: layers,nstars,ncored,nsld,nat
#ifdef CPP_MPI #ifdef CPP_MPI
...@@ -112,7 +112,7 @@ CONTAINS ...@@ -112,7 +112,7 @@ CONTAINS
CALL priv_create_memory(slot_size,local_slots,d%zc_data,d%zc_handle) CALL priv_create_memory(slot_size,local_slots,d%zc_data,d%zc_handle)
#endif #endif
!Data for DOS etc !Data for DOS etc
IF (l_dos) THEN IF (d%l_dos) THEN
local_slots=COUNT(d%pe_basis==d%irank) local_slots=COUNT(d%pe_basis==d%irank)
CALL priv_create_memory(4*ntype*neig,local_slots,d%qal_data,d%qal_handle) CALL priv_create_memory(4*ntype*neig,local_slots,d%qal_data,d%qal_handle)
CALL priv_create_memory(neig*2,local_slots,d%qvac_data,d%qvac_handle) CALL priv_create_memory(neig*2,local_slots,d%qvac_data,d%qvac_handle)
...@@ -179,7 +179,7 @@ CONTAINS ...@@ -179,7 +179,7 @@ CONTAINS
!only do this with PE=0 !only do this with PE=0
IF (d%irank==0) THEN IF (d%irank==0) THEN
tmp_id=eig66_data_newid(DA_mode) tmp_id=eig66_data_newid(DA_mode)
IF (l_dos) CPP_error("Could not read DOS data") 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.,.FALSE.,.FALSE.,filename) CALL open_eig_DA(tmp_id,nmat,neig,nkpts,jspins,lmax,nlo,ntype,nlotot,.FALSE.,.FALSE.,.FALSE.,.FALSE.,filename)
DO jspin=1,jspins DO jspin=1,jspins
DO nk=1,nkpts DO nk=1,nkpts
......
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