Fixed bug

devel/trexio/export_trexio.irp.f

@@ -12,9 +12,9 @@ program export_trexio
   print *, ''
 
   if (backend == 0) then
-    f = trexio_open(trexio_filename, 'w', TREXIO_HDF5)
+    f = trexio_open(trexio_filename, 'w', TREXIO_HDF5, rc)
   else if (backend == 1) then
-    f = trexio_open(trexio_filename, 'w', TREXIO_TEXT)
+    f = trexio_open(trexio_filename, 'w', TREXIO_TEXT, rc)
   endif
   if (f == 0) then
     print *, 'Unable to open TREXIO file for writing'

stable/champ/NEED

@@ -1 +1 @@
-determinants fci
+determinants fci csf

stable/champ/save_for_champ.irp.f

@@ -1,4 +1,4 @@
-program qmcpack
+program save_for_camp
   implicit none
   BEGIN_DOC
 ! Generates a file for CHAMP
@@ -23,6 +23,7 @@ program qmcpack
   call system('rm '//trim(ezfio_filename)//'/mo_basis/ao_md5')
   call system('$QP_ROOT/src/champ/qp_convert.py '//trim(ezfio_filename))
 
+  call write_champ_csf()
 !  integer :: iunit
 !  integer, external :: getUnitAndOpen
 !  iunit = getUnitAndOpen(trim(ezfio_filename)//'.H','w')

stable/champ/write_champ_csf.irp.f

@@ -0,0 +1,99 @@
+subroutine write_champ_csf
+  implicit none
+
+  integer, parameter             :: istate=1
+  character*(2048)               :: format
+  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(format,*) '(', N_det, '(F12.8, X))'
+  write(iunit, format) psi_coef(1:N_det,istate)
+
+  write(format,*) '( ', 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,format) 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(format,*) '(', N_csf, '(F12.8, X))'
+  do i=1,N_states
+    write(iunit, format) 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