10
0
mirror of https://github.com/LCPQ/quantum_package synced 2024-11-03 20:54:00 +01:00
quantum_package/plugins/analyze_wf/analyze_wf.irp.f

71 lines
2.0 KiB
Fortran
Raw Normal View History

2016-12-19 13:27:16 +01:00
program analyze_wf
implicit none
BEGIN_DOC
! Wave function analyzis
END_DOC
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)
write(*,'(A)') 'MO Occupation'
write(*,'(A)') '============='
write(*,'(A)') ''
do istate=1,N_states
call get_occupation_from_dets(occupation,1)
write(*,'(A)') ''
write(*,'(A,I3)'), 'State ', istate
write(*,'(A)') '---------------'
write(*,'(A)') ''
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
else if (occupation(i) > 1.95d0) then
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
else if (occupation(i) < 0.01d0) then
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