2016-12-19 13:27:16 +01:00
|
|
|
program analyze_wf
|
|
|
|
|
implicit none
|
|
|
|
|
BEGIN_DOC
|
|
|
|
|
! Wave function analyzis
|
|
|
|
|
END_DOC
|
2017-12-04 10:31:54 +01:00
|
|
|
PROVIDE mo_tot_num psi_det psi_coef
|
2016-12-19 13:27:16 +01:00
|
|
|
read_wf = .True.
|
|
|
|
|
SOFT_TOUCH read_wf
|
|
|
|
|
call run()
|
|
|
|
|
end
|
|
|
|
|
|
|
|
|
|
subroutine run
|
|
|
|
|
implicit none
|
|
|
|
|
integer :: istate, i
|
|
|
|
|
integer :: class(0:mo_tot_num,5)
|
|
|
|
|
double precision :: occupation(mo_tot_num)
|
|
|
|
|
|
2017-10-16 15:06:24 +02:00
|
|
|
write(*,'(A)') 'Energy of 1st determinant'
|
|
|
|
|
write(*,'(A)') '========================='
|
|
|
|
|
write(*,'(A)') ''
|
|
|
|
|
write(*,*) 'Total', ref_bitmask_energy + nuclear_repulsion
|
|
|
|
|
write(*,*) 'Mono-electronic', mono_elec_ref_bitmask_energy
|
|
|
|
|
write(*,*) 'Kinetic', kinetic_ref_bitmask_energy
|
|
|
|
|
write(*,*) 'Electron-nucleus', nucl_elec_ref_bitmask_energy
|
|
|
|
|
write(*,*) 'Two-electron', bi_elec_ref_bitmask_energy
|
|
|
|
|
write(*,'(A)') ''
|
|
|
|
|
write(*,'(A)') ''
|
|
|
|
|
|
2016-12-19 13:27:16 +01:00
|
|
|
write(*,'(A)') 'MO Occupation'
|
|
|
|
|
write(*,'(A)') '============='
|
|
|
|
|
write(*,'(A)') ''
|
|
|
|
|
do istate=1,N_states
|
|
|
|
|
write(*,'(A)') ''
|
|
|
|
|
write(*,'(A,I3)'), 'State ', istate
|
|
|
|
|
write(*,'(A)') '---------------'
|
|
|
|
|
write(*,'(A)') ''
|
2017-12-04 10:31:54 +01:00
|
|
|
call get_occupation_from_dets(istate,occupation)
|
2016-12-19 13:27:16 +01:00
|
|
|
write (*,'(A)') '======== ================'
|
|
|
|
|
class = 0
|
|
|
|
|
do i=1,mo_tot_num
|
|
|
|
|
write (*,'(I8,X,F16.10)') i, occupation(i)
|
|
|
|
|
if (occupation(i) > 1.999d0) then
|
|
|
|
|
class(0,1) += 1
|
|
|
|
|
class( class(0,1), 1) = i
|
2017-04-13 00:43:45 +02:00
|
|
|
else if (occupation(i) > 1.97d0) then
|
2016-12-19 13:27:16 +01:00
|
|
|
class(0,2) += 1
|
|
|
|
|
class( class(0,2), 2) = i
|
|
|
|
|
else if (occupation(i) < 0.001d0) then
|
|
|
|
|
class(0,5) += 1
|
|
|
|
|
class( class(0,5), 5) = i
|
2017-04-13 00:43:45 +02:00
|
|
|
else if (occupation(i) < 0.03d0) then
|
2016-12-19 13:27:16 +01:00
|
|
|
class(0,4) += 1
|
|
|
|
|
class( class(0,4), 4) = i
|
|
|
|
|
else
|
|
|
|
|
class(0,3) += 1
|
|
|
|
|
class( class(0,3), 3) = i
|
|
|
|
|
endif
|
|
|
|
|
enddo
|
|
|
|
|
write (*,'(A)') '======== ================'
|
|
|
|
|
write (*,'(A)') ''
|
|
|
|
|
|
|
|
|
|
write (*,'(A)') 'Suggested classes'
|
|
|
|
|
write (*,'(A)') '-----------------'
|
|
|
|
|
write (*,'(A)') ''
|
|
|
|
|
write (*,'(A)') 'Core :'
|
|
|
|
|
write (*,*) (class(i,1), ',', i=1,class(0,1))
|
|
|
|
|
write (*,*) ''
|
|
|
|
|
write (*,'(A)') 'Inactive :'
|
|
|
|
|
write (*,*) (class(i,2), ',', i=1,class(0,2))
|
|
|
|
|
write (*,'(A)') ''
|
|
|
|
|
write (*,'(A)') 'Active :'
|
|
|
|
|
write (*,*) (class(i,3), ',', i=1,class(0,3))
|
|
|
|
|
write (*,'(A)') ''
|
|
|
|
|
write (*,'(A)') 'Virtual :'
|
|
|
|
|
write (*,*) (class(i,4), ',', i=1,class(0,4))
|
|
|
|
|
write (*,'(A)') ''
|
|
|
|
|
write (*,'(A)') 'Deleted :'
|
|
|
|
|
write (*,*) (class(i,5), ',', i=1,class(0,5))
|
|
|
|
|
write (*,'(A)') ''
|
|
|
|
|
enddo
|
|
|
|
|
|
|
|
|
|
end
|
