Skip to content
Snippets Groups Projects
Commit d0a0a868 authored by Marie bernadette Lepetit's avatar Marie bernadette Lepetit
Browse files

restart -> guess pour lecture à tester

parent 2c4d8b36
No related branches found
No related tags found
2 merge requests!16Remove the reordering of the vectors when convergence is not reached,!15Possibility to increase the number of vectors to be computed
Pipeline #24187 passed with warnings
Stage: docker_pre_clean
Stage: build
Stage: docker_post_clean
This commit is part of merge request !15. Comments created here will be created in the context of that merge request.
Hide whitespace changes
Inline Side-by-side
src/RelaxSE.F90
+ 14
− 10
View file @ d0a0a868
...@@ -376,24 +376,28 @@ Program RelaxSE ...@@ -376,24 +376,28 @@ Program RelaxSE
end if end if
r0 => rspin%l(1)%p r0 => rspin%l(1)%p
call lect_guess(psi_0_guess, det_info%ndet, v_info%nvec, nvec_restart, & call lect_guess(psi_0_guess, det_info%ndet, v_info%nvec, nvec_restart, &
nvec_gen, bdav_info%iter0, ener_info, v_info) nvec_gen, bdav_info%iter0, ener_info, v_info, prog_info)
if (nvec_gen.ne.0) & if (nvec_gen.ne.0) &
call complement_guess(psi_0_guess, det_info%ndet, v_info%nvec, nvec_restart, nvec_gen, & call complement_guess(psi_0_guess, det_info%ndet, v_info%nvec, nvec_restart, nvec_gen, &
r0, d, fock, hdiag, g_info, o_info, ord_info, int_info, v_info%sz, & r0, d, fock, hdiag, g_info, o_info, ord_info, int_info, v_info%sz, &
ener_info, prog_info, bdav_info) ener_info, prog_info, bdav_info)
! sauvegarde dans f_restart ! sauvegarde dans f_restart
rewind(f_restart)
write(f_restart) v_info%nvec, det_info%ndet, v_info%nconv, bdav_info%iter0 if (prog_info%id_cpu.eq.0) then
write(f_restart) ener_info%Ecoeur,ener_info%PotNuc rewind(f_restart)
write(f_restart) (ener_info%ener(ivec), ivec =1,v_info%nvec) write(f_restart) v_info%nvec, det_info%ndet, v_info%nconv, bdav_info%iter0
do ivec = 1,v_info%nvec write(f_restart) ener_info%Ecoeur,ener_info%PotNuc
write(f_restart) (psi_0_guess(idet,ivec),idet=1,det_info%ndet) write(f_restart) (ener_info%ener(ivec), ivec =1,v_info%nvec)
end do do ivec = 1,v_info%nvec
flush(f_restart) write(f_restart) (psi_0_guess(idet,ivec),idet=1,det_info%ndet)
rewind(f_restart) end do
flush(f_restart)
rewind(f_restart)
end if
end if end if
if (prog_info%id_cpu.eq.0) then if (prog_info%id_cpu.eq.0) then
write(f_output,*) write(f_output,*)
write(f_output,*) ("--", i=1,50) write(f_output,*) ("--", i=1,50)
......
src/RelaxSE_diag.F90
+ 24
− 7
View file @ d0a0a868
...@@ -39,6 +39,7 @@ module SASS_diag ...@@ -39,6 +39,7 @@ module SASS_diag
use utils_wrt use utils_wrt
use utils_ortho use utils_ortho
use utils_intcase use utils_intcase
use utils_char
use typetargetvec use typetargetvec
use compute_hv use compute_hv
use sort use sort
...@@ -117,6 +118,7 @@ contains ...@@ -117,6 +118,7 @@ contains
integer :: ivec, jvec, kvec, iter, ish, jsh, i, j integer :: ivec, jvec, kvec, iter, ish, jsh, i, j
integer :: ncol, icol, jcol, idet integer :: ncol, icol, jcol, idet
Integer :: n
integer :: nguess integer :: nguess
integer :: iconv, nbre_col integer :: iconv, nbre_col
...@@ -134,7 +136,15 @@ contains ...@@ -134,7 +136,15 @@ contains
real(kd_dble), dimension(:,:), allocatable :: Vm_tmp, Wm_tmp real(kd_dble), dimension(:,:), allocatable :: Vm_tmp, Wm_tmp
debugdav = bdav_info%debug_dav debugdav = bdav_info%debug_dav
open(666) if (debugdav) then
if (prog_info%id_cpu.eq.0) then
write(f_output,*)
write(f_output,*)">>>>> Debug_dav on <<<<<<<"
write(f_output,*)
end if
call noblancs(prog_info%prefix,n)
open(fdav,file=prog_info%prefix(1:n)//".debug",form="formatted")
end if
open(667) open(667)
ngel = o_info%ngel ngel = o_info%ngel
...@@ -209,9 +219,7 @@ contains ...@@ -209,9 +219,7 @@ contains
if (debugdav) then if (debugdav) then
write(fdav,*) "Guess vectors" write(fdav,*) "Guess vectors"
do idet = 1, nd00 call wrt_vect(fdav,nd00,ndet,nvectot,psi_0_guess)
write(fdav,*) (psi_0_guess(idet,ivec), ivec = 1,nvectot)
enddo
write(fdav,*) write(fdav,*)
end if end if
...@@ -332,7 +340,7 @@ contains ...@@ -332,7 +340,7 @@ contains
! On met à jour Ener ! On met à jour Ener
Ener(1+nconv:nvectot) = Ener_np1(1:nvec) Ener(1+nconv:nvectot) = Ener_np1(1:nvec)
! Sauvegarde des vecteurs pour restart ! Sauvegarde des vecteurs pour restart
rewind(f_restart) rewind(f_restart)
write(f_restart) nvectot,ndet,nconv, iter+iter0 write(f_restart) nvectot,ndet,nconv, iter+iter0
write(f_restart) Ecoeur,PotNuc write(f_restart) Ecoeur,PotNuc
...@@ -341,6 +349,14 @@ contains ...@@ -341,6 +349,14 @@ contains
write(f_restart) (psi_SASS(idet,ivec),idet=1,ndet) write(f_restart) (psi_SASS(idet,ivec),idet=1,ndet)
end do end do
flush(f_restart) flush(f_restart)
!--- debug
if (debugdav) then
write(fdav,*) "psi_SASS - Iter =", iter
call wrt_vect(f_output,20,ndet,nvectot,psi_SASS)
write(fdav,*)
end if
!--- fin debug
! Si a on atteint Sizeheff alors on contracte tout sur les premiers vecteurs ! Si a on atteint Sizeheff alors on contracte tout sur les premiers vecteurs
! (une colonne) ! (une colonne)
...@@ -384,7 +400,7 @@ contains ...@@ -384,7 +400,7 @@ contains
! Puis Calcul du nouveau vecteur de correction : (HV-EV)/(Ej-Hii) -> Vm(ncol+1) ! Puis Calcul du nouveau vecteur de correction : (HV-EV)/(Ej-Hii) -> Vm(ncol+1)
ncol = ncol + 1 ncol = ncol + 1
if (debugdav) then if (debugdav .and. prog_info%id_cpu .eq. 0) then
write(fdav,*) " vecteurs HV de l'iteration :", iter+iter0 write(fdav,*) " vecteurs HV de l'iteration :", iter+iter0
call wrtmat(Wm, ndet, min(10,ndet), nvec*ncol, fdav) call wrtmat(Wm, ndet, min(10,ndet), nvec*ncol, fdav)
write(fdav,*) write(fdav,*)
...@@ -774,7 +790,7 @@ contains ...@@ -774,7 +790,7 @@ contains
close(f_mat) close(f_mat)
close(f_mat2) close(f_mat2)
close(f_bmat) close(f_bmat)
close(666) if (debugdav) close(666)
close(667) close(667)
close(f_Vm,status="delete") close(f_Vm,status="delete")
close(f_Wm,status="delete") close(f_Wm,status="delete")
...@@ -1043,6 +1059,7 @@ contains ...@@ -1043,6 +1059,7 @@ contains
if (prog_info%id_cpu .eq. 0) & if (prog_info%id_cpu .eq. 0) &
write(fdav,*) ">>> vecteurs vect de l'iteration :", iter + iter0 write(fdav,*) ">>> vecteurs vect de l'iteration :", iter + iter0
call wrtmat(Vect,Dimheff,nvec*ncol,nvec*ncol, fdav) call wrtmat(Vect,Dimheff,nvec*ncol,nvec*ncol, fdav)
write(fdav,*)
end if end if
......
src/def_files.F90
+ 3
− 0
View file @ d0a0a868
...@@ -46,6 +46,7 @@ subroutine def_files(prog_info) ...@@ -46,6 +46,7 @@ subroutine def_files(prog_info)
Character*2 :: file_input Character*2 :: file_input
Character*3 :: file_output, file_det, file_mat Character*3 :: file_output, file_det, file_mat
Character*4 :: file_fock, file_bmat, file_ref0, file_mat2, file_bdet, file_info Character*4 :: file_fock, file_bmat, file_ref0, file_mat2, file_bdet, file_info
Character*5 :: file_guess
Character*6 :: file_traone, file_traint Character*6 :: file_traone, file_traint
Character*7 :: file_restart Character*7 :: file_restart
Character*40 :: blan40 Character*40 :: blan40
...@@ -80,6 +81,8 @@ subroutine def_files(prog_info) ...@@ -80,6 +81,8 @@ subroutine def_files(prog_info)
file_bdet = "bdet" file_bdet = "bdet"
file_restart= "restart" ! infos pour restart de la procedure de Davidson file_restart= "restart" ! infos pour restart de la procedure de Davidson
file_guess = "guess" ! fichier restart utilisé du precedent calcul pour le
! restart de la procedure de Davidson
file_bmat = "bmat" !Hamiltonian matrix in binary format file_bmat = "bmat" !Hamiltonian matrix in binary format
file_mat = "mat" !Hamiltonian matrix file_mat = "mat" !Hamiltonian matrix
......
src/files.F90
+ 3
− 1
View file @ d0a0a868
...@@ -36,12 +36,14 @@ Module files ...@@ -36,12 +36,14 @@ Module files
!!$ En entree !!$ En entree
!!$ f_input : fichier de donnees !!$ f_input : fichier de donnees
!!$ f_ref0 : liste des det de ref0 !!$ f_ref0 : liste des det de ref0
!!$ f_guess : f_restart d'un precedent calcul pour restart
!!$ En sortie !!$ En sortie
!!$ f_output : fichier de sortie !!$ f_output : fichier de sortie
!!$ f_det : tous les determinants en clair !!$ f_det : tous les determinants en clair
!!$ f_bdet : tous les determinants en binaire !!$ f_bdet : tous les determinants en binaire
!!$ f_info : variables globales x_info !!$ f_info : variables globales x_info
!!$ f_dens : matrice densite !!$ f_dens : matrice densite
!!$ f_restart: vecteurs a la dernire iteration pour restart
!!$ Autres !!$ Autres
!!$ f_hcore : Hcore (a voir si vraiment nécessaire) !!$ f_hcore : Hcore (a voir si vraiment nécessaire)
...@@ -55,7 +57,7 @@ Module files ...@@ -55,7 +57,7 @@ Module files
!!$ ----------------------------------------------------------- !!$ -----------------------------------------------------------
integer, parameter :: f_input=1, f_output=7, f_ref0=8, f_det=9, f_bdet=39 integer, parameter :: f_input=1, f_output=7, f_ref0=8, f_det=9, f_bdet=39
integer, parameter :: f_fock=10 integer, parameter :: f_fock=10
integer, parameter :: f_info=24, f_dens=25, f_restart = 15 integer, parameter :: f_info=24, f_dens=25, f_restart = 15, f_guess = 12
integer, parameter :: f_gen=14, f_gen0=16, f_gen_mem=17, f_gen0_mem=18 integer, parameter :: f_gen=14, f_gen0=16, f_gen_mem=17, f_gen0_mem=18
integer, parameter :: f_tone=31, f_tint=32, f_mat=33, f_bmat=34, f_mat2=35 integer, parameter :: f_tone=31, f_tint=32, f_mat=33, f_bmat=34, f_mat2=35
integer, parameter :: f_Vm=80, f_Wm=81 integer, parameter :: f_Vm=80, f_Wm=81
......
src/gener_guess.F90
+ 216
− 122
View file @ d0a0a868
...@@ -965,7 +965,7 @@ contains ...@@ -965,7 +965,7 @@ contains
type(prog_infotype), intent(in) :: prog_info type(prog_infotype), intent(in) :: prog_info
logical :: debug = .false. logical :: debug = .false.
integer :: info, i integer :: info, i,j
real(kd_dble), allocatable, dimension(:,:) :: vec real(kd_dble), allocatable, dimension(:,:) :: vec
real(kd_dble), allocatable, dimension(:) :: e real(kd_dble), allocatable, dimension(:) :: e
real(kd_dble) :: e0 real(kd_dble) :: e0
...@@ -990,10 +990,18 @@ contains ...@@ -990,10 +990,18 @@ contains
do i = 1,nd00 do i = 1,nd00
write(f_output,'(2X,I0,X,F22.16)') i, e0 + e(i) write(f_output,'(2X,I0,X,F22.16)') i, e0 + e(i)
enddo enddo
write(f_output,*)
write(f_output,*) 'Eigenvectors of the D00-D00 Matrix'
do i=1,nd00
do j=1,nvec
write(f_output,'(2X,F22.16)',advance='no') vec(i,j)
end do
write(f_output,*)
end do
flush(f_output) flush(f_output)
endif endif
phi_0_guess = vec(:, 1:nvec) phi_0_guess(:,1:nvec) = vec(:, 1:nvec)
ener_info%ener(1:nvec) = e(1:nvec) ener_info%ener(1:nvec) = e(1:nvec)
deallocate(vec) deallocate(vec)
...@@ -1015,136 +1023,222 @@ contains ...@@ -1015,136 +1023,222 @@ contains
!> @param[in] ener_info : Nuclear potential & Core energy read from molcas file !> @param[in] ener_info : Nuclear potential & Core energy read from molcas file
!! to be compared with the value read from the restart file !! to be compared with the value read from the restart file
!$==================================================================== !$====================================================================
subroutine lect_guess(psi_0_guess, ndetcode, nvec, nveclus, ngen, iter, ener_info, v_info) subroutine lect_guess(psi_0_guess, ndetcode, nvec, nveclus, ngen, iter, ener_info, v_info, prog_info)
Real*8, parameter :: seuil = 1.d-12 use utils_char
real(kd_dble), allocatable :: psi_0_guess(:,:) Real*8, parameter :: seuil = 1.d-12
integer, intent(in) :: ndetcode, nvec real(kd_dble), dimension(:,:), allocatable, intent(out) :: psi_0_guess(:,:)
Integer, intent(inout) :: iter integer, intent(in) :: ndetcode, nvec
Integer, intent(out) :: nveclus, ngen Integer, intent(inout) :: iter
type(ener_infotype), intent(inout) :: ener_info Integer, intent(out) :: nveclus, ngen
type(v_infotype), intent(inout) :: v_info type(ener_infotype), intent(inout) :: ener_info
type(v_infotype), intent(inout) :: v_info
Real(kd_dble), dimension(:), allocatable :: ener type(prog_infotype), intent(in) :: prog_info
Real(kd_dble) :: Ecoeur,PotNuc
Integer :: ndet, nconv, ivec, idet, my_iostat Character*5 :: file_guess
Character(len=256) :: my_iomsg
Real(kd_dble), dimension(:,:), allocatable :: tmp_guess
Real(kd_dble), dimension(:), allocatable :: ener
Real(kd_dble) :: Ecoeur,PotNuc
Integer :: ndet, nconv, ivec, idet, my_iostat, i, n
Character(len=256) :: my_iomsg
Logical :: debugl=.true.
#ifdef VAR_MPI
integer :: info
#endif
if (prog_info%id_cpu.eq.0) then
write(f_output,*)
if (debugl) write(f_output,*) ">>> Debug : Guess vectors read from file"
end if
write(f_output,*) !!$--- Lecture des infos sur f_guess (chaque proc a son propre pointeur)
write(f_output,*) ">>> Guess vectors read from file" file_guess = "guess" ! fichier restart du precedent calcul utilise pour le
! restart de la procedure de Davidson
! lit nbre de vecteur et det
rewind (f_restart) if (prog_info%Yprefix) then
read(f_restart) nveclus,ndet,nconv, iter call noblancs(prog_info%prefix,n)
write(f_output,'(2x,i3," vectors on restart files")') nveclus open (f_guess,file=prog_info%prefix(1:n)//"."//file_guess,&
form="unformatted")
! cas ou on choisi dans les input ce qui est converge else
if (v_info%nconv.ne.-1) then open (f_guess,file=file_guess,form="unformatted")
if (nconv.gt.nveclus) then end if
write(f_output,*) ' Error in nb of given converged determinants'
flush(f_output) ! lit tout
call SASS_quit(' nconv should be smaller than nvec from restart',f_output) read(f_guess) nveclus,ndet,nconv, iter
end if read(f_guess) Ecoeur,PotNuc
nconv = v_info%nconv
else allocate (ener(nveclus))
v_info%nconv = nconv read(f_guess) (ener(ivec), ivec =1,nveclus)
end if
allocate(tmp_guess(ndet,nveclus))
tmp_guess(:,:) = 0.d0
do ivec = 1,nveclus
my_iomsg=' '
read(f_guess,iostat=my_iostat, iomsg=my_iomsg) (tmp_guess(idet,ivec),idet=1,ndet)
! if (prog_info%id_cpu.eq.0) then
! select case (my_iostat)
! case (0)
! write(f_output,'(2x,"Vector ",i3," has been sucessfully read")') ivec
! if (debugl) write(f_output,'("ivec=",i3," iostat=",i3,2x,"iomsg=",a120)') &
! ivec, my_iostat, my_iomsg
! case default
! write(f_output,'("ivec=",i3," iostat=",i3,2x,"iomsg=",a120)') &
! ivec, my_iostat, my_iomsg
! end select
! flush(f_output)
! end if
end do
! fermeture fichier
close (f_guess)
!!$ Ecritures
if (prog_info%id_cpu.eq.0) then
write(f_output,9001) nveclus,ndet,nconv, iter
write(f_output,9002) Ecoeur,PotNuc
write(f_output,*)
write(f_output,9003)
write(f_output,9004) (ener(ivec), ivec =1,nveclus)
write(f_output,*)
write(f_output,*) " Vectors read "
call wrt_vect(f_output,10,ndet,nveclus, tmp_guess)
write(f_output,*)
flush(f_output)
end if
!!$--- Tests donnees code et guess identiques
! test egalite des nbre de det e
if (ndetcode.ne.ndet) then
if (prog_info%id_cpu.eq.0) then
write(f_output,*)
write(f_output,'(1x," Number of determinants read from file: ",i4, &
" different from number of computed ones :",i4)') ndet, ndetcode
write(f_output,*)
end if
call SASS_quit(' Error in nb of determinants read from file', f_output)
end if
! test egalite Ecoeur,PotNuc & test egalite
if (abs(ener_info%potnuc-potnuc).ge.seuil) then
if (prog_info%id_cpu.eq.0) then
write(f_output,*)
write(f_output,'(1x," Nuclear potential read from restart file: ",i4, &
" differs from read on molcas file :",i4)') potnuc, ener_info%potnuc
write(f_output,*)
end if
call SASS_quit(' Error in potnuc read from file', f_output)
end if
if (abs(ener_info%Ecoeur-Ecoeur).ge.seuil) then
if (prog_info%id_cpu.eq.0) then
write(f_output,*)
write(f_output,'(" Core energy read from restart file: ",i4, &
" differs from read on molcas file :",i4)') Ecoeur, ener_info%Ecoeur
write(f_output,*)
end if
call SASS_quit('Error in Ecoeur read from file', f_output)
end if
!!$ Reste a calculer
! cas ou on choisi dans les input le nombre de vecteurs converges
if (v_info%nconv.ne.-1) then ! certains vecteurs sont supposes converges
if (nconv.gt.nveclus) then
if (prog_info%id_cpu.eq.0) then
write(f_output,*) ' Error~: number of given converged vecteurs > number of read vectors'
flush(f_output)
end if
call SASS_quit(' nconv should be smaller than nvec from guess file',f_output)
end if
nconv = v_info%nconv
else
v_info%nconv = nconv
end if
! test du cas de convergence ! test du cas de convergence
ngen = 0 ngen = 0
if (nvec.le.nconv) then if (nvec.le.nconv) then
! tous les vecteurs demandes sont converges ! tous les vecteurs demandes sont converges
write(f_output,'(1x," All guess vectors read from file are converged.", & if (prog_info%id_cpu.eq.0) &
" No need to work further.")' ) write(f_output,'(1x," All guess vectors read from file are converged.", &
call SASS_quit(' All vectors converged. ', f_output) " No need to work further.")' )
call SASS_quit(' All vectors converged. ', f_output)
else if (nconv.lt.nvec .and. nconv.eq.nveclus) then
! ts les vecteurs demandes ne sont pas converges
! ts les vecteurs lus sont converges
ngen = nvec-nveclus
write(f_output,'(1x," All vectors read from file are converged.")')
write(f_output,'(1x,i4," out of ",i4," required vectors are converged.")') &
nconv, nvec
write(f_output,'(1x,i4," extra guess vectors will be generated from H0=<D00|H|D00>")') &
ngen
else if (nconv.lt.nvec .and. nvec.le.nveclus) then else if (nconv.lt.nvec .and. nconv.eq.nveclus) then
! ts les vecteurs demandes ne sont pas converges ! ts les vecteurs demandes ne sont pas converges
! On a assez de vecteurs lus ! ts les vecteurs lus sont converges
write(f_output,'(1x,i4," out of ",i4," required vectors are converged.")') & ngen = nvec-nveclus
nconv, nvec if (prog_info%id_cpu.eq.0) then
write(f_output,'(1x," All vectors read from file are converged.")')
else if (nconv.lt.nvec .and. nvec.gt.nveclus) then write(f_output,'(1x,i4," out of ",i4," required vectors are converged.")') &
! ts les vecteurs demandes ne sont pas converges nconv, nvec
! certain ont des guess lus, pas les autres write(f_output,'(1x,i4," extra guess vectors will be generated from H0=<D00|H|D00>")') &
ngen = nvec - nveclus ngen
write(f_output,'(1x,i4," out of ",i4," required vectors are converged.")') & end if
nconv, nvec
write(f_output,'(1x,i4," extra guess vectors will be generated from H0=<D00|H|D00>")') &
ngen
else else if (nconv.lt.nvec .and. nvec.le.nveclus) then
! ne devrait pas exister ! ts les vecteurs demandes ne sont pas converges
call SASS_quit(' Error ', f_output) ! On a assez de vecteurs lus, pas besoin d'en generer
end if if (prog_info%id_cpu.eq.0)&
write(f_output,'(1x,i4," out of ",i4," required vectors are converged.")') &
nconv, nvec
else if (nconv.lt.nvec .and. nvec.gt.nveclus) then
! ts les vecteurs demandes ne sont pas converges
! certain ont des guess lus, pas les autres
ngen = nvec - nveclus
if (prog_info%id_cpu.eq.0) then
write(f_output,'(1x,i4," out of ",i4," required vectors are converged.")') &
nconv, nvec
write(f_output,'(1x,i4," extra guess vectors will be generated from H0=<D00|H|D00>")') &
ngen
end if
else
! ne devrait pas exister
call SASS_quit(' Error ', f_output)
end if
! test egalite des nbre de det et energies
if (ndetcode.ne.ndet) then
write(f_output,*)
write(f_output,'(1x," Number of determinants read from file: ",i4, &
" different from number of computed ones :",i4)') ndet, ndetcode
write(f_output,*)
call SASS_quit(' Error in nb of determinants read from file', f_output)
end if
read(f_restart) Ecoeur,PotNuc
if (ener_info%potnuc.ne.potnuc) then
write(f_output,*)
write(f_output,'(1x," Nuclear potential read from restart file: ",i4, &
" differs from read on molcas file :",i4)') potnuc, ener_info%potnuc
write(f_output,*)
if (abs(potnuc-ener_info%potnuc).ge.seuil) call SASS_quit(' Error in potnuc read from file', f_output)
end if
if (ener_info%Ecoeur.ne.Ecoeur) then
write(f_output,*)
write(f_output,'(" Core energy read from restart file: ",i4, &
" differs from read on molcas file :",i4)') Ecoeur, ener_info%Ecoeur
write(f_output,*)
if (abs(Ecoeur-ener_info%Ecoeur).ge.seuil) call SASS_quit('Error in Ecoeur read from file', f_output)
end if
! lecture des vecteurs et energies !!$--- On met les tableaux lus dans tableaux du code et on dealloue
allocate (ener(nveclus)) n = min(nvec, nveclus)
read(f_restart) (ener(ivec), ivec =1,nveclus) ener_info%ener(1:n) = ener(1:n)
ener_info%ener(1:min(nveclus,nvec)) = ener(1:min(nveclus,nvec)) deallocate(ener)
! write(f_output,'(2x,f20.15)',advance='no') ener(1:nveclus)
! write(f_output,*)
deallocate(ener)
allocate(psi_0_guess(ndet,nvec))
psi_0_guess(:,:) = 0.d0
!write(f_output,*) 'nveclus,nvec', nveclus, nvec, min(nveclus,nvec)
do ivec = 1, min(nveclus,nvec)
my_iomsg=' '
read(f_restart,iostat=my_iostat, iomsg=my_iomsg) psi_0_guess(1:ndet,ivec)
if (my_iostat.ne.0) then
write(f_output,*) ivec, my_iostat, my_iomsg
flush(f_output)
end if
end do
! sorties allocate(psi_0_guess(ndet,nvec))
write(f_output,'(1x,i4," vectors read successfully from restart file")') min(nveclus,nvec) psi_0_guess(:,:) = 0.d0
write(f_output,'(1x," Energies of vectors read from restart file")') psi_0_guess(1:ndet , 1:n) = tmp_guess(1:ndet , 1:n)
do ivec = 1, min(nconv,nvec)
write(f_output,9007) ivec, ener_info%ener(ivec), & deallocate(ener,tmp_guess)
ener_info%ener(ivec) + Ecoeur+Potnuc
end do
do ivec = nconv+1, min(nveclus,nvec) !!$ sorties
write(f_output,9008) ivec, ener_info%ener(ivec), & if (prog_info%id_cpu.eq.0) then
ener_info%ener(ivec) + Ecoeur+Potnuc write(f_output,'(1x,i4," vectors read successfully from restart file")') min(nveclus,nvec)
end do write(f_output,'(1x," Energies of vectors read from restart file")')
do ivec = 1, min(nconv,nvec)
write(f_output,9007) ivec, ener_info%ener(ivec), &
ener_info%ener(ivec) + Ecoeur+Potnuc
end do
do ivec = nconv+1, min(nveclus,nvec)
write(f_output,9008) ivec, ener_info%ener(ivec), &
ener_info%ener(ivec) + Ecoeur+Potnuc
end do
end if
if (debugl.and.prog_info%id_cpu.eq.0) write(f_output,*) "<<< Debug : Fin reading guess vectors from file"
9001 format(2x,'nveclus =',i3,/, 2x,'ndet =',i10,/, 2x,'nconv =',i3,/,&
2x,'iter =',i3,/)
9002 format(2x,'Ecoeur =',f20.10,/, 2x,'PotNuc =',f20.10,/)
9003 format(2x,'Ener =')
9004 format(2x,f20.15)
9005 format(2x,'Vectors=')
9006 format(2x,5(f20.15,2x))
9007 format(2x,i10,2x,2(f22.15,2x)," converged") 9007 format(2x,i10,2x,2(f22.15,2x)," converged")
9008 format(2x,i10,2x,2(f22.15,2x)," not converged") 9008 format(2x,i10,2x,2(f22.15,2x)," not converged")
end subroutine lect_guess end subroutine lect_guess
......
src/lect_data.F90
+ 1
− 0
View file @ d0a0a868
...@@ -600,6 +600,7 @@ subroutine read_davidinp(iunit, bdav_info, prog_info) ...@@ -600,6 +600,7 @@ subroutine read_davidinp(iunit, bdav_info, prog_info)
bdav_info%iter0 = iter0 bdav_info%iter0 = iter0
bdav_info%conv_ener = conv_ener bdav_info%conv_ener = conv_ener
bdav_info%debug_dav = debug_dav bdav_info%debug_dav = debug_dav
if (debug_dav) write(f_output,*) " debug_dav active"
if (SizeheffDavidson.lt.1) & if (SizeheffDavidson.lt.1) &
call SASS_quit('>>> Error in SizeheffDavidson : must be at least 1 (default = 10) <<<',f_output) call SASS_quit('>>> Error in SizeheffDavidson : must be at least 1 (default = 10) <<<',f_output)
......
src/utils_wrt.F90
+ 30
− 2
View file @ d0a0a868
...@@ -32,7 +32,8 @@ ...@@ -32,7 +32,8 @@
!! Wrtdet : écrit un det !! Wrtdet : écrit un det
!! Wrtact : écrit la partie active d'un det !! Wrtact : écrit la partie active d'un det
!! Wrtactalpha : Ecriture partie active alpha des det !! Wrtactalpha : Ecriture partie active alpha des det
!! Wrtmat : Ecriture matrice réelle !! Wrtmat : Ecriture matrice réelle
!! Wrt_vect : Ecriture des vecteurs
!$============================================================ !$============================================================
module utils_wrt module utils_wrt
...@@ -49,7 +50,7 @@ module utils_wrt ...@@ -49,7 +50,7 @@ module utils_wrt
wrtact, & wrtact, &
wrtactalpha, & wrtactalpha, &
wrtmat, wrtmat_accurate, wrtmatE, wrt_bdet, wrt_info, & wrtmat, wrtmat_accurate, wrtmatE, wrt_bdet, wrt_info, &
wrt_WF wrt_WF, wrt_vect
! interface wrt_bdet ! interface wrt_bdet
! module procedure wrt_bdet ! module procedure wrt_bdet
...@@ -639,6 +640,33 @@ contains ...@@ -639,6 +640,33 @@ contains
9990 format(5(2x,F20.16)) 9990 format(5(2x,F20.16))
end subroutine wrt_WF end subroutine wrt_WF
!!$============================================================ !!$============================================================
Subroutine wrt_vect(file,ndetwrt,ndet,nvec,vect)
!------------------------------------------------------------
! Ecriture vecteurs
Implicit none
Integer (KIND=kd_int), intent(in) :: file,ndetwrt,ndet,nvec
real(kd_dble), dimension(:,:), allocatable, intent(in) :: vect
! -------- Donnes locales -----------------------------------
Integer (KIND=kd_int) :: i, nq, n, idet
! -------- Code ---------------------------------------------
write(f_output,9005)
nq = nvec/5
do i=1 , nq+1
n = min(5,nvec-(i-1)*5)
do idet =1,ndetwrt
write(file,9006) (vect(idet,(i-1)*5+1:(i-1)*5+n))
end do
write(file,*)
end do
write(file,9007)
write(file,*)
9005 format(2x,'Vectors=')
9006 format(2x,5(f20.15,2x))
9007 format(2x,5(20("."),2x))
end Subroutine wrt_vect
!!$============================================================ !!$============================================================
End Module utils_wrt End Module utils_wrt
!!$ Local Variables: !!$ Local Variables:
......
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