Commit 48186235 authored by Elisa Rebolini's avatar Elisa Rebolini
Browse files

remove goto in prop for omp debug

parent df04d1de
Pipeline #12661 passed with stage
in 24 minutes and 32 seconds
......@@ -45,12 +45,13 @@ Program proprietes
use utils_wrt
#ifdef VAR_DEV
use densite
! use density_matrix
! use density_matrix
#endif
!$ use OMP_LIB
!!$ -------- Donnes locales -----------------------------------
implicit none
type(prop_infotype) :: prop_info
type(prog_infotype) :: prog_info
type(g_infotype) :: g_info
......@@ -59,7 +60,7 @@ Program proprietes
type(det_infotype) :: det_info
type(sym_infotype) :: sym_info
! det
type(deter), dimension(:), allocatable :: det, ref0
Integer (KIND=kd_int) :: ndet, nvec, nblock, nelact, nact
......@@ -73,14 +74,14 @@ Program proprietes
! vecteurs
real(kd_dble), dimension(:,:), allocatable :: psi
real(kd_dble), dimension(:), allocatable :: ener, psi_S
! prop
Integer(KIND=kd_int) :: nprop
character*5, dimension(:), allocatable :: whichprop
! proprietes
! real(kd_dble), dimension(:,:,:), allocatable :: rho_tot,rho_spin
! impressions
integer, parameter :: pas = 10
character*1, parameter :: A1=" "
......@@ -100,7 +101,7 @@ Program proprietes
real(kind=kd_dble), allocatable :: rho(:, :)
real(kind=kd_dble), allocatable :: WF(:)
#endif
!!$============================================================
!!$ -------- Code ---------------------------------------------
!!$-----
......@@ -112,7 +113,7 @@ Program proprietes
!$OMP PARALLEL SHARED(nb_thread)
nb_thread=OMP_GET_MAX_THREADS()
!$OMP END PARALLEL
prog_info%nb_thread = nb_thread
#endif
......@@ -120,10 +121,10 @@ Program proprietes
call def_files_prop(prog_info, ndet)
flush(f_output)
call gettime(tstart, wstart)
! lecture des x_info
read(f_info) prog_info
read(f_info) g_info
......@@ -145,12 +146,12 @@ Program proprietes
nelact = g_info%nelact
nact = o_info%nact
det_info%nref0 = nref0lu
!!$-----
!!$ --- Generation des det
!!$-----
if (prog_info%methodAct.eq.'cas') then
det_info%nref0 = comb(o_info%nact,g_info%na) * comb(o_info%nact,g_info%nb)
if (prog_info%methodAct.eq.'cas') then
det_info%nref0 = comb(o_info%nact,g_info%na) * comb(o_info%nact,g_info%nb)
call deter_init(ref0, det_info%nref0)
call gener_cas(ref0, prog_info, det_info, g_info, o_info)
else
......@@ -159,7 +160,7 @@ Program proprietes
end if
if (prog_info%id_cpu.eq.0) flush(f_output)
call detact_all_init(r, nb_rlist)
if (prog_info%id_cpu.eq.0) then
write(f_output,*)
......@@ -201,7 +202,7 @@ Program proprietes
psi(:,:) = 0.d0
ener(:) = 0.d0
call lect_vect(psi, ener, ndet, nvec)
!!$-----
!!$ --- Projection sur le cas
!!$-----
......@@ -215,110 +216,90 @@ Program proprietes
write(f_output,'(X,A,A,F17.2,A,F17.2,A)') '>>> Active space projection in ',&
'CPU time ',t2-t1,'s, Wall time ',wt2-wt1,' s'
flush(f_output)
!!$-----------------------------------------------------------------------------
!!$ --- Autres proprits
!!$-----------------------------------------------------------------------------
nprop = prop_info%nprop
if (nprop.eq.0) goto 9999
allocate(whichprop(nprop))
whichprop(1:nprop) = prop_info%whichprop(1:nprop)
do iprop = 1, nprop
call lowercase(whichprop(iprop))
select case (whichprop(iprop))
case("s-s2")
write(f_output,*)
write(f_output,*) " >>> Total S "
allocate(psi_S(nvec))
psi_S(:) = 0.d0
call s2(psi,psi_S,ndet,nvec,nelact, det, det_info, d, o_info, f_output)
nq=nvec/10
nr=nvec - nq*pas
do i =1,nq
if (nprop.ne.0) then
allocate(whichprop(nprop))
whichprop(1:nprop) = prop_info%whichprop(1:nprop)
do iprop = 1, nprop
call lowercase(whichprop(iprop))
select case (whichprop(iprop))
case("s-s2")
write(f_output,*)
write(f_output,*) " >>> Total S "
allocate(psi_S(nvec))
psi_S(:) = 0.d0
call s2(psi,psi_S,ndet,nvec,nelact, det, det_info, d, o_info, f_output)
nq=nvec/10
nr=nvec - nq*pas
do i =1,nq
write(f_output,'(" S ")',advance='no')
do iwr = 1, max(2*nact +1-6,0)
write(f_output,'(a1)',advance='no') A1
end do
write(f_output,9012) psi_S((i-1)*pas+1:i*pas)
end do
write(f_output,'(" S ")',advance='no')
do iwr = 1, max(2*nact +1-6,0)
write(f_output,'(a1)',advance='no') A1
end do
write(f_output,9012) psi_S((i-1)*pas+1:i*pas)
end do
write(f_output,'(" S ")',advance='no')
do iwr = 1, max(2*nact +1-6,0)
write(f_output,'(a1)',advance='no') A1
end do
write(f_output,9012) psi_S(nq*pas+1:nvec)
write(f_output,*)
deallocate(psi_S)
9012 format(10(F18.8,2x))
case("wf") !------- Print WFs ---------------------------------------------
write(f_output,*)
write(f_output,*) " >>> Total WFs"
call wrt_WF(ndet,nvec,1,nvec,det,psi,o_info,f_output)
case("pref1") !---- Project WF on Ref1 ------------------------------------
write(f_output,*)
write(f_output,*) " >>> Projection on Ref1"
write(f_output,*) " Not yet implemented"
case("lcoef") !---- Print largest determinants ----------------------------
write(f_output,*)
write(f_output,*) " >>> Projection on determinants with coefficients largest than 0.05"
write(f_output,*) " Not yet implemented"
case("dens") !----- 1e-density matrix --------------------------------------
write(f_output,*)
write(f_output,*) ">>> One particule density matrix"
write(f_output,9012) psi_S(nq*pas+1:nvec)
write(f_output,*)
deallocate(psi_S)
9012 format(10(F18.8,2x))
case("wf") !------- Print WFs ---------------------------------------------
write(f_output,*)
write(f_output,*) " >>> Total WFs"
call wrt_WF(ndet,nvec,1,nvec,det,psi,o_info,f_output)
case("pref1") !---- Project WF on Ref1 ------------------------------------
write(f_output,*)
write(f_output,*) " >>> Projection on Ref1"
write(f_output,*) " Not yet implemented"
case("lcoef") !---- Print largest determinants ----------------------------
write(f_output,*)
write(f_output,*) " >>> Projection on determinants with coefficients largest than 0.05"
write(f_output,*) " Not yet implemented"
case("dens") !----- 1e-density matrix --------------------------------------
write(f_output,*)
write(f_output,*) ">>> One particule density matrix"
#ifdef VAR_DEV
call dens(ndet,nvec, psi,det, d,rspin, o_info,g_info,prog_info)
call verif_dens(ndet,nvec, psi,det, d,rspin, o_info,g_info,prog_info)
! allocate(WF(ndet))
! Wf(:) = psi(:,2)
! norb = o_info%ntot + o_info%ngel + o_info%ndel
! allocate(rho(norb,norb))
! rho(:,:) = 0.d0
! rho = calc_density_matrix(WF, o_info, det)
! write(f_output,*) " calc_density_matrix : non zero terms"
! do iorb2=1,norb
! ! do iorb1=1,norb
! iorb1 = iorb2
! if (abs(rho(iorb1,iorb2)).gt.1.d-10) write(f_output,9983) iorb1,iorb2, rho(iorb1,iorb2)
! ! end do
! end do
write(f_output,*)
write(f_output,*)
9983 format (5x,2(I4,1x),2x,10(F22.16,1x))
call dens(ndet,nvec, psi,det, d,rspin, o_info,g_info,prog_info)
call verif_dens(ndet,nvec, psi,det, d,rspin, o_info,g_info,prog_info)
write(f_output,*)
write(f_output,*)
#endif
end select
end do
end select
end do
deallocate(whichprop)
9001 format(a7," :",a80)
9993 format (5x,10(E15.6,1x))
9994 format ("Ener ",10(F15.6,1x))
9995 format (a5,10(F15.6,1x))
end if
9999 write(f_output,*)
write(f_output,*)
write(f_output,*) ' <<< End of prop code >>> '
write(f_output,*)
deallocate(shtblkdet, nblkdet, deter_index)
deallocate(det)
deallocate(psi, ener)
if (nprop.ne.0) deallocate(whichprop)
call gettime(tend,wend)
call date_and_time(date, time, zone, values)
write(f_output,'(X,A,F17.2,A,F17.2,A)') 'Calculation finished in CPUtime',&
tend-tstart,'s Walltime:', &
wend-wstart,'s'
write(f_output,*) 'Calculation finished on ', date(7:8),'-',date(5:6),&
'-',date(1:4), ' at ', time(1:2),':',time(3:4)
flush(f_output)
!!$ Clean
call detact_all_free(r)
......
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