diff --git a/ocaml/Input_determinants.ml b/ocaml/Input_determinants.ml index bb369ec3..af4fc08f 100644 --- a/ocaml/Input_determinants.ml +++ b/ocaml/Input_determinants.ml @@ -508,12 +508,19 @@ psi_det = %s let psi_coef = let rec read_coefs accu = function | [] -> List.rev accu + | ""::""::tail -> read_coefs accu tail | ""::c::tail -> + let c = + Float.of_string c + |> Det_coef.of_float + in read_coefs (c::accu) tail | _::tail -> read_coefs accu tail in - let a = read_coefs [] dets - |> String.concat ~sep:" " + let a = + read_coefs [] dets + |> List.map ~f:(fun x -> Det_coef.to_string x) + |> String.concat ~sep:" " in "(psi_coef ("^a^"))" in diff --git a/ocaml/qp_edit.ml b/ocaml/qp_edit.ml index 000eec78..8e947e71 100644 --- a/ocaml/qp_edit.ml +++ b/ocaml/qp_edit.ml @@ -2,16 +2,13 @@ open Qputils;; open Qptypes;; open Core.Std;; -let file_header filename = Printf.sprintf -" -================================================================== - Quantum Package -================================================================== +(** Interactive editing of the input. -Editing file `%s` +@author A. Scemama +*) -" filename - + +(** Keywords used to define input sections *) type keyword = | Ao_basis | Bielec_integrals @@ -24,6 +21,7 @@ type keyword = | Nuclei ;; + let keyword_to_string = function | Ao_basis -> "AO basis" | Bielec_integrals -> "Two electron integrals" @@ -36,12 +34,30 @@ let keyword_to_string = function | Nuclei -> "Molecule" ;; + + +(** Create the header of the temporary file *) +let file_header filename = + Printf.sprintf " +================================================================== + Quantum Package +================================================================== + +Editing file `%s` + +" filename +;; + + +(** Creates the header of a section *) let make_header kw = let s = keyword_to_string kw in let l = String.length s in "\n\n"^s^"\n"^(String.init l ~f:(fun _ -> '='))^"\n\n" ;; + +(** Returns the rst string of section [s] *) let get s = let header = (make_header s) in let f (read,to_rst) = @@ -79,6 +95,8 @@ let get s = rst ;; + +(** Applies the changes from the string [str] corresponding to section [s] *) let set str s = let header = (make_header s) in match String.substr_index ~pos:0 ~pattern:header str with @@ -103,7 +121,7 @@ let set str s = | None -> () with | _ -> (Printf.eprintf "Info: Read error in %s\n%!" - (keyword_to_string s)) + (keyword_to_string s); ignore (of_rst str) ) in let open Input in match s with @@ -120,6 +138,7 @@ let set str s = ;; +(** Creates the temporary file for interactive editing *) let create_temp_file ezfio_filename fields = let temp_filename = Filename.temp_file "qp_edit_" ".rst" in begin @@ -132,6 +151,8 @@ let create_temp_file ezfio_filename fields = ; temp_filename ;; + + let run ezfio_filename = (* Open EZFIO *) @@ -173,8 +194,8 @@ let run ezfio_filename = | Some editor -> editor | None -> "vi" in - let command = Printf.sprintf "%s %s" editor temp_filename in - Sys.command_exn command; + Printf.sprintf "%s %s" editor temp_filename + |> Sys.command_exn ; (* Re-read the temp file *) let temp_string = @@ -188,6 +209,24 @@ let run ezfio_filename = ;; +(** Create a backup file in case of an exception *) +let create_backup ezfio_filename = + Printf.sprintf " + rm -f %s/backup.tgz ; + tar -zcf .backup.tgz %s && mv .backup.tgz %s/backup.tgz + " + ezfio_filename ezfio_filename ezfio_filename + |> Sys.command_exn +;; + + +(** Restore the backup file when an exception occuprs *) +let restore_backup ezfio_filename = + Printf.sprintf "tar -zxf %s/backup.tgz" + ezfio_filename + |> Sys.command_exn +;; + let spec = let open Command.Spec in @@ -216,11 +255,34 @@ Edit input data with | _ msg -> print_string ("\n\nError\n\n"^msg^"\n\n") *) - (fun ezfio_file () -> run ezfio_file) + (fun ezfio_file () -> + try + run ezfio_file ; + (* create_backup ezfio_file; *) + with + | Failure exc + | Invalid_argument exc as e -> + begin + Printf.eprintf "=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-\n\n"; + Printf.eprintf "%s\n\n" exc; + Printf.eprintf "=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-\n\n"; + (* restore_backup ezfio_file; *) + raise e + end + | Assert_failure (file, line, ch) as e -> + begin + Printf.eprintf "=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-\n\n"; + Printf.eprintf "Assert error in file $QPACKAGE_ROOT/ocaml/%s, line %d, character %d\n\n" file line ch; + Printf.eprintf "=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-\n\n"; + (* restore_backup ezfio_file; *) + raise e + end + ) ;; let () = - Command.run command + Command.run command; + exit 0 ;; diff --git a/src/Dets/diagonalize_CI.irp.f b/src/Dets/diagonalize_CI.irp.f index f3a352f3..bd17f8bd 100644 --- a/src/Dets/diagonalize_CI.irp.f +++ b/src/Dets/diagonalize_CI.irp.f @@ -61,22 +61,35 @@ END_PROVIDER call lapack_diag(eigenvalues,eigenvectors, & H_matrix_all_dets,size(H_matrix_all_dets,1),N_det) CI_electronic_energy(:) = 0.d0 + do i=1,N_det + CI_eigenvectors(i,1) = eigenvectors(i,1) + enddo integer :: i_state double precision :: s2 - j=0 i_state = 0 - do while(i_state.lt.min(N_states_diag,N_det)) - j+=1 + do j=1,N_det call get_s2_u0(psi_det,eigenvectors(1,j),N_det,N_det,s2) - if(dabs(s2-expected_s2).le.0.1d0)then + print *, 'j = ',j,s2, expected_s2 + if(dabs(s2-expected_s2).le.0.3d0)then i_state += 1 + print *, 'i_state = ',i_state do i=1,N_det CI_eigenvectors(i,i_state) = eigenvectors(i,j) enddo CI_electronic_energy(i_state) = eigenvalues(j) CI_eigenvectors_s2(i_state) = s2 endif + if (i_state.ge.N_states_diag) then + exit + endif enddo +! if(i_state < min(N_states_diag,N_det))then +! print *, 'pb with the number of states' +! print *, 'i_state = ',i_state +! print *, 'N_states_diag ',N_states_diag +! print *,'stopping ...' +! stop +! endif deallocate(eigenvectors,eigenvalues) endif diff --git a/src/NEEDED_MODULES b/src/NEEDED_MODULES index cf798396..19b875a4 100644 --- a/src/NEEDED_MODULES +++ b/src/NEEDED_MODULES @@ -1,2 +1,2 @@ -AOs BiInts Bitmask CASSD DDCI Dets Electrons Ezfio_files Generators_CAS Hartree_Fock Loc_MOs MOGuess Molden MonoInts MOs Nuclei Output Perturbation Primitive_basis Selectors_full Utils +AOs BiInts Bitmask Dets Electrons Ezfio_files Hartree_Fock MOGuess Molden MonoInts MOs Nuclei Output Perturbation Selectors_full Utils