qp_plugins_scemama/stable/champ/write_champ_csf.irp.f

subroutine write_champ_csf
  implicit none

  integer, parameter             :: istate=1
  character*(2048)               :: fmt
  integer                        :: i, n_elements, j, k
  integer, allocatable           :: list(:,:)

  integer                        :: startdet, enddet, iunit
  integer                        :: ndetI, bfIcfg, s
  double precision               :: phasedet
  integer                        :: idx

  open(newunit=iunit, file='det.'//ezfio_filename)

  write(iunit, '(A, X, I4,  X, A, X, I4)') '&electrons nelec', elec_num, 'nup', elec_alpha_num


  ! Determinants
  write(iunit, '(A, I10)') 'determinants', N_det

  write(fmt,*) '(', N_det, '(F12.8, X))'
  write(iunit, fmt) psi_coef(1:N_det,istate)

  write(fmt,*) '( ', elec_alpha_num, '(I4,X), 2X, ', elec_beta_num, '(I4,X))'
  allocate ( list(bit_kind_size,2) )
  do i=1, N_det
   call bitstring_to_list( psi_det(1,1,i), list(1,1), n_elements, N_int)
   call bitstring_to_list( psi_det(1,2,i), list(1,2), n_elements, N_int)
   write(iunit,fmt) list(1:elec_alpha_num,1), list(1:elec_beta_num,2)
  end do
  write(iunit, '(A)') 'end'

  ! CSF
  write(iunit, '(A, I10, X, I3)') 'csf', N_csf, N_states

  write(fmt,*) '(', N_csf, '(F12.8, X))'
  do i=1,N_states
    write(iunit, fmt) psi_csf_coef(1:N_csf,i)
  end do

  write(iunit, '(A)') 'end'

  ! CSF map
  phasedet = 1.0d0

  ndetI = 0
  do i=1,N_configuration
    startdet = psi_configuration_to_psi_det(1,i)
    enddet = psi_configuration_to_psi_det(2,i)
    s = 0
    do k=1,N_int
      if (psi_configuration(k,1,i) == 0_bit_kind) cycle
      s = s + popcnt(psi_configuration(k,1,i))
    enddo
    bfIcfg = max(1,nint((binom(s,(s+1)/2)-binom(s,((s+1)/2)+1))))
    do k=1,bfIcfg
      do j = startdet, enddet
        if (DetToCSFTransformationMatrix(s,k,j-startdet+1) == 0.d0) cycle
        ndetI += 1
      end do
    end do
  end do

  write(iunit, '(A)') 'csfmap'
  write(iunit, '(I10, I10, I10)') n_csf, n_det, ndetI

  do i=1,N_configuration
    startdet = psi_configuration_to_psi_det(1,i)
    enddet = psi_configuration_to_psi_det(2,i)

    s = 0
    do k=1,N_int
      if (psi_configuration(k,1,i) == 0_bit_kind) cycle
      s = s + popcnt(psi_configuration(k,1,i))
    enddo
    bfIcfg = max(1,nint((binom(s,(s+1)/2)-binom(s,((s+1)/2)+1))))

    do k=1,bfIcfg
      ndetI = 0
      do j = startdet, enddet
        if (DetToCSFTransformationMatrix(s,k,j-startdet+1) == 0.d0) cycle
        ndetI += 1
      end do

      write(iunit, '(I4)') ndetI
      do j = startdet, enddet
        if (DetToCSFTransformationMatrix(s,k,j-startdet+1) == 0.d0) cycle
        idx = psi_configuration_to_psi_det_data(j)
        call get_phase_qp_to_cfg(psi_det(1,1,idx), psi_det(1,2,idx), phasedet)
        write(iunit, '(I10, F18.12)') idx, DetToCSFTransformationMatrix(s,k,j-startdet+1)*phasedet
      end do
    end do

  end do

  write(iunit, '(A)') 'end'

end