Skip to content

Moved reading files to surboutines #38

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
pfloos merged 1 commit into from
Jan 14, 2026
Merged

Moved reading files to surboutines #38

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
22 changes: 3 additions & 19 deletions src/QuAcK/BQuAcK.f90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -119,25 +119,9 @@ subroutine BQuAcK(working_dir,dotest,doaordm,doRHFB,doBRPA,dophRPA,doG0W0,doqsGW

! For the FCIDUMP read two-body parameters integrals

inquire(file='FCIDUMP', exist=file_exists)
if(file_exists .and. readFCIDUMP) then
write(*,*)
write(*,*) 'Reading FCIDUMP two-body integrals'
write(*,*)
ERI_AO=0d0
open(unit=314, form='formatted', file='FCIDUMP', status='old')
do
read(314,*) Val,iorb,jorb,korb,lorb
if(korb==lorb .and. lorb==0) then
if(iorb==jorb .and. iorb==0) then
exit
endif
else
ERI_AO(iorb,jorb,korb,lorb)=Val
endif
enddo
close(314)
endif
if (readFCIDUMP) then
call read_fcidump_2body(nBas,ERI_AO)
endif

call wall_time(end_int)
t_int = end_int - start_int
Expand Down
44 changes: 5 additions & 39 deletions src/QuAcK/QuAcK.f90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -23,13 +23,10 @@ program QuAcK
logical :: do_SOSEX,do_2SOSEX,do_G3W2
logical :: do_ADC_GW,do_ADC_2SOSEX,do_ADC3_G3W2,do_ADC3x_G3W2,do_ADC4_G3W2

logical :: file_exists
logical :: error_P
logical :: verbose_scGW,verbose_scGF2
logical :: chem_pot_scG

integer :: iorb,jorb,korb,lorb
integer :: ifreq,kind_int
integer :: nNuc
integer :: nBas
integer :: nOrb
Expand All @@ -38,7 +35,6 @@ program QuAcK
integer :: nV(nspin)
integer :: nR(nspin)
double precision :: ENuc
double precision :: Val

double precision,allocatable :: ZNuc(:),rNuc(:,:)

Expand Down Expand Up @@ -220,13 +216,8 @@ program QuAcK
! Prepare Quadrature !
!--------------------!

ntimes = 0
kind_int = 1
if(nfreqs<2) nfreqs=2
allocate(wweight(nfreqs),wcoord(nfreqs))
call cgqf(nfreqs,kind_int,0d0,0d0,0d0,1d0,wcoord,wweight)
wweight(:)=wweight(:)/((1d0-wcoord(:))**2d0)
wcoord(:)=wcoord(:)/(1d0-wcoord(:))
call read_quadrature(nfreqs,ntimes,wcoord,wweight)

!------------------!
! Hardware !
Expand Down Expand Up @@ -302,35 +293,10 @@ program QuAcK
X(1:nBas,1:nOrb) = X_tmp(1:nBas,1:nOrb)
deallocate(X_tmp)

! For the FCIDUMP read one-body integrals

inquire(file='FCIDUMP', exist=file_exists)
if(file_exists .and. readFCIDUMP) then
write(*,*)
write(*,*) 'Reading FCIDUMP one-body integrals'
write(*,*)
S=0d0; T=0d0; V=0d0; Hc=0d0; X=0d0;
dipole_int_AO=0d0; ENuc=0d0; Znuc=0d0;
do iorb=1,nBas
S(iorb,iorb) = 1d0
X(iorb,iorb) = 1d0
enddo
open(unit=314, form='formatted', file='FCIDUMP', status='old')
do
read(314,*) Val,iorb,jorb,korb,lorb
if(korb==lorb .and. lorb==0) then
if(iorb==jorb .and. iorb==0) then
ENuc=Val
exit
else
T(iorb,jorb) =Val
T(jorb,iorb) =T(iorb,jorb)
Hc(iorb,jorb)=T(iorb,jorb)
Hc(jorb,iorb)=T(iorb,jorb)
endif
endif
enddo
close(314)
! For the FCIDUMP reading case, read one-body integrals

if (readFCIDUMP) then
call read_fcidump_1body(nBas,nOrb,ncart,S,T,V,Hc,X,dipole_int_AO,ENuc,Znuc)
endif

call wall_time(end_int)
Expand Down
26 changes: 5 additions & 21 deletions src/QuAcK/RQuAcK.f90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -224,27 +224,11 @@ subroutine RQuAcK(working_dir,use_gpu,dotest,doRHF,doROHF,docRHF,doeRHF,
call wall_time(start_int)
call read_2e_integrals(working_dir,nBas,ERI_AO)

! For the FCIDUMP read two-body integrals

inquire(file='FCIDUMP', exist=file_exists)
if(file_exists .and. readFCIDUMP) then
write(*,*)
write(*,*) 'Reading FCIDUMP two-body integrals'
write(*,*)
ERI_AO=0d0
open(unit=314, form='formatted', file='FCIDUMP', status='old')
do
read(314,*) Val,iorb,jorb,korb,lorb
if(korb==lorb .and. lorb==0) then
if(iorb==jorb .and. iorb==0) then
exit
endif
else
ERI_AO(iorb,jorb,korb,lorb)=Val
endif
enddo
endif
close(314)
! For the FCIDUMP case, read two-body integrals

if (readFCIDUMP) then
call read_fcidump_2body(nBas,ERI_AO)
endif

call wall_time(end_int)
t_int = end_int - start_int
Expand Down
26 changes: 5 additions & 21 deletions src/QuAcK/UQuAcK.f90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -127,27 +127,11 @@ subroutine UQuAcK(working_dir,dotest,doUHF,doMOMUHF,dostab,dosearch,doMP2,doMP3,
call wall_time(start_int)
call read_2e_integrals(working_dir,nBas,ERI_AO)

! For the Hubbard model read two-body parameters (U, J, etc from hubbard file)

inquire(file='FCIDUMP', exist=file_exists)
if(file_exists .and. readFCIDUMP) then
write(*,*)
write(*,*) 'Reading FCIDUMP two-body integrals'
write(*,*)
ERI_AO=0d0; ENuc=0d0;
open(unit=314, form='formatted', file='FCIDUMP', status='old')
do
read(314,*) Val,iorb,jorb,korb,lorb
if(korb==lorb .and. lorb==0) then
if(iorb==jorb .and. iorb==0) then
exit
endif
else
ERI_AO(iorb,jorb,korb,lorb)=Val
endif
enddo
endif
close(314)
! For the FCIDUMP case, read two-body integrals

if (readFCIDUMP) then
call read_fcidump_2body(nBas,ERI_AO)
endif

call wall_time(end_int)
t_int = end_int - start_int
Expand Down
54 changes: 54 additions & 0 deletions src/QuAcK/read_fcidump_1body.f90
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -0,0 +1,54 @@
subroutine read_fcidump_1body(nBas,nOrb,ncart,S,T,V,Hc,X,dipole_int_AO,ENuc,Znuc)

implicit none

! Input variables

integer,intent(in) :: nBas,nOrb,ncart

! Output variables

double precision,intent(out) :: ENuc,Znuc
double precision,intent(out) :: S(nBas,nBas)
double precision,intent(out) :: X(nBas,nOrb)
double precision,intent(out) :: T(nBas,nBas)
double precision,intent(out) :: V(nBas,nBas)
double precision,intent(out) :: Hc(nBas,nBas)
double precision,intent(out) :: dipole_int_AO(nBas,nBas,ncart)

! Local variables

logical :: file_exists
integer :: ibas,jbas,kbas,lbas
double precision :: Val

inquire(file='FCIDUMP', exist=file_exists)
if(file_exists) then
write(*,*)
write(*,*) 'Reading FCIDUMP one-body integrals'
write(*,*)
S=0d0; T=0d0; V=0d0; Hc=0d0; X=0d0;
dipole_int_AO=0d0; ENuc=0d0; Znuc=0d0;
do ibas=1,nBas
S(ibas,ibas) = 1d0
X(ibas,ibas) = 1d0
enddo
open(unit=314, form='formatted', file='FCIDUMP', status='old')
do
read(314,*) Val,ibas,jbas,kbas,lbas
if(kbas==lbas .and. lbas==0) then
if(ibas==jbas .and. ibas==0) then
ENuc=Val
exit
else
T(ibas,jbas) =Val
T(jbas,ibas) =T(ibas,jbas)
Hc(ibas,jbas)=T(ibas,jbas)
Hc(jbas,ibas)=T(ibas,jbas)
endif
endif
enddo
close(314)
endif

end subroutine
40 changes: 40 additions & 0 deletions src/QuAcK/read_fcidump_2body.f90
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -0,0 +1,40 @@
subroutine read_fcidump_2body(nBas,ERI_AO)

implicit none

! Input variables

integer,intent(in) :: nBas

! Output variables

double precision,intent(out) :: ERI_AO(nBas,nBas,nBas,nBas)

! Local variables

logical :: file_exists
integer :: ibas,jbas,kbas,lbas
double precision :: Val

inquire(file='FCIDUMP', exist=file_exists)
if(file_exists) then
write(*,*)
write(*,*) 'Reading FCIDUMP two-body integrals'
write(*,*)
ERI_AO=0d0
open(unit=314, form='formatted', file='FCIDUMP', status='old')
do
read(314,*) Val,ibas,jbas,kbas,lbas
if(kbas==lbas .and. lbas==0) then
if(ibas==jbas .and. ibas==0) then
exit
endif
else
ERI_AO(ibas,jbas,kbas,lbas)=Val
endif
enddo
endif
close(314)


end subroutine
16 changes: 16 additions & 0 deletions src/utils/read_quadrature.f90
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -0,0 +1,16 @@
subroutine read_quadrature(nfreqs,ntimes,wcoord,wweight)

integer :: kind_int

integer,intent(in) :: nfreqs
integer,intent(out) :: ntimes
double precision,intent(out) :: wcoord(nfreqs)
double precision,intent(out) :: wweight(nfreqs)

ntimes = 0
kind_int = 1
call cgqf(nfreqs,kind_int,0d0,0d0,0d0,1d0,wcoord,wweight)
wweight(:)=wweight(:)/((1d0-wcoord(:))**2d0)
wcoord(:)=wcoord(:)/(1d0-wcoord(:))

end subroutine
Loading