Skip to content

GitLab

fleur
fleur
Commit a66945e4 authored by Daniel Wortmann's avatar Daniel Wortmann
Browse files
Options

Modified IO of DOS and related data 

This is now included in the eig-file, hence
two new routines in eig66_io have been created.
parent e15587dc
Expand all Hide whitespace changes
Inline Side-by-side
Showing with 2099 additions and 1617 deletions
cdn/cdnval.F90
View file @ a66945e4
......@@ -44,6 +44,7 @@ CONTAINS
! and bands
!***********************************************************************
!
USE m_eig66_io,ONLY: write_dos
USE m_radfun
USE m_radflo
USE m_rhomt
......@@ -158,8 +159,8 @@ CONTAINS
INTEGER, ALLOCATABLE :: nmtsl(:,:),nslat(:,:)
REAL, ALLOCATABLE :: zsl(:,:),volsl(:)
REAL, ALLOCATABLE :: volintsl(:)
REAL, ALLOCATABLE :: qintsl(:,:,:,:),qmtsl(:,:,:,:)
REAL, ALLOCATABLE :: orbcomp(:,:,:,:,:),qmtp(:,:,:,:)
REAL, ALLOCATABLE :: qintsl(:,:),qmtsl(:,:)
REAL, ALLOCATABLE :: orbcomp(:,:,:),qmtp(:,:)
!-new_sl
!-dw
INTEGER, ALLOCATABLE :: gvac1d(:),gvac2d(:) ,kveclo(:)
......@@ -429,10 +430,10 @@ CONTAINS
atoms,cell,nsld,&
nsl,zsl,nmtsl,nslat,volsl,volintsl)
!
ALLOCATE ( qintsl(nsld,dimension%neigd,kpts%nkptd,dimension%jspd))
ALLOCATE ( qmtsl(nsld,dimension%neigd,kpts%nkptd,jsp_start:jsp_end))
ALLOCATE ( orbcomp(dimension%neigd,23,atoms%natd,kpts%nkptd,jsp_start:jsp_end) )
ALLOCATE ( qmtp(dimension%neigd,atoms%natd,kpts%nkptd,jsp_start:jsp_end) )
ALLOCATE ( qintsl(nsld,dimension%neigd))
ALLOCATE ( qmtsl(nsld,dimension%neigd))
ALLOCATE ( orbcomp(dimension%neigd,23,atoms%natd) )
ALLOCATE ( qmtp(dimension%neigd,atoms%natd) )
IF (.not.input%film) qvac(:,:,:,jspin) = 0.0
ENDIF
!-q_sl
......@@ -626,7 +627,7 @@ CONTAINS
cell,&
z,noccbd,lapw,&
nsl,zsl,nmtsl,oneD,&
qintsl(:,:,ikpt,jspin))
qintsl(:,:))
!
ENDIF
ENDIF
......@@ -727,7 +728,7 @@ CONTAINS
IF (banddos%dos.AND.(banddos%ndir.EQ.-3)) THEN
CALL q_mt_sl(ispin, atoms,noccbd,nsld, ikpt,noccbd,ccof(-atoms%llod,1,1,1,ispin),&
skip_t,noccbd, acof(:,0:,:,ispin),bcof(:,0:,:,ispin),usdus,&
nmtsl,nsl, qmtsl(:,:,ikpt,ispin))
nmtsl,nsl, qmtsl(:,:))
!
INQUIRE (file='orbcomprot',exist=l_orbcomprot)
......@@ -738,7 +739,7 @@ CONTAINS
ENDIF
CALL orb_comp(ispin,noccbd,atoms,noccbd,usdus,acof(1:,0:,1:,ispin),bcof(1:,0:,1:,ispin),&
ccof(-atoms%llod:,1:,1:,1:,ispin), orbcomp(:,:,:,ikpt,ispin), qmtp(:,:,ikpt,ispin))
ccof(-atoms%llod:,1:,1:,1:,ispin), orbcomp, qmtp)
!
ENDIF
!-new
......@@ -829,56 +830,10 @@ CONTAINS
!
!--dw now write k-point data to tmp_dos
!
CALL judft_error("IO in cdnval not implemented")
IF (mpi%irank==0) THEN
IF ( .not.l_mcd ) THEN
DO ispin = jsp_start,jsp_end
WRITE (84,rec=kpts%nkpt*(ispin-1)+ikpt) bkpt,wk,nbands,eig,&
& qal(:,:,:,ispin),qvac(:,:,ikpt,ispin),&
& qis(:,ikpt,ispin),qvlay(:,:,:,ikpt,ispin),&
& qstars,ksym,jsym
ENDDO
ELSE
WRITE (84,rec=kpts%nkpt*(jspin-1)+ikpt) bkpt,wk,nbands,eig,&
& qal(:,:,:,jspin),qvac(:,:,ikpt,jspin),&
& qis(:,ikpt,jspin),qvlay(:,:,:,ikpt,jspin),&
& qstars,ksym,jsym,mcd(:,1:ncored,:)
ENDIF ! not.l_mcd
!+new_sl
IF (banddos%ndir.EQ.-3) THEN
IF ( .not.l_mcd ) THEN
DO ispin = jsp_start,jsp_end
WRITE (129,rec=kpts%nkpt*(ispin-1)+ikpt) bkpt,wk,&
nbands,eig,qvac(:,:,ikpt,ispin),&
qintsl(:,:,ikpt,ispin),&
qmtsl(:,:,ikpt,ispin),&
orbcomp(:,:,:,ikpt,ispin),&
qmtp(:,:,ikpt,ispin)
ENDDO
ELSE
WRITE (6,FMT=500)
WRITE (16,FMT=500)
500 FORMAT('A calculation of an orbital composition&
&of input%film states (s,px,py,pz,....)&
& for the l_mcd case is not implemented.')
ENDIF ! not.l_mcd
ENDIF ! banddos%ndir == -3
ENDIF ! mpi%irank==0
#ifdef CPP_MPI
DO ispin = jsp_start,jsp_end
CALL mpi_col_dos(&
mpi,l_evp,noccbd,noccbd_l,&
dimension,atoms,atoms,&
nsld,ncored,&
vacuum,vacuum,l_mcd,banddos,kpts,ispin,ikpt,&
bkpt,wk,nbands,eig,qal(0,1,1,ispin),&
qvac(1,1,ikpt,ispin),qis(1,nkpt,ispin),&
qvlay(:,:,:,ikpt,ispin),qstars,ksym,&
jsym,m_mcd,qintsl(:,:,ikpt,ispin),&
qmtsl(:,:,ikpt,ispin),qmtp(:,:,ikpt,ispin),&
orbcomp(:,:,:,ikpt,ispin))
ENDDO
#endif
call write_dos(eig_id,ikpt,ispin,qal(:,:,:,ispin),qvac(:,:,ikpt,ispin),qis(:,ikpt,ispin),&
qvlay(:,:,:,ikpt,ispin),qstars,ksym,jsym,mcd,qintsl,&
qmtsl(:,:),qmtp(:,:),orbcomp)
CALL timestop("cdnval: write_info")
!-new_sl
ENDIF
......@@ -917,7 +872,7 @@ enddo
call timestart("cdnval: dos")
IF (mpi%irank==0) THEN
CALL doswrite(&
dimension,kpts,atoms,vacuum,&
eig_id,dimension,kpts,atoms,vacuum,&
input,banddos,&
sliceplot,noco,sym,&
cell,&
......@@ -925,7 +880,7 @@ enddo
results%ef,nsld,oneD)
IF (banddos%dos.AND.(banddos%ndir.EQ.-3)) THEN
CALL Ek_write_sl(&
dimension,kpts,atoms,vacuum,&
eig_id,dimension,kpts,atoms,vacuum,&
nsld,input,jspin,&
sym,cell,&
nsl,nslat)
......
dos/Ek_write_sl.f90
View file @ a66945e4
MODULE m_Ekwritesl
use m_juDFT
CONTAINS
SUBROUTINE Ek_write_sl(&
& dimension,kpts,atoms,vacuum,nsld,&
& input,jspin,&
& sym,cell,&
& nsl,nslat)
SUBROUTINE Ek_write_sl(eig_id,dimension,kpts,atoms,vacuum,nsld,&
input,jspin, sym,cell, nsl,nslat)
!-----------------------------------------------------------------
!-- now write E(k) for all kpts if on T3E
!-- now read data from tmp_dos and write of E(k) in ek_orbcomp
!-----------------------------------------------------------------
USE m_types
USE m_eig66_io
IMPLICIT NONE
TYPE(t_dimension),INTENT(IN) :: dimension
TYPE(t_input),INTENT(IN) :: input
......@@ -21,7 +19,7 @@ CONTAINS
TYPE(t_atoms),INTENT(IN) :: atoms
! ..
! .. Scalar Arguments ..
INTEGER, INTENT (IN) :: nsld
INTEGER, INTENT (IN) :: nsld,eig_id
INTEGER, INTENT (IN) :: nsl ,jspin
! ..
! .. Array Arguments ..
......@@ -36,19 +34,22 @@ CONTAINS
INTEGER norb(23),iqsl(nsld),iqvacpc(2)
REAL bkpt(3),qvact(2)
REAL, ALLOCATABLE :: eig(:),qvac(:,:,:,:),orbcomp(:,:,:,:,:)
REAL, ALLOCATABLE :: qal(:,:,:),qis(:),qvlay(:,:,:)
COMPLEX,ALLOCATABLE::qstars(:,:,:,:)
INTEGER,ALLOCATABLE::ksym(:),jsym(:)
REAL, ALLOCATABLE :: qintsl(:,:,:,:),qmtsl(:,:,:,:),qmtp(:,:,:,:)
CHARACTER (len=2) :: chntype
CHARACTER (len=99) :: chform
! ..
! .. Intrinsic Functions
INTRINSIC nint
!
IF (nsl.GT.nsld) THEN
CALL juDFT_error("nsl.GT.nsld",calledby="Ek_write_sl")
ENDIF
ALLOCATE(eig(dimension%neigd),orbcomp(dimension%neigd,23,atoms%natd,kpts%nkptd,dimension%jspd))
ALLOCATE(qvac(dimension%neigd,2,kpts%nkptd,dimension%jspd),qintsl(nsld,dimension%neigd,kpts%nkptd,dimension%jspd))
ALLOCATE(qmtsl(nsld,dimension%neigd,kpts%nkptd,dimension%jspd),qmtp(dimension%neigd,atoms%natd,kpts%nkptd,dimension%jspd))
ALLOCATE(qal(4,atoms%ntype,dimension%neigd),qis(dimension%neigd),qvlay(dimension%neigd,vacuum%layerd,2))
ALLOCATE(qstars(vacuum%nstars,dimension%neigd,vacuum%layerd,2))
ALLOCATE(ksym(dimension%neigd),jsym(dimension%neigd))
!
! ---> open files for a bandstucture with an orbital composition
! ---> in the case of the film geometry
......@@ -83,10 +84,9 @@ CONTAINS
!==============================================================
DO ikpt=1,kpts%nkpt
!
READ (129,rec=kpts%nkpt*(kspin-1)+ikpt) bkpt,wk,nbands,eig,&
& qvac(:,:,ikpt,kspin),qintsl(:,:,ikpt,kspin),&
& qmtsl(:,:,ikpt,kspin),&
& orbcomp(:,:,:,ikpt,kspin),qmtp(:,:,ikpt,kspin)
call read_eig(eig_id,ikpt,kspin,bk=bkpt,neig=nbands,eig=eig)
call read_dos(eig_id,ikpt,kspin,qal,qvac(:,:,ikpt,kspin),qis,qvlay,qstars,ksym,jsym,&
qintsl=qintsl(:,:,ikpt,kspin),qmtsl= qmtsl(:,:,ikpt,kspin),qmtp=qmtp(:,:,ikpt,kspin),orbcomp=orbcomp(:,:,:,ikpt,kspin))
! write(*,*) kspin,nkpt,qmtp(1,:,ikpt,kspin)
!
WRITE (130,FMT=8000) (bkpt(i),i=1,3)
......
dos/doswrite.f90
View file @ a66945e4
......@@ -6,17 +6,18 @@ MODULE m_doswrite
!
CONTAINS
SUBROUTINE doswrite(&
& DIMENSION,kpts,atoms,vacuum,&
& eig_id,DIMENSION,kpts,atoms,vacuum,&
& input,banddos,&
& sliceplot,noco,sym,&
& cell,&
& l_mcd,ncored,ncore,e_mcd,&
& efermi,nsld,oneD)
USE m_eig66_io,ONLY:read_dos
USE m_evaldos
USE m_cdninf
USE m_types
IMPLICIT NONE
TYPE(t_dimension),INTENT(IN) :: DIMENSION
TYPE(t_oneD),INTENT(IN) :: oneD
TYPE(t_banddos),INTENT(IN) :: banddos
......@@ -31,7 +32,7 @@ CONTAINS
! .. Scalar Arguments ..
INTEGER,PARAMETER :: n2max=13
INTEGER, INTENT (IN) :: nsld
INTEGER, INTENT (IN) :: nsld,eig_id
INTEGER, INTENT (IN) :: ncored
REAL, INTENT (IN) :: efermi
LOGICAL, INTENT (IN) :: l_mcd
......@@ -98,10 +99,10 @@ CONTAINS
ENDIF
DO ikpt=1,kpts%nkpt
READ (84,rec=kpts%nkpt*(kspin-1)+ikpt) bkpt,wk,ne,eig,&
call read_dos(eig_id,ikpt,kspin,&
& qal(:,:,:,kspin),qvac(:,:,ikpt,kspin),&
& qis(:,ikpt,kspin),&
& qvlay(:,:,:),qstars,ksym,jsym
& qvlay(:,:,:),qstars,ksym,jsym)
CALL cdninf(&
& input,sym,noco,kspin,atoms,&
......@@ -127,7 +128,7 @@ CONTAINS
!
IF (banddos%dos.AND.(banddos%ndir.LT.0)) THEN
CALL evaldos(&
& input,banddos,vacuum,kpts,atoms,sym,noco,oneD,cell,&
& eig_id,input,banddos,vacuum,kpts,atoms,sym,noco,oneD,cell,&
& DIMENSION,efermi,&
& l_mcd,ncored,ncore,e_mcd,nsld)
ENDIF
......
dos/evaldos.f90
View file @ a66945e4
MODULE m_evaldos
CONTAINS
SUBROUTINE evaldos(input,banddos,vacuum,kpts,atoms,sym,noco,oneD,cell,&
SUBROUTINE evaldos(eig_id,input,banddos,vacuum,kpts,atoms,sym,noco,oneD,cell,&
dimension,efermiarg, l_mcd,ncored,ncore,e_mcd,nsld)
!----------------------------------------------------------------------
!
......@@ -19,6 +19,7 @@
! ntb=max(nevk)
!
!----------------------------------------------------------------------
USE m_eig66_io,ONLY:read_dos
USE m_triang
USE m_maketetra
USE m_tetrados
......@@ -27,7 +28,7 @@
USE m_smooth
USE m_types
IMPLICIT NONE
INTEGER,INTENT(IN) :: eig_id
TYPE(t_dimension),INTENT(IN) :: dimension
TYPE(t_oneD),INTENT(IN) :: oneD
TYPE(t_banddos),INTENT(IN) :: banddos
......@@ -62,7 +63,7 @@
REAL vk(3,kpts%nkptd),wt(kpts%nkptd),voltet(6*kpts%nkpt),kx(kpts%nkpt),vkr(3,kpts%nkpt)
REAL ev(dimension%neigd,kpts%nkptd),e(ned),gpart(ned,atoms%ntype),atr(2*kpts%nkpt)
REAL e_grid(ned+1),spect(ned,3*atoms%ntypd),ferwe(dimension%neigd,kpts%nkptd)
REAL, ALLOCATABLE :: qal(:,:,:),qval(:,:,:),qlay(:,:,:),g(:,:)
REAL, ALLOCATABLE :: qal(:,:,:),qval(:,:,:),qlay(:,:,:),g(:,:),qal_tmp(:,:,:),qis(:),qvlay(:,:,:)
REAL, ALLOCATABLE :: mcd(:,:,:),orbcomp(:,:,:),qmtp(:,:)
REAL, ALLOCATABLE :: qintsl(:,:),qmtsl(:,:),qvac(:,:)
COMPLEX, ALLOCATABLE :: qstars(:,:,:,:)
......@@ -155,44 +156,35 @@
ENDDO
ENDDO
!
! read data from dos_tmp file!
! read data from file!
!
IF (( .not.l_mcd ).AND.(banddos%ndir.NE.-3)) THEN
READ(84,rec=kpts%nkpt*(jspin-1)+k) vk(:,k),wt(k),nevk(k),ev(:,k),&
qal(1:lmax*atoms%ntype,:,k), & ! atoms 1...atoms%ntype&
qal(lmax*atoms%ntype+2,:,k), & ! vacuum 1&
qal(lmax*atoms%ntype+3,:,k), & ! vacuum 2&
qal(lmax*atoms%ntype+1,:,k), & ! interstitial&
qlay,qstars
ELSEIF (banddos%ndir.NE.-3) THEN
ALLOCATE( ksym(dimension%neigd),jsym(dimension%neigd) )
READ(84,rec=kpts%nkpt*(jspin-1)+k) vk(:,k),wt(k),nevk(k),ev(:,k),&
qal(1:lmax*atoms%ntype,:,k), & ! atoms 1...atoms%ntype&
qal(lmax*atoms%ntype+2,:,k), & ! vacuum 1&
qal(lmax*atoms%ntype+3,:,k), & ! vacuum 2&
qal(lmax*atoms%ntype+1,:,k), & ! interstitial&
qlay,qstars,ksym,jsym,&
mcd(:,:,k)
ALLOCATE( qal_tmp(1:lmax,atoms%ntype,dimension%neigd))
ALLOCATE( orbcomp(dimension%neigd,23,atoms%natd),qintsl(nsld,dimension%neigd))
ALLOCATE( qmtsl(nsld,dimension%neigd),qmtp(dimension%neigd,atoms%natd),qvac(dimension%neigd,2))
ALLOCATE( qis(dimension%neigd),qvlay(dimension%neigd,vacuum%layerd,2))
CALL read_dos(eig_id,k,jspin,qal_tmp,qvac,qis,qvlay,qstars,ksym,jsym,mcd,qintsl,qmtsl,qmtp,orbcomp)
qal(1:lmax*atoms%ntype,:,k)=reshape(qal_tmp,(/lmax*atoms%ntype,size(qal_tmp,3)/))
qal(lmax*atoms%ntype+2,:,k)=qvac(:,1) ! vacuum 1
qal(lmax*atoms%ntype+3,:,k)=qvac(:,2) ! vacuum 2
qal(lmax*atoms%ntype+1,:,k)=qis ! interstitial
DEALLOCATE( ksym,jsym )
ELSE
ALLOCATE( orbcomp(dimension%neigd,23,atoms%natd),qintsl(nsld,dimension%neigd))
ALLOCATE( qmtsl(nsld,dimension%neigd),qmtp(dimension%neigd,atoms%natd),qvac(dimension%neigd,2))
READ (129,rec=kpts%nkpt*(jspin-1)+k) vk(:,k),wt(k),nevk(k),ev(:,k),qvac,qintsl,qmtsl,orbcomp,qmtp
IF (n_orb == 0) THEN
qal(1:nsld,:,k) = qintsl(:,:)
qal(nsld+1:2*nsld,:,k) = qmtsl(:,:)
ELSE
DO i = 1, 23
DO l = 1, nevk(k)
qal(i,l,k) = orbcomp(l,i,n_orb)*qmtp(l,n_orb)/10000.
ENDDO
DO l = nevk(k)+1, dimension%neigd
qal(i,l,k) = 0.0
ENDDO
ENDDO
ENDIF
DEALLOCATE( orbcomp,qintsl,qmtsl,qmtp,qvac)
ENDIF
IF (l_orbcomp)THEN
IF (n_orb == 0) THEN
qal(1:nsld,:,k) = qintsl(:,:)
qal(nsld+1:2*nsld,:,k) = qmtsl(:,:)
ELSE
DO i = 1, 23
DO l = 1, nevk(k)
qal(i,l,k) = orbcomp(l,i,n_orb)*qmtp(l,n_orb)/10000.
ENDDO
DO l = nevk(k)+1, dimension%neigd
qal(i,l,k) = 0.0
ENDDO
ENDDO
ENDIF
ENDIF
DEALLOCATE( orbcomp,qintsl,qmtsl,qmtp,qvac,qis,qal_tmp,qvlay)
ntb = max(ntb,nevk(k))
!
! set vacuum partial charge zero, if bulk calculation
......
io/eig66_da.F90
View file @ a66945e4
This diff is collapsed.
io/eig66_data.F90
View file @ a66945e4
......@@ -8,25 +8,32 @@ 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
END TYPE
TYPE,EXTENDS(t_data):: t_data_DA
REAL, ALLOCATABLE:: el_s(:,:),ello_s(:,:),evac_s(:)
INTEGER,ALLOCATABLE:: kvec_s(:,:),kveclo_s(:)
INTEGER :: recl_bas=0,recl_vec=0
INTEGER :: recl_bas=0,recl_vec=0,recl_dos
CHARACTER(LEN=20) :: fname="eig"
INTEGER :: file_io_id_bas,file_io_id_vec
INTEGER :: file_io_id_bas,file_io_id_vec,file_io_id_dos
END TYPE
TYPE,extends(t_data):: t_data_MPI
INTEGER :: n_size=1
INTEGER :: size_k,size_el,size_ello,size_eig
INTEGER :: int_handle,real_handle,eig_handle,zr_handle,zc_handle,neig_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(:),int_data(:)
REAL,POINTER :: eig_data(:),zr_data(:),real_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
......@@ -36,6 +43,9 @@ module m_eig66_data
INTEGER(HID_T) :: bksetid,wksetid,ksetid
INTEGER(HID_T) :: neigsetid,nvsetid,nmatsetid
INTEGER(HID_T) :: energysetid,evsetid
INTEGER(HID_T) :: qalsetid,qvacsetid,qissetid,qvlaysetid
INTEGER(HID_T) :: qstarssetid,ksymsetid,jsymsetid,mcdsetid
INTEGER(HID_T) :: qintslsetid,qmtslsetid,qmtpstid,orbcompsetid
CHARACTER(LEN=20) :: fname="eig"
#endif
END TYPE
......@@ -46,6 +56,18 @@ 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
......@@ -62,9 +84,10 @@ module m_eig66_data
contains
subroutine eig66_data_storedefault(d,jspins,nkpts,nmat,neig,lmax,nlotot,nlo,ntype)
subroutine eig66_data_storedefault(d,jspins,nkpts,nmat,neig,lmax,nlotot,nlo,ntype,l_dos,l_mcd,l_orb)
CLASS(t_data)::d
INTEGER,INTENT(IN)::jspins,nkpts,nmat,neig,lmax,nlotot,nlo,ntype
LOGICAL,INTENT(IN)::l_dos,l_mcd,l_orb
d%jspins=jspins
d%nkpts=nkpts
d%nmat=nmat
......@@ -73,6 +96,9 @@ module m_eig66_data
d%nlotot=nlotot
d%nlo=nlo
d%ntype=ntype
d%l_dos=l_dos
d%l_mcd=l_mcd
d%l_orb=l_orb
END SUBROUTINE
subroutine eig66_find_data(d,id,io_mode)
......
io/eig66_hdf.F90
View file @ a66945e4
This diff is collapsed.
io/eig66_io.F90
View file @ a66945e4
MODULE m_eig66_io
#include "juDFT_env.h"
use m_eig66_data
IMPLICIT NONE
PRIVATE
USE m_eig66_data
IMPLICIT NONE
PRIVATE
PUBLIC open_eig,close_eig
PUBLIC read_eig, write_eig
CONTAINS
PUBLIC open_eig,close_eig
PUBLIC read_eig, write_eig
PUBLIC read_dos,write_dos
CONTAINS
FUNCTION open_eig(mpi_comm,nmat,neig,nkpts,jspins,lmax,nlo,ntype,nlotot,l_noco,l_create,l_readonly,n_size,mode_in,filename)result(id)
FUNCTION open_eig(mpi_comm,nmat,neig,nkpts,jspins,lmax,nlo,ntype,nlotot,l_noco,l_create,l_readonly,n_size,mode_in,filename,layers,nstars,ncored,nsld,nat,l_dos,l_mcd,l_orb)RESULT(id)
USE m_eig66_hdf,ONLY:open_eig_hdf=>open_eig
USE m_eig66_DA ,ONLY:open_eig_DA=>open_eig
USE m_eig66_mem,ONLY:open_eig_mem=>open_eig
......@@ -17,7 +18,9 @@ MODULE m_eig66_io
INTEGER,INTENT(IN) :: nmat,neig,nkpts,jspins,lmax,nlo,ntype,nlotot,mpi_comm
LOGICAL,INTENT(IN) :: l_noco,l_readonly,l_create
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
INTEGER:: neig_local,isize,err
......@@ -27,7 +30,7 @@ MODULE m_eig66_io
neig_local=neig
#endif
mode=-1
if (present(mode_in)) mode=mode_in
IF (PRESENT(mode_in)) mode=mode_in
IF (mode<0) THEN
!Use default mode
......@@ -37,44 +40,44 @@ MODULE m_eig66_io
mode=MEM_mode
#endif
!check if default was given on command-line
if (juDFT_was_argument("-mpi")) mode=MPI_mode
if (juDFT_was_argument("-mem")) mode=MEM_mode
if (juDFT_was_argument("-da")) mode=DA_mode
if (juDFT_was_argument("-hdf")) mode=HDF_mode
IF (juDFT_was_argument("-mpi")) mode=MPI_mode
IF (juDFT_was_argument("-mem")) mode=MEM_mode
IF (juDFT_was_argument("-da")) mode=DA_mode
IF (juDFT_was_argument("-hdf")) mode=HDF_mode
ENDIF
!Check if mode is available
#ifndef CPP_MPI
if (mode==MPI_mode) call juDFT_error("MPI-mode not available. Recompile with CPP_MPI",calledby="eig66_io")
IF (mode==MPI_mode) CALL juDFT_error("MPI-mode not available. Recompile with CPP_MPI",calledby="eig66_io")
#else
CALL MPI_COMM_SIZE(mpi_comm,isize,err)
if (isize>1.and.((mode==DA_mode.or.mode==mem_mode))) &
call juDFT_error("In a parallel calculation MEM/DA-mode are not available",calledby="eig66_io")
CALL MPI_COMM_SIZE(mpi_comm,isize,err)
IF (isize>1.AND.((mode==DA_mode.OR.mode==mem_mode))) &
CALL juDFT_error("In a parallel calculation MEM/DA-mode are not available",calledby="eig66_io")
#endif
#ifndef CPP_HDF
if (mode==HDF_mode) call juDFT_error("HDF-mode not available. Recompile with CPP_HDF",calledby="eig66_io")
IF (mode==HDF_mode) CALL juDFT_error("HDF-mode not available. Recompile with CPP_HDF",calledby="eig66_io")
#endif
id=eig66_data_newid(mode)
id=eig66_data_newid(mode)
print *,"open_eig:",id,mode
PRINT *,"open_eig:",id,mode
call timestart("Open file/memory for IO of eig66")
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,filename)
CASE (hdf_mode)
CALL open_eig_HDF(id,mpi_comm,nmat,neig_local,nkpts,jspins,lmax,nlo,ntype,l_create,l_readonly,filename)
CASE (mem_mode)
CALL open_eig_MEM(id,nmat,neig_local,nkpts,jspins,lmax,nlo,ntype,l_create,nlotot,l_noco,filename)
CASE (mpi_mode)
CALL open_eig_MPI(id,mpi_comm,nmat,neig_local,nkpts,jspins,lmax,nlo,ntype,l_create,nlotot,l_noco,n_size,filename)
CASE DEFAULT
CALL juDFT_error("Invalid IO-mode in eig66_io")
CASE (DA_mode)
CALL open_eig_DA(id,nmat,neig_local,nkpts,jspins,lmax,nlo,ntype,nlotot,l_create,l_dos,l_mcd,l_orb,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_readonly,l_dos,l_mcd,l_orb,filename,layers,nstars,ncored,nsld,nat)
CASE (mem_mode)
CALL open_eig_MEM(id,nmat,neig_local,nkpts,jspins,lmax,nlo,ntype,l_create,nlotot,l_noco,l_dos,l_mcd,l_orb,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,nlotot,l_noco,n_size,l_dos,l_mcd,l_orb,filename,layers,nstars,ncored,nsld,nat)
CASE DEFAULT
CALL juDFT_error("Invalid IO-mode in eig66_io")
END SELECT
call timestop("Open file/memory for IO of eig66")
END FUNCTION
CALL timestop("Open file/memory for IO of eig66")
END FUNCTION open_eig
SUBROUTINE close_eig(id,filename)
SUBROUTINE close_eig(id,filename)
USE m_eig66_hdf,ONLY:close_eig_hdf=>close_eig
USE m_eig66_DA ,ONLY:close_eig_DA=>close_eig
USE m_eig66_mem,ONLY:close_eig_MEM=>close_eig
......@@ -84,23 +87,23 @@ MODULE m_eig66_io
CHARACTER(LEN=*),INTENT(IN),OPTIONAL :: filename
INTEGER :: mode
mode=eig66_data_mode(id)
print*,"close_eig:",id,mode
PRINT*,"close_eig:",id,mode
SELECT CASE (mode)
CASE (DA_mode)
CALL close_eig_DA(id,filename)
CASE (hdf_mode)
CALL close_eig_HDF(id,filename)
CASE (mem_mode)
CALL close_eig_Mem(id,filename=filename)
CASE (MPI_mode)
CALL close_eig_MPI(id,filename=filename)
CASE (-1)
CALL juDFT_error("ID not assigned in close_eig",calledby="eig66_io")
CASE (DA_mode)
CALL close_eig_DA(id,filename)
CASE (hdf_mode)
CALL close_eig_HDF(id,filename)
CASE (mem_mode)
CALL close_eig_Mem(id,filename=filename)
CASE (MPI_mode)
CALL close_eig_MPI(id,filename=filename)
CASE (-1)
CALL juDFT_error("ID not assigned in close_eig",calledby="eig66_io")
END SELECT
END SUBROUTINE
END SUBROUTINE close_eig