QuantumPackage/src/casscf_cipsi/casscf.irp.f

program casscf
  implicit none
  BEGIN_DOC
! TODO : Put the documentation of the program here
  END_DOC
  call reorder_orbitals_for_casscf
!  no_vvvv_integrals = .True.
!  touch no_vvvv_integrals
  n_det_max_full = 500
  touch n_det_max_full
  if(small_active_space)then
   pt2_relative_error = 0.00001
  else
   thresh_scf = 1.d-4
   pt2_relative_error = 0.04
  endif
  touch pt2_relative_error 
  call run
end

subroutine run
  implicit none
  double precision               :: energy_old, energy, pt2_max_before,delta_E
  logical                        :: converged,state_following_casscf_cipsi_save
  integer                        :: iteration,istate
  double precision, allocatable :: E_PT2(:), PT2(:), Ev(:), ept2_before(:)
  allocate(E_PT2(N_states), PT2(N_states), Ev(N_states), ept2_before(N_states))
  converged = .False.

  energy = 0.d0
  mo_label = "MCSCF"
  iteration = 1
  state_following_casscf_cipsi_save = state_following_casscf
  state_following_casscf = .True.
  touch state_following_casscf
  ept2_before = 0.d0
  if(small_active_space)then
   pt2_max = 1.d-10
   SOFT_TOUCH pt2_max
  else
   if(adaptive_pt2_max)then
    pt2_max = 0.005
    SOFT_TOUCH pt2_max
   endif
  endif
  do while (.not.converged)
    print*,'pt2_max = ',pt2_max
    call run_stochastic_cipsi(Ev,PT2)
    print*,'Ev,PT2',Ev(1),PT2(1)
    E_PT2(1:N_states) = Ev(1:N_states) + PT2(1:N_states)
    energy_old = energy
    energy = eone+etwo+ecore
    pt2_max_before = pt2_max

    call write_time(6)
    call write_int(6,iteration,'CAS-SCF iteration = ')
    call write_double(6,energy,'State-average CAS-SCF energy = ')
!    if(n_states == 1)then
!     call ezfio_get_casscf_cipsi_energy_pt2(E_PT2)
!     call ezfio_get_casscf_cipsi_energy(PT2)
     double precision :: delta_E_istate, e_av
     e_av = 0.d0
     do istate=1,N_states
      e_av += state_average_weight(istate) * Ev(istate) 
      if(istate.gt.1)then
       delta_E_istate = E_PT2(istate)  - E_PT2(1)
      write(*,'(A6,I2,A18,F16.10)')'state ',istate,' Delta E+PT2    = ',delta_E_istate
      endif
      write(*,'(A6,I2,A18,F16.10)')'state ',istate,' E + PT2 energy = ',E_PT2(istate)
      write(*,'(A6,I2,A18,F16.10)')'state ',istate,'     PT2 energy = ',PT2(istate)
!      call write_double(6,E_PT2(istate),'E + PT2 energy = ')
!      call write_double(6,PT2(istate),'  PT2          = ')
     enddo
     call write_double(6,e_av,'State-average CAS-SCF energy bis = ')
     call write_double(6,pt2_max,' PT2_MAX       = ')
!    endif

    print*,''
    call write_double(6,norm_grad_vec2,'Norm of gradients = ')
    call write_double(6,norm_grad_vec2_tab(1), '     Core-active  gradients = ')
    call write_double(6,norm_grad_vec2_tab(2), '     Core-virtual gradients = ')
    call write_double(6,norm_grad_vec2_tab(3), '   Active-virtual gradients = ')
    print*,''
    call write_double(6,energy_improvement, 'Predicted energy improvement = ')

    if(criterion_casscf == "energy")then
     converged = dabs(energy_improvement) < thresh_scf
    else if (criterion_casscf == "gradients")then
     converged = norm_grad_vec2 < thresh_scf
    else if (criterion_casscf == "e_pt2")then
     delta_E = 0.d0
     do istate = 1, N_states
      delta_E += dabs(E_PT2(istate) - ept2_before(istate))
     enddo
     converged = dabs(delta_E) < thresh_casscf
    endif
    ept2_before = E_PT2
    if(.not.small_active_space)then
     if(adaptive_pt2_max)then
      pt2_max = dabs(energy_improvement / (pt2_relative_error))
      pt2_max = min(pt2_max, pt2_max_before)
      if(n_act_orb.ge.n_big_act_orb)then
       pt2_max = max(pt2_max,pt2_min_casscf)
      endif
     endif
    endif
    print*,''
    call write_double(6,pt2_max, 'PT2_MAX for next iteration = ')

    mo_coef = NewOrbs
    mo_occ  = occnum
    if(.not.converged)then
     call save_mos
     iteration += 1
     if(norm_grad_vec2.gt.0.01d0)then
      N_det = N_states
     else
      N_det = max(N_det/8 ,N_states)
     endif
     psi_det = psi_det_sorted
     psi_coef = psi_coef_sorted
     read_wf = .True.
     call clear_mo_map
     SOFT_TOUCH mo_coef N_det psi_det psi_coef
     if(.not.small_active_space)then
      if(adaptive_pt2_max)then
        SOFT_TOUCH pt2_max  
      endif
     endif
     if(iteration .gt. 3)then
      state_following_casscf = state_following_casscf_cipsi_save
      soft_touch state_following_casscf
     endif
    endif

  enddo
     integer :: i
    print*,'Converged CASSCF '
    print*,'--------------------------'
    write(6,*) ' occupation numbers of orbitals '
    do i=1,mo_num
      write(6,*) i,occnum(i)
    end do
    print*,'--------------'
!
!     write(6,*)
!     write(6,*) ' the diagonal of the inactive effective Fock matrix '
!     write(6,'(5(i3,F12.5))') (i,Fipq(i,i),i=1,mo_num)
!     write(6,*)
  print*,'Fock MCSCF'
  do i = 1, mo_num
   write(*,*)i,mcscf_fock_diag_mo(i)
!   write(*,*)mcscf_fock_alpha_mo(i,i)
  enddo


end