Merge pull request #285 from AbdAmmar/dev-stable-tc-scf

Dev stable tc scf

.github/workflows/compilation.yml

@@ -48,6 +48,7 @@ jobs:
               ./configure -i docopt || :
               ./configure -i resultsFile || :
               ./configure -i bats || :
+              ./configure -i trexio-nohdf5 || :
               ./configure -c ./config/gfortran_debug.cfg
        - name: Compilation
          run: |

.github/workflows/configuration.yml

@@ -22,7 +22,7 @@ jobs:
        - uses: actions/checkout@v3
        - name: Install dependencies
          run: |
-           sudo apt install gfortran gcc liblapack-dev libblas-dev wget python3 make m4 pkg-config
+           sudo apt install gfortran gcc liblapack-dev libblas-dev wget python3 make m4 pkg-config hdf5
        - name: zlib
          run: |
               ./configure -i zlib || echo OK
@@ -50,6 +50,12 @@ jobs:
        - name: bats
          run: |
               ./configure -i bats || echo OK
+       - name: trexio-nohdf5
+         run: |
+              ./configure -i trexio-nohdf5 || echo OK
+       - name: trexio
+         run: |
+              ./configure -i trexio || echo OK
        - name: Final check
          run: |
               ./configure -c config/gfortran_debug.cfg

bin/qp_test

@@ -46,7 +46,7 @@ def main(arguments):
                 append_bats(dirname, filenames)
     else:
         for (dirname, _, filenames) in os.walk(os.getcwd(), followlinks=False):
-            if "IRPF90_temp" not in dirname:
+            if "IRPF90_temp" not in dirname and "external" not in dirname:
                 append_bats(dirname, filenames)
     l_bats = [y for _, y in sorted(l_bats)]
 
@@ -67,6 +67,7 @@ def main(arguments):
             os.system(test+" python3 bats_to_sh.py "+bats_file+
                                     "| bash")
         else:
+#           print(" ".join(["bats", "--verbose-run", "--trace", bats_file]))
             subprocess.check_call(["bats", "--verbose-run", "--trace", bats_file], env=os.environ)
 
 

configure

@@ -9,6 +9,8 @@ echo "QP_ROOT="$QP_ROOT
 unset CC
 unset CCXX
 
+TREXIO_VERSION=2.3.2
+
 # Force GCC instead of ICC for dependencies
 export CC=gcc
 
@@ -189,7 +191,7 @@ if [[ "${PACKAGES}.x" != ".x" ]] ; then
 fi
 
 if [[ ${PACKAGES} = all ]] ; then
-        PACKAGES="zlib ninja zeromq f77zmq gmp ocaml docopt resultsFile bats"
+        PACKAGES="zlib ninja zeromq f77zmq gmp ocaml docopt resultsFile bats trexio"
 fi
 
 
@@ -203,6 +205,33 @@ for PACKAGE in ${PACKAGES} ; do
               mv ninja "\${QP_ROOT}"/bin/
 EOF
 
+    elif [[ ${PACKAGE} = trexio-nohdf5 ]] ; then
+
+            VERSION=$TREXIO_VERSION
+            execute << EOF
+              cd "\${QP_ROOT}"/external
+              wget https://github.com/TREX-CoE/trexio/releases/download/v${VERSION}/trexio-${VERSION}.tar.gz
+              tar -zxf trexio-${VERSION}.tar.gz
+              cd trexio-${VERSION}
+              ./configure --prefix=\${QP_ROOT} --without-hdf5
+              make -j 8 && make -j 8 check && make -j 8 install
+              cp ${QP_ROOT}/include/trexio_f.f90 ${QP_ROOT}/src/ezfio_files
+              tar -zxvf "\${QP_ROOT}"/external/qp2-dependencies/${ARCHITECTURE}/ninja.tar.gz 
+              mv ninja "\${QP_ROOT}"/bin/
+EOF
+    elif [[ ${PACKAGE} = trexio ]] ; then
+
+            VERSION=$TREXIO_VERSION
+            execute << EOF
+              cd "\${QP_ROOT}"/external
+              wget https://github.com/TREX-CoE/trexio/releases/download/v${VERSION}/trexio-${VERSION}.tar.gz
+              tar -zxf trexio-${VERSION}.tar.gz
+              cd trexio-${VERSION}
+              ./configure --prefix=\${QP_ROOT}
+              make -j 8 && make -j 8 check && make -j 8 install
+              cp ${QP_ROOT}/include/trexio_f.f90 ${QP_ROOT}/src/ezfio_files
+EOF
+ 
 
     elif [[ ${PACKAGE} = gmp ]] ; then
 
@@ -338,6 +367,12 @@ if [[ ${ZEROMQ} = $(not_found) ]] ; then
         fail
 fi
 
+TREXIO=$(find_lib -ltrexio)
+if [[ ${TREXIO} = $(not_found) ]] ; then
+        error "TREXIO (trexio,trexio-nohdf5) is not installed. If you don't have HDF5, use trexio-nohdf5"
+        fail
+fi
+
 F77ZMQ=$(find_lib -lzmq -lf77zmq -lpthread)
 if [[ ${F77ZMQ} = $(not_found) ]] ; then
         error "Fortran binding of ZeroMQ (f77zmq) is not installed."

data/basis/none

@@ -0,0 +1,5 @@
+$DATA
+
+HYDROGEN
+
+$END

etc/qp.rc

@@ -110,6 +110,11 @@ function qp()
       unset COMMAND
       ;;
 
+    "test")
+      shift
+      qp_test $@
+      ;;
+
     *)
       which "qp_$1" &> /dev/null
       if [[ $? -eq 0 ]] ; then
@@ -183,7 +188,7 @@ _qp_Complete()
             ;;
         esac;;
       set_file)
-        COMPREPLY=( $(compgen -W "$(for i in * ; do [[ -f ${i}/ezfio/.version ]] && echo $i ; done)" -- ${cur} ) )
+        COMPREPLY=( $(compgen -W "$(for i in */ $(find . -name ezfio | sed 's/ezfio$/.version/') ; do [[ -f $i ]] && echo ${i%/.version} ; done)" -- ${cur} ) )
         return 0
         ;;
       plugins)
@@ -215,10 +220,15 @@ _qp_Complete()
             return 0
             ;;
         esac;;
+      test)
+        COMPREPLY=( $(compgen -W "-v -a " -- $cur ) )
+        return 0
+        ;;
       *)
         COMPREPLY=( $(compgen -W 'plugins set_file \
                                    unset_file man \
                                    create_ezfio \
+                                   test \
                                    convert_output_to_ezfio \
                                    -h update' -- $cur ) )
 

ocaml/Input_ao_basis.ml

@@ -247,8 +247,7 @@ end = struct
 
 
   let read () =
-    if (Ezfio.has_ao_basis_ao_basis ()) then
+      try
-      begin
         let result =
           { ao_basis        = read_ao_basis ();
             ao_num          = read_ao_num () ;
@@ -267,9 +266,8 @@ end = struct
         |> MD5.to_string
         |> Ezfio.set_ao_basis_ao_md5 ;
         Some result
-      end
+      with
-    else
+      | _ -> (Ezfio.set_ao_basis_ao_md5 "None" ; None)
-      None
   ;;
 
 

ocaml/qp_create_ezfio.ml

@@ -478,6 +478,7 @@ let run ?o b au c d m p cart xyz_file =
         let nmax =
           Nucl_number.get_max ()
         in
+
         let rec do_work (accu:(Atom.t*Nucl_number.t) list) (n:int) = function
         | [] -> accu
         | e::tail ->
@@ -520,6 +521,8 @@ let run ?o b au c d m p cart xyz_file =
       in
       let long_basis = Long_basis.of_basis basis in
       let ao_num = List.length long_basis in
+      if ao_num > 0 then
+        begin
           Ezfio.set_ao_basis_ao_num ao_num;
           Ezfio.set_ao_basis_ao_basis b;
           Ezfio.set_basis_basis b;
@@ -655,6 +658,7 @@ let run ?o b au c d m p cart xyz_file =
           match Input.Ao_basis.read () with
           | None -> failwith "Error in basis"
           | Some x -> Input.Ao_basis.write x
+     end
   in
   let () =
     try write_file () with
@@ -781,7 +785,7 @@ If a file with the same name as the basis set exists, this file will be read.  O
   run ?o:output basis au charge dummy multiplicity pseudo cart xyz_filename
   )
   with
-  | Failure txt  -> Printf.eprintf "Fatal error: %s\n%!" txt
+(*  | Failure txt  -> Printf.eprintf "Fatal error: %s\n%!" txt *)
   | Command_line.Error txt  -> Printf.eprintf "Command line error: %s\n%!" txt
 
 

scripts/compilation/qp_create_ninja

@@ -38,7 +38,7 @@ def comp_path(path):
 
 from qp_path import QP_ROOT, QP_SRC, QP_EZFIO
 
-LIB = " -lz"
+LIB = " -lz -ltrexio"
 EZFIO_LIB = join("$QP_ROOT", "lib", "libezfio_irp.a")
 ZMQ_LIB = join("$QP_ROOT", "lib", "libf77zmq.a") + " "  + join("$QP_ROOT", "lib", "libzmq.a") + " -lstdc++ -lrt -ldl"
 ROOT_BUILD_NINJA = join("$QP_ROOT", "config", "build.ninja")

scripts/ezfio_interface/qp_edit_template

@@ -172,11 +172,8 @@ let run check_only ?ndet ?state ezfio_filename =
 
   (* Reorder basis set *)
   begin
-    let aos =
     match Input.Ao_basis.read() with
-      | Some x -> x
+    | Some aos -> 
-      | _ -> assert false
-    in
         let ordering = Input.Ao_basis.ordering aos in
         let test = Array.copy ordering in
         Array.sort compare test ;
@@ -191,6 +188,7 @@ let run check_only ?ndet ?state ezfio_filename =
               let new_mos = Input.Mo_basis.reorder mos ordering in
               Input.Mo_basis.write new_mos
         end
+    | _ -> ()
   end;
 
   begin

scripts/qp_exc_energy.py

@@ -42,13 +42,15 @@ import sys, os
 import scipy
 import scipy.stats
 from math import sqrt, gamma, exp
-import json
+import qp_json
 
 
-def read_data(filename,state):
+def read_data(ezfio_filename,state):
   """ Read energies and PT2 from input file """
-  with open(filename,'r') as f:
+  data = qp_json.load_last(ezfio_filename)
-      lines = json.load(f)['fci']
+  for method in data.keys():
+    x = data[method]
+  lines = x
 
   print(f"State: {state}")
 
@@ -138,15 +140,15 @@ def compute(data):
 
     return mu, err, bias, p
 
-filename = sys.argv[1]
+ezfio_filename = sys.argv[1]
-print(filename)
+print(ezfio_filename)
 if len(sys.argv) > 2:
     state = int(sys.argv[2])
 else:
     state = 1
-data = read_data(filename,state)
+data = read_data(ezfio_filename,state)
 mu, err, bias, _ = compute(data)
-print(" %s: %8.3f +/- %5.3f eV\n"%(filename, mu, err))
+print(" %s: %8.3f +/- %5.3f eV\n"%(ezfio_filename, mu, err))
 
 import numpy as np
 A = np.array( [ [ data[-1][1], 1. ],

scripts/qp_extract_cipsi_data.py

@@ -1,57 +1,37 @@
 #!/usr/bin/env python3
 
-import re
+import qp_json
 import sys
 
-# Read output file
+if len(sys.argv) == 1:
-with open(sys.argv[1], 'r') as file:
+  print(f"syntax: {sys.argv[0]} EZFIO_FILE")
-  output = file.read()
+
+d = qp_json.load_all(sys.argv[1])
+
+k = [ x for x in d.keys() ]
+k.sort()
+
+print("# Energy  PT2   PT2_err  rPT2  rPT2_err  exFCI\n")
+for f in k:
+  try:
+    j = d[f]["fci"]
+  except:
+     continue
+
+  print(f"# {f}")
+  for e in j:
+
+       out = f" {e['n_det']:8d}"
+
+       nstates = len(e["states"])
+       for ee in e["states"]:
+         try:
+            exc_energy = ee['ex_energy'][0]
+         except:
+            exc_energy = 0.
+         out += f" {ee['energy']:16.8f}  {ee['pt2']:e}  {ee['pt2_err']:e}  {ee['rpt2']:e}  {ee['rpt2_err']:e}  {exc_energy:16.8f}"
+       print(out)
+
+  print("\n")
 
 
-def extract_data(output):
-    lines = output.split("\n")
-    data = []
-
-    n_det = None
-    e = None
-    pt2 = None
-    err_pt2 = None
-    rpt2 = None
-    err_rpt2 = None
-    e_ex = None
-
-
-    reading = False
-    for iline, line in enumerate(lines):
-        if line.startswith("Summary at N_det"):
-            reading = False
-
-        if not reading and line.startswith(" N_det "):
-            n_det = int(re.search(r"N_det\s+=\s+(\d+)", line).group(1))
-            reading = True
-
-        if reading:
-            if line.startswith(" E "):
-                e = float(re.search(r"E\s+=\s+(-?\d+\.\d+)", line).group(1))
-            elif line.startswith(" PT2 "):
-                pt2 = float(re.search(r"PT2\s+=\s+(-?\d+\.\d+E?.\d*)", line).group(1))
-                err_pt2 = float(re.search(r"\+/-\s+(-?\d+\.\d+E?.\d*)", line).group(1))
-            elif line.startswith(" rPT2 "):
-                rpt2 = float(re.search(r"rPT2\s+=\s+(-?\d+\.\d+E?.\d*)", line).group(1))
-                err_rpt2 = float(re.search(r"\+/-\s+(-?\d+\.\d+E?.\d*)", line).group(1))
-            elif "minimum PT2 Extrapolated energy" in line:
-                e_ex_line = lines[iline+2]
-                e_ex = float(e_ex_line.split()[1])
-                reading = False
-
-                new_data = " {:8d}  {:16.8f}  {:e}  {:e}  {:e}  {:e}  {:16.8f}".format(n_det, e, pt2, err_pt2, rpt2, err_rpt2, e_ex)
-                data.append(new_data)
-                n_det = e = pt2 = err_pt2 = rpt2 = err_rpt2 = e_ex = None
-
-    return data
-
-data = extract_data(output)
-
-for item in data:
-    print(item)
-

scripts/utility/qp_json.py

@@ -0,0 +1,66 @@
+#!/usr/bin/env python
+import os
+import json
+
+def fix_json(s):
+   """Properly termitates an incomplete JSON file"""
+
+   s = s.replace(' ','')
+   s = s.replace('\n','')
+   s = s.replace('\t','')
+   s = s.replace(",{}",'')
+   tmp = [ c for c in s if c in "[]{}" ]
+   tmp = "".join(tmp)
+   tmp_old = ""
+   while tmp != tmp_old:
+      tmp_old = tmp
+      tmp = tmp.replace("{}","")
+      tmp = tmp.replace("[]","")
+   while s[-1] in [ ',', '\n', ' ', '\t' ]:
+      s = s[:-1]
+   tmp = [ c for c in tmp ]
+   tmp.reverse()
+   for c in tmp:
+      if c == '[': s += "]"
+      elif c == '{': s += "}"
+   return s
+
+
+def load(filename):
+  """Loads a JSON file after calling the fix_json function."""
+  with open(filename,'r') as f:
+    data = f.read()
+  new_data = fix_json(data)
+  return json.loads(new_data)
+
+
+def load_all(ezfio_filename):
+  """Loads all JSON files of an EZFIO."""
+  d = {}
+  prefix = ezfio_filename+'/json/'
+  for filename in [ x for x in os.listdir(prefix) if x.endswith(".json")]:
+    d[filename] = load(prefix+filename)
+  return d
+
+
+def load_last(ezfio_filename):
+  """Loads last JSON file of an EZFIO."""
+  d = {}
+  prefix = ezfio_filename+'/json/'
+  l = [ x for x in os.listdir(prefix) if x.endswith(".json")]
+  l.sort()
+  filename = l[-1]
+  print(filename)
+  return load(prefix+filename)
+
+
+def fix(ezfio_filename):
+  """Fixes all JSON files in an EZFIO."""
+  d = load_all(ezfio_filename)
+  prefix = ezfio_filename+'/json/'
+  for filename in d.keys():
+        with open(prefix+filename, 'w') as json_file:
+            json.dump(d[filename], json_file)
+
+
+

src/ao_basis/aos_in_r.irp.f

@@ -12,21 +12,21 @@ double precision function ao_value(i,r)
  integer :: power_ao(3)
  double precision :: accu,dx,dy,dz,r2
  num_ao = ao_nucl(i)
-! power_ao(1:3)= ao_power(i,1:3)
+ power_ao(1:3)= ao_power(i,1:3)
-! center_ao(1:3) = nucl_coord(num_ao,1:3)
+ center_ao(1:3) = nucl_coord(num_ao,1:3)
-! dx = (r(1) - center_ao(1))
+ dx = (r(1) - center_ao(1))
-! dy = (r(2) - center_ao(2))
+ dy = (r(2) - center_ao(2))
-! dz = (r(3) - center_ao(3))
+ dz = (r(3) - center_ao(3))
-! r2 = dx*dx + dy*dy + dz*dz
+ r2 = dx*dx + dy*dy + dz*dz
-! dx = dx**power_ao(1)
+ dx = dx**power_ao(1)
-! dy = dy**power_ao(2)
+ dy = dy**power_ao(2)
-! dz = dz**power_ao(3)
+ dz = dz**power_ao(3)
 
  accu = 0.d0
-! do m=1,ao_prim_num(i)
+ do m=1,ao_prim_num(i)
-!   beta = ao_expo_ordered_transp(m,i)
+   beta = ao_expo_ordered_transp(m,i)
-!   accu += ao_coef_normalized_ordered_transp(m,i) * dexp(-beta*r2)
+   accu += ao_coef_normalized_ordered_transp(m,i) * dexp(-beta*r2)
-! enddo
+ enddo
  ao_value = accu * dx * dy * dz
 
 end

src/ao_many_one_e_ints/listj1b.irp.f

@@ -7,17 +7,17 @@ BEGIN_PROVIDER [integer, List_all_comb_b2_size]
 
   PROVIDE j1b_type
 
-  if(j1b_type .eq. 3) then
+  if((j1b_type .eq. 3) .or. (j1b_type .eq. 103)) then
 
     List_all_comb_b2_size = 2**nucl_num
 
-  elseif(j1b_type .eq. 4) then
+  elseif((j1b_type .eq. 4) .or. (j1b_type .eq. 104)) then
 
     List_all_comb_b2_size = nucl_num + 1
 
   else 
 
-    print *, 'j1b_type = ', j1b_pen, 'is not implemented'
+    print *, 'j1b_type = ', j1b_type, 'is not implemented'
     stop
 
   endif
@@ -67,7 +67,7 @@ END_PROVIDER
   List_all_comb_b2_expo = 0.d0
   List_all_comb_b2_cent = 0.d0
 
-  if(j1b_type .eq. 3) then
+  if((j1b_type .eq. 3) .or. (j1b_type .eq. 103)) then
 
     do i = 1, List_all_comb_b2_size
 
@@ -121,7 +121,7 @@ END_PROVIDER
       List_all_comb_b2_coef(i) = (-1.d0)**dble(phase) * dexp(-List_all_comb_b2_coef(i))
     enddo
 
-  elseif(j1b_type .eq. 4) then
+  elseif((j1b_type .eq. 4) .or. (j1b_type .eq. 104)) then
 
     List_all_comb_b2_coef(    1) = 1.d0
     List_all_comb_b2_expo(    1) = 0.d0
@@ -136,7 +136,7 @@ END_PROVIDER
 
   else
 
-    print *, 'j1b_type = ', j1b_pen, 'is not implemented'
+    print *, 'j1b_type = ', j1b_type, 'is not implemented'
     stop
 
   endif
@@ -156,18 +156,18 @@ BEGIN_PROVIDER [ integer, List_all_comb_b3_size]
   implicit none
   double precision :: tmp
 
-  if(j1b_type .eq. 3) then
+  if((j1b_type .eq. 3) .or. (j1b_type .eq. 103)) then
 
     List_all_comb_b3_size = 3**nucl_num
 
-  elseif(j1b_type .eq. 4) then
+  elseif((j1b_type .eq. 4) .or. (j1b_type .eq. 104)) then
 
     tmp                   = 0.5d0 * dble(nucl_num) * (dble(nucl_num) + 3.d0)
     List_all_comb_b3_size = int(tmp) + 1
 
   else
 
-    print *, 'j1b_type = ', j1b_pen, 'is not implemented'
+    print *, 'j1b_type = ', j1b_type, 'is not implemented'
     stop
 
   endif
@@ -230,7 +230,7 @@ END_PROVIDER
   List_all_comb_b3_expo = 0.d0
   List_all_comb_b3_cent = 0.d0
 
-  if(j1b_type .eq. 3) then
+  if((j1b_type .eq. 3) .or. (j1b_type .eq. 103)) then
 
     do i = 1, List_all_comb_b3_size
 
@@ -287,7 +287,7 @@ END_PROVIDER
       List_all_comb_b3_coef(i) = (-1.d0)**dble(phase) * facto * dexp(-List_all_comb_b3_coef(i))
     enddo
 
-  elseif(j1b_type .eq. 4) then
+  elseif((j1b_type .eq. 4) .or. (j1b_type .eq. 104)) then
 
     ii = 1
     List_all_comb_b3_coef(    ii) = 1.d0
@@ -347,7 +347,7 @@ END_PROVIDER
 
   else
 
-    print *, 'j1b_type = ', j1b_pen, 'is not implemented'
+    print *, 'j1b_type = ', j1b_type, 'is not implemented'
     stop
 
   endif

src/ao_one_e_ints/NEED

@@ -1,2 +1,3 @@
 ao_basis
 pseudo
+cosgtos_ao_int

src/ao_one_e_ints/ao_overlap.irp.f

@@ -1,27 +1,47 @@
- BEGIN_PROVIDER [ double precision, ao_overlap,(ao_num,ao_num) ]
+
-&BEGIN_PROVIDER [ double precision, ao_overlap_x,(ao_num,ao_num) ]
+! ---
-&BEGIN_PROVIDER [ double precision, ao_overlap_y,(ao_num,ao_num) ]
+
-&BEGIN_PROVIDER [ double precision, ao_overlap_z,(ao_num,ao_num) ]
+ BEGIN_PROVIDER [ double precision, ao_overlap  , (ao_num, ao_num) ]
-  implicit none
+&BEGIN_PROVIDER [ double precision, ao_overlap_x, (ao_num, ao_num) ]
+&BEGIN_PROVIDER [ double precision, ao_overlap_y, (ao_num, ao_num) ]
+&BEGIN_PROVIDER [ double precision, ao_overlap_z, (ao_num, ao_num) ]
+
   BEGIN_DOC
-! Overlap between atomic basis functions:
+  ! Overlap between atomic basis functions:
-!
+  !
-! :math:`\int \chi_i(r) \chi_j(r) dr`
+  ! :math:`\int \chi_i(r) \chi_j(r) dr`
   END_DOC
-  integer :: i,j,n,l
+
-  double precision :: f
+  implicit none
-  integer :: dim1
+  integer          :: i, j, n, l, dim1, power_A(3), power_B(3)
   double precision :: overlap, overlap_x, overlap_y, overlap_z
   double precision :: alpha, beta, c
   double precision :: A_center(3), B_center(3)
-  integer :: power_A(3), power_B(3)
+
   ao_overlap   = 0.d0
   ao_overlap_x = 0.d0
   ao_overlap_y = 0.d0
   ao_overlap_z = 0.d0
-  if (read_ao_integrals_overlap) then
+
+  if(read_ao_integrals_overlap) then
+
     call ezfio_get_ao_one_e_ints_ao_integrals_overlap(ao_overlap(1:ao_num, 1:ao_num))
     print *,  'AO overlap integrals read from disk'
+
+  else
+
+    if(use_cosgtos) then
+      !print*, ' use_cosgtos for ao_overlap ?', use_cosgtos
+
+      do j = 1, ao_num
+        do i = 1, ao_num
+          ao_overlap  (i,j) = ao_overlap_cosgtos  (i,j) 
+          ao_overlap_x(i,j) = ao_overlap_cosgtos_x(i,j)
+          ao_overlap_y(i,j) = ao_overlap_cosgtos_y(i,j)
+          ao_overlap_z(i,j) = ao_overlap_cosgtos_z(i,j)
+        enddo
+      enddo
+
     else
 
       dim1=100
@@ -69,7 +89,11 @@
       enddo
       enddo
       !$OMP END PARALLEL DO
+
     endif
+
+  endif
+
   if (write_ao_integrals_overlap) then
      call ezfio_set_ao_one_e_ints_ao_integrals_overlap(ao_overlap(1:ao_num, 1:ao_num))
      print *,  'AO overlap integrals written to disk'
@@ -77,6 +101,8 @@
 
 END_PROVIDER
 
+! ---
+
 BEGIN_PROVIDER [ double precision, ao_overlap_imag, (ao_num, ao_num) ]
  implicit none
  BEGIN_DOC
@@ -85,6 +111,8 @@ BEGIN_PROVIDER [ double precision, ao_overlap_imag, (ao_num, ao_num) ]
  ao_overlap_imag = 0.d0
 END_PROVIDER
 
+! ---
+
 BEGIN_PROVIDER [ complex*16, ao_overlap_complex, (ao_num, ao_num) ]
   implicit none
   BEGIN_DOC
@@ -98,37 +126,39 @@ BEGIN_PROVIDER [ complex*16, ao_overlap_complex, (ao_num, ao_num) ]
   enddo
 END_PROVIDER
 
+! ---
 
+BEGIN_PROVIDER [ double precision, ao_overlap_abs, (ao_num, ao_num) ]
 
-
-BEGIN_PROVIDER [ double precision, ao_overlap_abs,(ao_num,ao_num) ]
-  implicit none
   BEGIN_DOC
-! Overlap between absolute values of atomic basis functions:
+  ! Overlap between absolute values of atomic basis functions:
-!
+  !
-! :math:`\int |\chi_i(r)| |\chi_j(r)| dr`
+  ! :math:`\int |\chi_i(r)| |\chi_j(r)| dr`
   END_DOC
-  integer :: i,j,n,l
+
-  double precision :: f
+  implicit none
-  integer :: dim1
+  integer          :: i, j, n, l, dim1, power_A(3), power_B(3)
-  double precision :: overlap, overlap_x, overlap_y, overlap_z
+  double precision :: overlap_x, overlap_y, overlap_z
   double precision :: alpha, beta
   double precision :: A_center(3), B_center(3)
-  integer :: power_A(3), power_B(3)
   double precision :: lower_exp_val, dx
-  if (is_periodic) then
+
-    do j=1,ao_num
+  if(is_periodic) then
-      do i= 1,ao_num
+
-        ao_overlap_abs(i,j)= cdabs(ao_overlap_complex(i,j))
+    do j = 1, ao_num
+      do i = 1, ao_num
+        ao_overlap_abs(i,j) = cdabs(ao_overlap_complex(i,j))
       enddo
     enddo
+
   else
+
     dim1=100
     lower_exp_val = 40.d0
  !$OMP PARALLEL DO SCHEDULE(GUIDED)               &
  !$OMP DEFAULT(NONE)                              &
  !$OMP PRIVATE(A_center,B_center,power_A,power_B, &
-        !$OMP  overlap_x,overlap_y, overlap_z, overlap,              &
+ !$OMP  overlap_x,overlap_y, overlap_z,           &
  !$OMP  alpha, beta,i,j,dx)                       &
  !$OMP SHARED(nucl_coord,ao_power,ao_prim_num,    &
  !$OMP  ao_overlap_abs,ao_num,ao_coef_normalized_ordered_transp,ao_nucl,&
@@ -161,9 +191,13 @@ BEGIN_PROVIDER [ double precision, ao_overlap_abs,(ao_num,ao_num) ]
       enddo
     enddo
  !$OMP END PARALLEL DO
+
   endif
+
 END_PROVIDER
 
+! ---
+
 BEGIN_PROVIDER [ double precision, S_inv,(ao_num,ao_num) ]
  implicit none
  BEGIN_DOC

src/ao_one_e_ints/kin_ao_ints.irp.f

@@ -1,7 +1,10 @@
- BEGIN_PROVIDER [ double precision, ao_deriv2_x,(ao_num,ao_num) ]
+
-&BEGIN_PROVIDER [ double precision, ao_deriv2_y,(ao_num,ao_num) ]
+! ---
-&BEGIN_PROVIDER [ double precision, ao_deriv2_z,(ao_num,ao_num) ]
+
-  implicit none
+ BEGIN_PROVIDER [ double precision, ao_deriv2_x, (ao_num, ao_num) ]
+&BEGIN_PROVIDER [ double precision, ao_deriv2_y, (ao_num, ao_num) ]
+&BEGIN_PROVIDER [ double precision, ao_deriv2_z, (ao_num, ao_num) ]
+
   BEGIN_DOC
   ! Second derivative matrix elements in the |AO| basis.
   !
@@ -11,15 +14,28 @@
   !   \langle \chi_i(x,y,z) | \frac{\partial^2}{\partial x^2} |\chi_j (x,y,z) \rangle
   !
   END_DOC
-  integer :: i,j,n,l
+
-  double precision :: f
+  implicit none
-  integer :: dim1
+  integer          :: i, j, n, l, dim1, power_A(3), power_B(3)
   double precision :: overlap, overlap_y, overlap_z
   double precision :: overlap_x0, overlap_y0, overlap_z0
   double precision :: alpha, beta, c
   double precision :: A_center(3), B_center(3)
-  integer :: power_A(3), power_B(3)
   double precision :: d_a_2,d_2
+
+  if(use_cosgtos) then
+    !print*, 'use_cosgtos for ao_kinetic_integrals ?', use_cosgtos
+
+    do j = 1, ao_num
+      do i = 1, ao_num
+        ao_deriv2_x(i,j) = ao_deriv2_cosgtos_x(i,j)
+        ao_deriv2_y(i,j) = ao_deriv2_cosgtos_y(i,j)
+        ao_deriv2_z(i,j) = ao_deriv2_cosgtos_z(i,j)
+      enddo
+    enddo
+
+  else
+
     dim1=100
 
     ! -- Dummy call to provide everything
@@ -117,8 +133,12 @@
     enddo
     !$OMP END PARALLEL DO
 
+  endif
+
 END_PROVIDER
 
+! ---
+
 BEGIN_PROVIDER [double precision, ao_kinetic_integrals, (ao_num,ao_num)]
   implicit none
   BEGIN_DOC

src/ao_one_e_ints/pot_ao_erf_ints.irp.f

@@ -1,3 +1,6 @@
+
+! ---
+
 subroutine give_all_erf_kl_ao(integrals_ao,mu_in,C_center)
   implicit none
   BEGIN_DOC
@@ -15,36 +18,104 @@ subroutine give_all_erf_kl_ao(integrals_ao,mu_in,C_center)
   enddo
 end
 
+! ---
+
+double precision function NAI_pol_mult_erf_ao(i_ao, j_ao, mu_in, C_center)
 
-double precision function NAI_pol_mult_erf_ao(i_ao,j_ao,mu_in,C_center)
-  implicit none
   BEGIN_DOC
+  !
   ! Computes the following integral :
-  ! $\int_{-\infty}^{infty} dr \chi_i(r) \chi_j(r) \frac{\erf(\mu | r - R_C | )}{ | r - R_C | }$.
+  ! $\int_{-\infty}^{infty} dr \chi_i(r) \chi_j(r) \frac{\erf(\mu |r - R_C|)}{|r - R_C|}$.
+  !
   END_DOC
-  integer, intent(in)            :: i_ao,j_ao
+
+  implicit none
+  integer,          intent(in)   :: i_ao, j_ao
   double precision, intent(in)   :: mu_in, C_center(3)
-  integer                        :: i,j,num_A,num_B, power_A(3), power_B(3), n_pt_in
+
-  double precision               :: A_center(3), B_center(3),integral, alpha,beta
+  integer                        :: i, j, num_A, num_B, power_A(3), power_B(3), n_pt_in
+  double precision               :: A_center(3), B_center(3), integral, alpha, beta
+
   double precision               :: NAI_pol_mult_erf
+
   num_A         = ao_nucl(i_ao)
-  power_A(1:3)= ao_power(i_ao,1:3)
+  power_A(1:3)  = ao_power(i_ao,1:3)
   A_center(1:3) = nucl_coord(num_A,1:3)
   num_B         = ao_nucl(j_ao)
-  power_B(1:3)= ao_power(j_ao,1:3)
+  power_B(1:3)  = ao_power(j_ao,1:3)
   B_center(1:3) = nucl_coord(num_B,1:3)
+
   n_pt_in = n_pt_max_integrals
+
   NAI_pol_mult_erf_ao = 0.d0
   do i = 1, ao_prim_num(i_ao)
     alpha = ao_expo_ordered_transp(i,i_ao)
     do j = 1, ao_prim_num(j_ao)
       beta = ao_expo_ordered_transp(j,j_ao)
-      integral =  NAI_pol_mult_erf(A_center,B_center,power_A,power_B,alpha,beta,C_center,n_pt_in,mu_in)
+
-      NAI_pol_mult_erf_ao += integral * ao_coef_normalized_ordered_transp(j,j_ao)*ao_coef_normalized_ordered_transp(i,i_ao)
+      integral = NAI_pol_mult_erf(A_center, B_center, power_A, power_B, alpha, beta, C_center, n_pt_in,mu_in)
+
+      NAI_pol_mult_erf_ao += integral * ao_coef_normalized_ordered_transp(j,j_ao) * ao_coef_normalized_ordered_transp(i,i_ao)
     enddo
   enddo
 
-end
+end function NAI_pol_mult_erf_ao
+
+! ---
+
+double precision function NAI_pol_mult_erf_ao_with1s(i_ao, j_ao, beta, B_center, mu_in, C_center)
+
+  BEGIN_DOC
+  !
+  ! Computes the following integral :
+  ! $\int_{-\infty}^{infty} dr \chi_i(r) \chi_j(r) e^{-\beta (r - B_center)^2} \frac{\erf(\mu |r - R_C|)}{|r - R_C|}$.
+  !
+  END_DOC
+
+  implicit none
+  integer,          intent(in)   :: i_ao, j_ao
+  double precision, intent(in)   :: beta, B_center(3)
+  double precision, intent(in)   :: mu_in, C_center(3)
+
+  integer                        :: i, j, power_A1(3), power_A2(3), n_pt_in
+  double precision               :: A1_center(3), A2_center(3), alpha1, alpha2, coef12, coef1, integral
+
+  double precision, external     :: NAI_pol_mult_erf_with1s, NAI_pol_mult_erf_ao
+
+  ASSERT(beta .ge. 0.d0)
+  if(beta .lt. 1d-10) then
+    NAI_pol_mult_erf_ao_with1s = NAI_pol_mult_erf_ao(i_ao, j_ao, mu_in, C_center)
+    return
+  endif
+
+  power_A1(1:3) = ao_power(i_ao,1:3)
+  power_A2(1:3) = ao_power(j_ao,1:3)
+
+  A1_center(1:3) = nucl_coord(ao_nucl(i_ao),1:3)
+  A2_center(1:3) = nucl_coord(ao_nucl(j_ao),1:3)
+
+  n_pt_in = n_pt_max_integrals
+
+  NAI_pol_mult_erf_ao_with1s = 0.d0
+  do i = 1, ao_prim_num(i_ao)
+    alpha1 = ao_expo_ordered_transp           (i,i_ao)
+    coef1  = ao_coef_normalized_ordered_transp(i,i_ao)
+
+    do j = 1, ao_prim_num(j_ao)
+      alpha2 = ao_expo_ordered_transp(j,j_ao)
+      coef12 = coef1 * ao_coef_normalized_ordered_transp(j,j_ao)
+      if(dabs(coef12) .lt. 1d-14) cycle
+
+      integral = NAI_pol_mult_erf_with1s( A1_center, A2_center, power_A1, power_A2, alpha1, alpha2 &
+                                        , beta, B_center, C_center, n_pt_in, mu_in )
+
+      NAI_pol_mult_erf_ao_with1s += integral * coef12
+    enddo
+  enddo
+
+end function NAI_pol_mult_erf_ao_with1s
+
+! ---
 
 double precision function NAI_pol_mult_erf(A_center, B_center, power_A, power_B, alpha, beta, C_center, n_pt_in, mu_in)
 
@@ -127,58 +198,221 @@ end function NAI_pol_mult_erf
 
 ! ---
 
-
+subroutine NAI_pol_mult_erf_v(A_center, B_center, power_A, power_B, alpha, beta, C_center, LD_C, n_pt_in, mu_in, res_v, LD_resv, n_points)
-double precision function NAI_pol_mult_erf_ao_with1s(i_ao, j_ao, beta, B_center, mu_in, C_center)
 
   BEGIN_DOC
   !
   ! Computes the following integral :
-  ! $\int_{-\infty}^{infty} dr \chi_i(r) \chi_j(r) e^{-\beta (r - B_center)^2} \frac{\erf(\mu |r - R_C|)}{|r - R_C|}$.
+  !
+  ! .. math::
+  !
+  !   \int dr (x-A_x)^a (x-B_x)^b \exp(-\alpha (x-A_x)^2 - \beta (x-B_x)^2 )
+  !   \frac{\erf(\mu |r - R_C |)}{| r - R_C |}$.
   !
   END_DOC
 
+  include 'utils/constants.include.F'
+
   implicit none
-  integer,          intent(in)   :: i_ao, j_ao
-  double precision, intent(in)   :: beta, B_center(3)
-  double precision, intent(in)   :: mu_in, C_center(3)
 
-  integer                        :: i, j, power_A1(3), power_A2(3), n_pt_in
+  integer,          intent(in)  :: n_pt_in, n_points, LD_C, LD_resv
-  double precision               :: A1_center(3), A2_center(3), alpha1, alpha2, coef12, coef1, integral
+  integer,          intent(in)  :: power_A(3), power_B(3)
+  double precision, intent(in)  :: A_center(3), B_center(3), alpha, beta, mu_in
+  double precision, intent(in)  :: C_center(LD_C,3)
+  double precision, intent(out) :: res_v(LD_resv)
 
-  double precision, external     :: NAI_pol_mult_erf_with1s, NAI_pol_mult_erf_ao
+  integer                       :: i, n_pt, n_pt_out, ipoint
+  double precision              :: P_center(3)
+  double precision              :: d(0:n_pt_in), coeff, dist, const, factor
+  double precision              :: const_factor, dist_integral
+  double precision              :: accu, p_inv, p, rho, p_inv_2
+  double precision              :: p_new, p_new2, coef_tmp
 
-  ASSERT(beta .ge. 0.d0)
+  double precision              :: rint
-  if(beta .lt. 1d-10) then
+
-    NAI_pol_mult_erf_ao_with1s = NAI_pol_mult_erf_ao(i_ao, j_ao, mu_in, C_center)
+  res_V(1:LD_resv) = 0.d0
+
+  p        = alpha + beta
+  p_inv    = 1.d0 / p
+  p_inv_2  = 0.5d0 * p_inv
+  rho      = alpha * beta * p_inv
+  p_new    = mu_in / dsqrt(p + mu_in * mu_in)
+  p_new2   = p_new * p_new
+  coef_tmp = p * p_new2
+
+  dist = 0.d0
+  do i = 1, 3
+    P_center(i) = (alpha * A_center(i) + beta * B_center(i)) * p_inv
+    dist       += (A_center(i) - B_center(i)) * (A_center(i) - B_center(i))
+  enddo
+
+  const_factor = dist * rho
+  if(const_factor > 80.d0) then
+    return
+  endif
+  factor = dexp(-const_factor)
+  coeff  = dtwo_pi * factor * p_inv * p_new
+
+  n_pt =  2 * ( power_A(1) + power_B(1) + power_A(2) + power_B(2) + power_A(3) + power_B(3) )
+
+  if(n_pt == 0) then
+
+    do ipoint = 1, n_points
+      dist_integral = 0.d0
+      do i = 1, 3
+        dist_integral += (P_center(i) - C_center(ipoint,i)) * (P_center(i) - C_center(ipoint,i))
+      enddo
+      const = coef_tmp * dist_integral 
+
+      res_v(ipoint) = coeff * rint(0, const)
+    enddo
+
+  else
+
+    do ipoint = 1, n_points
+      dist_integral = 0.d0
+      do i = 1, 3
+        dist_integral += (P_center(i) - C_center(ipoint,i)) * (P_center(i) - C_center(ipoint,i))
+      enddo
+      const = coef_tmp * dist_integral 
+
+      do i = 0, n_pt_in
+        d(i) = 0.d0
+      enddo
+      call give_polynomial_mult_center_one_e_erf_opt(A_center, B_center, power_A, power_B, C_center(ipoint,1:3), n_pt_in, d, n_pt_out, p_inv_2, p_new2, P_center)
+     
+      if(n_pt_out < 0) then
+        res_v(ipoint) = 0.d0
+        cycle
+      endif
+
+      ! sum of integrals of type : int {t,[0,1]}  exp-(rho.(P-Q)^2 * t^2) * t^i
+      accu = 0.d0
+      do i = 0, n_pt_out, 2
+        accu += d(i) * rint(i/2, const)
+      enddo
+     
+      res_v(ipoint) = accu * coeff
+    enddo
+
+  endif
+
+end subroutine NAI_pol_mult_erf_v
+
+! ---
+
+double precision function NAI_pol_mult_erf_with1s( A1_center, A2_center, power_A1, power_A2, alpha1, alpha2 &
+                                                 , beta, B_center, C_center, n_pt_in, mu_in )
+
+  BEGIN_DOC
+  !
+  ! Computes the following integral :
+  !
+  ! .. math::
+  !
+  !   \int dx (x - A1_x)^a_1 (x - B1_x)^a_2 \exp(-\alpha_1 (x - A1_x)^2 - \alpha_2 (x - A2_x)^2)
+  !   \int dy (y - A1_y)^b_1 (y - B1_y)^b_2 \exp(-\alpha_1 (y - A1_y)^2 - \alpha_2 (y - A2_y)^2)
+  !   \int dz (x - A1_z)^c_1 (z - B1_z)^c_2 \exp(-\alpha_1 (z - A1_z)^2 - \alpha_2 (z - A2_z)^2)
+  !   \exp(-\beta (r - B)^2)
+  !   \frac{\erf(\mu |r - R_C|)}{|r - R_C|}$.
+  !
+  END_DOC
+
+  include 'utils/constants.include.F'
+
+  implicit none
+  integer,          intent(in) :: n_pt_in
+  integer,          intent(in) :: power_A1(3), power_A2(3)
+  double precision, intent(in) :: C_center(3), A1_center(3), A2_center(3), B_center(3)
+  double precision, intent(in) :: alpha1, alpha2, beta, mu_in
+
+  integer                      :: i, n_pt, n_pt_out
+  double precision             :: alpha12, alpha12_inv, alpha12_inv_2, rho12, A12_center(3), dist12, const_factor12
+  double precision             :: p, p_inv, p_inv_2, rho, P_center(3), dist, const_factor
+  double precision             :: dist_integral
+  double precision             :: d(0:n_pt_in), coeff, const, factor
+  double precision             :: accu
+  double precision             :: p_new
+
+  double precision             :: rint
+
+
+  ! e^{-alpha1 (r - A1)^2} e^{-alpha2 (r - A2)^2} = e^{-K12} e^{-alpha12 (r - A12)^2}
+  alpha12       = alpha1 + alpha2
+  alpha12_inv   = 1.d0 / alpha12
+  alpha12_inv_2 = 0.5d0 * alpha12_inv
+  rho12         = alpha1 * alpha2 * alpha12_inv
+  A12_center(1) = (alpha1 * A1_center(1) + alpha2 * A2_center(1)) * alpha12_inv
+  A12_center(2) = (alpha1 * A1_center(2) + alpha2 * A2_center(2)) * alpha12_inv
+  A12_center(3) = (alpha1 * A1_center(3) + alpha2 * A2_center(3)) * alpha12_inv
+  dist12        = (A1_center(1) - A2_center(1)) * (A1_center(1) - A2_center(1)) &
+                + (A1_center(2) - A2_center(2)) * (A1_center(2) - A2_center(2)) &
+                + (A1_center(3) - A2_center(3)) * (A1_center(3) - A2_center(3))
+
+  const_factor12 = dist12 * rho12
+  if(const_factor12 > 80.d0) then
+    NAI_pol_mult_erf_with1s = 0.d0
     return
   endif
 
-  power_A1(1:3) = ao_power(i_ao,1:3)
+  ! ---
-  power_A2(1:3) = ao_power(j_ao,1:3)
 
-  A1_center(1:3) = nucl_coord(ao_nucl(i_ao),1:3)
+  ! e^{-K12} e^{-alpha12 (r - A12)^2} e^{-beta (r - B)^2} = e^{-K} e^{-p (r - P)^2}
-  A2_center(1:3) = nucl_coord(ao_nucl(j_ao),1:3)
+  p           = alpha12 + beta
+  p_inv       = 1.d0 / p
+  p_inv_2     = 0.5d0 * p_inv
+  rho         = alpha12 * beta * p_inv
+  P_center(1) = (alpha12 * A12_center(1) + beta * B_center(1)) * p_inv
+  P_center(2) = (alpha12 * A12_center(2) + beta * B_center(2)) * p_inv
+  P_center(3) = (alpha12 * A12_center(3) + beta * B_center(3)) * p_inv
+  dist        = (A12_center(1) - B_center(1)) * (A12_center(1) - B_center(1)) &
+              + (A12_center(2) - B_center(2)) * (A12_center(2) - B_center(2)) &
+              + (A12_center(3) - B_center(3)) * (A12_center(3) - B_center(3))
 
-  n_pt_in = n_pt_max_integrals
+  const_factor = const_factor12 + dist * rho
+  if(const_factor > 80.d0) then
+    NAI_pol_mult_erf_with1s = 0.d0
+    return
+  endif
 
-  NAI_pol_mult_erf_ao_with1s = 0.d0
+  dist_integral = (P_center(1) - C_center(1)) * (P_center(1) - C_center(1)) &
-  do i = 1, ao_prim_num(i_ao)
+                + (P_center(2) - C_center(2)) * (P_center(2) - C_center(2)) &
-    alpha1 = ao_expo_ordered_transp           (i,i_ao)
+                + (P_center(3) - C_center(3)) * (P_center(3) - C_center(3))
-    coef1  = ao_coef_normalized_ordered_transp(i,i_ao)
 
-    do j = 1, ao_prim_num(j_ao)
+  ! ---
-      alpha2 = ao_expo_ordered_transp(j,j_ao)
-      coef12 = coef1 * ao_coef_normalized_ordered_transp(j,j_ao)
-      if(dabs(coef12) .lt. 1d-14) cycle
 
-      integral = NAI_pol_mult_erf_with1s( A1_center, A2_center, power_A1, power_A2, alpha1, alpha2 &
+  p_new  = mu_in / dsqrt(p + mu_in * mu_in)
-                                        , beta, B_center, C_center, n_pt_in, mu_in )
+  factor = dexp(-const_factor)
+  coeff  = dtwo_pi * factor * p_inv * p_new
 
-      NAI_pol_mult_erf_ao_with1s += integral * coef12
+  n_pt  =  2 * ( (power_A1(1) + power_A2(1)) + (power_A1(2) + power_A2(2)) + (power_A1(3) + power_A2(3)) )
-    enddo
+  const = p * dist_integral * p_new * p_new
+  if(n_pt == 0) then
+    NAI_pol_mult_erf_with1s = coeff * rint(0, const)
+    return
+  endif
+
+  do i = 0, n_pt_in
+    d(i) = 0.d0
   enddo
+  p_new = p_new * p_new
+  call give_polynomial_mult_center_one_e_erf_opt( A1_center, A2_center, power_A1, power_A2, C_center, n_pt_in, d, n_pt_out, p_inv_2, p_new, P_center)
 
-end function NAI_pol_mult_erf_ao_with1s
+  if(n_pt_out < 0) then
+    NAI_pol_mult_erf_with1s = 0.d0
+    return
+  endif
+
+  ! sum of integrals of type : int {t,[0,1]}  exp-(rho.(P-Q)^2 * t^2) * t^i
+  accu = 0.d0
+  do i = 0, n_pt_out, 2
+    accu += d(i) * rint(i/2, const)
+  enddo
+  NAI_pol_mult_erf_with1s = accu * coeff
+
+end function NAI_pol_mult_erf_with1s
+
+! ---
 
 subroutine NAI_pol_mult_erf_with1s_v(A1_center, A2_center, power_A1, power_A2, alpha1, alpha2, beta, B_center, LD_B, C_center, LD_C, n_pt_in, mu_in, res_v, LD_resv, n_points)
 
@@ -428,107 +662,6 @@ subroutine give_polynomial_mult_center_one_e_erf_opt(A_center, B_center, power_A
 end subroutine give_polynomial_mult_center_one_e_erf_opt
 
 ! ---
-subroutine NAI_pol_mult_erf_v(A_center, B_center, power_A, power_B, alpha, beta, C_center, LD_C, n_pt_in, mu_in, res_v, LD_resv, n_points)
-
-  BEGIN_DOC
-  !
-  ! Computes the following integral :
-  !
-  ! .. math::
-  !
-  !   \int dr (x-A_x)^a (x-B_x)^b \exp(-\alpha (x-A_x)^2 - \beta (x-B_x)^2 )
-  !   \frac{\erf(\mu |r - R_C |)}{| r - R_C |}$.
-  !
-  END_DOC
-
-  include 'utils/constants.include.F'
-
-  implicit none
-
-  integer,          intent(in)  :: n_pt_in, n_points, LD_C, LD_resv
-  integer,          intent(in)  :: power_A(3), power_B(3)
-  double precision, intent(in)  :: A_center(3), B_center(3), alpha, beta, mu_in
-  double precision, intent(in)  :: C_center(LD_C,3)
-  double precision, intent(out) :: res_v(LD_resv)
-
-  integer                       :: i, n_pt, n_pt_out, ipoint
-  double precision              :: P_center(3)
-  double precision              :: d(0:n_pt_in), coeff, dist, const, factor
-  double precision              :: const_factor, dist_integral
-  double precision              :: accu, p_inv, p, rho, p_inv_2
-  double precision              :: p_new, p_new2, coef_tmp
-
-  double precision              :: rint
-
-  res_V(1:LD_resv) = 0.d0
-
-  p        = alpha + beta
-  p_inv    = 1.d0 / p
-  p_inv_2  = 0.5d0 * p_inv
-  rho      = alpha * beta * p_inv
-  p_new    = mu_in / dsqrt(p + mu_in * mu_in)
-  p_new2   = p_new * p_new
-  coef_tmp = p * p_new2
-
-  dist = 0.d0
-  do i = 1, 3
-    P_center(i) = (alpha * A_center(i) + beta * B_center(i)) * p_inv
-    dist       += (A_center(i) - B_center(i)) * (A_center(i) - B_center(i))
-  enddo
-
-  const_factor = dist * rho
-  if(const_factor > 80.d0) then
-    return
-  endif
-  factor = dexp(-const_factor)
-  coeff  = dtwo_pi * factor * p_inv * p_new
-
-  n_pt =  2 * ( power_A(1) + power_B(1) + power_A(2) + power_B(2) + power_A(3) + power_B(3) )
-
-  if(n_pt == 0) then
-
-    do ipoint = 1, n_points
-      dist_integral = 0.d0
-      do i = 1, 3
-        dist_integral += (P_center(i) - C_center(ipoint,i)) * (P_center(i) - C_center(ipoint,i))
-      enddo
-      const = coef_tmp * dist_integral
-
-      res_v(ipoint) = coeff * rint(0, const)
-    enddo
-
-  else
-
-    do ipoint = 1, n_points
-      dist_integral = 0.d0
-      do i = 1, 3
-        dist_integral += (P_center(i) - C_center(ipoint,i)) * (P_center(i) - C_center(ipoint,i))
-      enddo
-      const = coef_tmp * dist_integral
-
-      do i = 0, n_pt_in
-        d(i) = 0.d0
-      enddo
-      call give_polynomial_mult_center_one_e_erf_opt(A_center, B_center, power_A, power_B, C_center(ipoint,1:3), n_pt_in, d, n_pt_out, p_inv_2, p_new2, P_center)                                                                                                                                                                                                                                                                                                                                                                                                                                                                  
-
-      if(n_pt_out < 0) then
-        res_v(ipoint) = 0.d0
-        cycle
-      endif
-
-      ! sum of integrals of type : int {t,[0,1]}  exp-(rho.(P-Q)^2 * t^2) * t^i
-      accu = 0.d0
-      do i = 0, n_pt_out, 2
-        accu += d(i) * rint(i/2, const)
-      enddo
-
-      res_v(ipoint) = accu * coeff
-    enddo
-
-  endif
-
-end subroutine NAI_pol_mult_erf_v
-
 
 subroutine give_polynomial_mult_center_one_e_erf(A_center,B_center,alpha,beta,power_A,power_B,C_center,n_pt_in,d,n_pt_out,mu_in)
 
@@ -659,113 +792,3 @@ subroutine give_polynomial_mult_center_one_e_erf(A_center,B_center,alpha,beta,po
 
 end
 
-double precision function NAI_pol_mult_erf_with1s( A1_center, A2_center, power_A1, power_A2, alpha1, alpha2 &
-                                                 , beta, B_center, C_center, n_pt_in, mu_in )
-
-  BEGIN_DOC
-  !
-  ! Computes the following integral :
-  !
-  ! .. math::
-  !
-  !   \int dx (x - A1_x)^a_1 (x - B1_x)^a_2 \exp(-\alpha_1 (x - A1_x)^2 - \alpha_2 (x - A2_x)^2)
-  !   \int dy (y - A1_y)^b_1 (y - B1_y)^b_2 \exp(-\alpha_1 (y - A1_y)^2 - \alpha_2 (y - A2_y)^2)
-  !   \int dz (x - A1_z)^c_1 (z - B1_z)^c_2 \exp(-\alpha_1 (z - A1_z)^2 - \alpha_2 (z - A2_z)^2)
-  !   \exp(-\beta (r - B)^2)
-  !   \frac{\erf(\mu |r - R_C|)}{|r - R_C|}$.
-  !
-  END_DOC
-
-  include 'utils/constants.include.F'
-
-  implicit none
-  integer,          intent(in) :: n_pt_in
-  integer,          intent(in) :: power_A1(3), power_A2(3)
-  double precision, intent(in) :: C_center(3), A1_center(3), A2_center(3), B_center(3)
-  double precision, intent(in) :: alpha1, alpha2, beta, mu_in
-
-  integer                      :: i, n_pt, n_pt_out
-  double precision             :: alpha12, alpha12_inv, alpha12_inv_2, rho12, A12_center(3), dist12, const_factor12
-  double precision             :: p, p_inv, p_inv_2, rho, P_center(3), dist, const_factor
-  double precision             :: dist_integral
-  double precision             :: d(0:n_pt_in), coeff, const, factor
-  double precision             :: accu
-  double precision             :: p_new
-
-  double precision             :: rint
-
-
-  ! e^{-alpha1 (r - A1)^2} e^{-alpha2 (r - A2)^2} = e^{-K12} e^{-alpha12 (r - A12)^2}
-  alpha12       = alpha1 + alpha2
-  alpha12_inv   = 1.d0 / alpha12
-  alpha12_inv_2 = 0.5d0 * alpha12_inv
-  rho12         = alpha1 * alpha2 * alpha12_inv
-  A12_center(1) = (alpha1 * A1_center(1) + alpha2 * A2_center(1)) * alpha12_inv
-  A12_center(2) = (alpha1 * A1_center(2) + alpha2 * A2_center(2)) * alpha12_inv
-  A12_center(3) = (alpha1 * A1_center(3) + alpha2 * A2_center(3)) * alpha12_inv
-  dist12        = (A1_center(1) - A2_center(1)) * (A1_center(1) - A2_center(1)) &
-                + (A1_center(2) - A2_center(2)) * (A1_center(2) - A2_center(2)) &
-                + (A1_center(3) - A2_center(3)) * (A1_center(3) - A2_center(3))
-
-  const_factor12 = dist12 * rho12
-  if(const_factor12 > 80.d0) then
-    NAI_pol_mult_erf_with1s = 0.d0
-    return
-  endif
-
-  ! ---
-
-  ! e^{-K12} e^{-alpha12 (r - A12)^2} e^{-beta (r - B)^2} = e^{-K} e^{-p (r - P)^2}
-  p           = alpha12 + beta
-  p_inv       = 1.d0 / p
-  p_inv_2     = 0.5d0 * p_inv
-  rho         = alpha12 * beta * p_inv
-  P_center(1) = (alpha12 * A12_center(1) + beta * B_center(1)) * p_inv
-  P_center(2) = (alpha12 * A12_center(2) + beta * B_center(2)) * p_inv
-  P_center(3) = (alpha12 * A12_center(3) + beta * B_center(3)) * p_inv
-  dist        = (A12_center(1) - B_center(1)) * (A12_center(1) - B_center(1)) &
-              + (A12_center(2) - B_center(2)) * (A12_center(2) - B_center(2)) &
-              + (A12_center(3) - B_center(3)) * (A12_center(3) - B_center(3))
-
-  const_factor = const_factor12 + dist * rho
-  if(const_factor > 80.d0) then
-    NAI_pol_mult_erf_with1s = 0.d0
-    return
-  endif
-
-  dist_integral = (P_center(1) - C_center(1)) * (P_center(1) - C_center(1)) &
-                + (P_center(2) - C_center(2)) * (P_center(2) - C_center(2)) &
-                + (P_center(3) - C_center(3)) * (P_center(3) - C_center(3))
-
-  ! ---
-
-  p_new  = mu_in / dsqrt(p + mu_in * mu_in)
-  factor = dexp(-const_factor)
-  coeff  = dtwo_pi * factor * p_inv * p_new
-
-  n_pt  =  2 * ( (power_A1(1) + power_A2(1)) + (power_A1(2) + power_A2(2)) + (power_A1(3) + power_A2(3)) )
-  const = p * dist_integral * p_new * p_new
-  if(n_pt == 0) then
-    NAI_pol_mult_erf_with1s = coeff * rint(0, const)
-    return
-  endif
-
-  do i = 0, n_pt_in
-    d(i) = 0.d0
-  enddo
-  p_new = p_new * p_new
-  call give_polynomial_mult_center_one_e_erf_opt( A1_center, A2_center, power_A1, power_A2, C_center, n_pt_in, d, n_pt_out, p_inv_2, p_new, P_center)
-
-  if(n_pt_out < 0) then
-    NAI_pol_mult_erf_with1s = 0.d0
-    return
-  endif
-
-  ! sum of integrals of type : int {t,[0,1]}  exp-(rho.(P-Q)^2 * t^2) * t^i
-  accu = 0.d0
-  do i = 0, n_pt_out, 2
-    accu += d(i) * rint(i/2, const)
-  enddo
-  NAI_pol_mult_erf_with1s = accu * coeff
-
-end function NAI_pol_mult_erf_with1s

src/ao_one_e_ints/pot_ao_ints.irp.f

@@ -1,4 +1,8 @@
+
+! ---
+
 BEGIN_PROVIDER [ double precision, ao_integrals_n_e, (ao_num,ao_num)]
+
   BEGIN_DOC
   !  Nucleus-electron interaction, in the |AO| basis set.
   !
@@ -6,30 +10,38 @@ BEGIN_PROVIDER [ double precision, ao_integrals_n_e, (ao_num,ao_num)]
   !
   !  These integrals also contain the pseudopotential integrals.
   END_DOC
-  implicit none
-  double precision               :: alpha, beta, gama, delta
-  integer                        :: num_A,num_B
-  double precision               :: A_center(3),B_center(3),C_center(3)
-  integer                        :: power_A(3),power_B(3)
-  integer                        :: i,j,k,l,n_pt_in,m
-  double precision               :: overlap_x,overlap_y,overlap_z,overlap,dx,NAI_pol_mult
 
-  if (read_ao_integrals_n_e) then
+  implicit none
-    call ezfio_get_ao_one_e_ints_ao_integrals_n_e(ao_integrals_n_e)
+  integer          :: num_A, num_B, power_A(3), power_B(3)
-    print *,  'AO N-e integrals read from disk'
+  integer          :: i, j, k, l, n_pt_in, m
-  else
+  double precision :: alpha, beta
+  double precision :: A_center(3),B_center(3),C_center(3)
+  double precision :: overlap_x,overlap_y,overlap_z,overlap,dx,NAI_pol_mult
 
   ao_integrals_n_e = 0.d0
 
-    !        _
+  if (read_ao_integrals_n_e) then
-    ! /|  / |_)
+
-    !  | /  | \
+    call ezfio_get_ao_one_e_ints_ao_integrals_n_e(ao_integrals_n_e)
-    !
+    print *,  'AO N-e integrals read from disk'
+
+  else
+
+    if(use_cosgtos) then
+      !print *, " use_cosgtos for ao_integrals_n_e ?", use_cosgtos
+
+      do j = 1, ao_num
+        do i = 1, ao_num
+          ao_integrals_n_e(i,j) = ao_integrals_n_e_cosgtos(i,j)
+        enddo
+      enddo
+
+    else
 
       !$OMP PARALLEL                                                   &
           !$OMP DEFAULT (NONE)                                         &
           !$OMP PRIVATE (i,j,k,l,m,alpha,beta,A_center,B_center,C_center,power_A,power_B,&
-        !$OMP          num_A,num_B,Z,c,n_pt_in)                      &
+          !$OMP          num_A,num_B,Z,c,c1,n_pt_in)                      &
           !$OMP SHARED (ao_num,ao_prim_num,ao_expo_ordered_transp,ao_power,ao_nucl,nucl_coord,ao_coef_normalized_ordered_transp,&
           !$OMP         n_pt_max_integrals,ao_integrals_n_e,nucl_num,nucl_charge)
 
@@ -54,7 +66,7 @@ BEGIN_PROVIDER [ double precision, ao_integrals_n_e, (ao_num,ao_num)]
             do m=1,ao_prim_num(i)
               beta = ao_expo_ordered_transp(m,i)
 
-            double precision               :: c
+              double precision               :: c, c1
               c = 0.d0
 
               do  k = 1, nucl_num
@@ -63,8 +75,16 @@ BEGIN_PROVIDER [ double precision, ao_integrals_n_e, (ao_num,ao_num)]
 
                 C_center(1:3) = nucl_coord(k,1:3)
 
-              c = c - Z * NAI_pol_mult(A_center,B_center,            &
+                !print *, ' '
-                  power_A,power_B,alpha,beta,C_center,n_pt_in)
+                !print *, A_center, B_center, C_center, power_A, power_B
+                !print *, alpha, beta
+
+                c1 = NAI_pol_mult( A_center, B_center, power_A, power_B &
+                                 , alpha, beta, C_center, n_pt_in )
+
+                !print *, ' c1 = ', c1
+
+                c = c - Z * c1
 
               enddo
               ao_integrals_n_e(i,j) = ao_integrals_n_e(i,j)  &
@@ -77,13 +97,13 @@ BEGIN_PROVIDER [ double precision, ao_integrals_n_e, (ao_num,ao_num)]
 
     !$OMP END DO
     !$OMP END PARALLEL
-    IF (DO_PSEUDO) THEN
+
+    endif
+
+
+    IF(do_pseudo) THEN
        ao_integrals_n_e += ao_pseudo_integrals
     ENDIF
-    IF(point_charges) THEN
-       ao_integrals_n_e += ao_integrals_pt_chrg
-    ENDIF
-
 
   endif
 
@@ -102,7 +122,7 @@ BEGIN_PROVIDER [ double precision, ao_integrals_n_e_imag, (ao_num,ao_num)]
   !  :math:`\langle \chi_i | -\sum_A \frac{1}{|r-R_A|} | \chi_j \rangle`
   END_DOC
   implicit none
-  double precision               :: alpha, beta, gama, delta
+  double precision               :: alpha, beta
   integer                        :: num_A,num_B
   double precision               :: A_center(3),B_center(3),C_center(3)
   integer                        :: power_A(3),power_B(3)
@@ -125,7 +145,7 @@ BEGIN_PROVIDER [ double precision, ao_integrals_n_e_per_atom, (ao_num,ao_num,nuc
 ! :math:`\langle \chi_i | -\frac{1}{|r-R_A|} | \chi_j \rangle`
   END_DOC
   implicit none
-  double precision               :: alpha, beta, gama, delta
+  double precision               :: alpha, beta
   integer                        :: i_c,num_A,num_B
   double precision               :: A_center(3),B_center(3),C_center(3)
   integer                        :: power_A(3),power_B(3)
@@ -268,6 +288,7 @@ double precision function NAI_pol_mult(A_center,B_center,power_A,power_B,alpha,b
 
 end
 
+! ---
 
 subroutine give_polynomial_mult_center_one_e(A_center,B_center,alpha,beta,power_A,power_B,C_center,n_pt_in,d,n_pt_out)
   implicit none
@@ -579,61 +600,3 @@ double precision function V_r(n,alpha)
 end
 
 
-double precision function V_phi(n,m)
-  implicit none
-  BEGIN_DOC
-  ! Computes the angular $\phi$ part of the nuclear attraction integral:
-  !
-  ! $\int_{0}^{2 \pi} \cos(\phi)^n \sin(\phi)^m d\phi$.
-  END_DOC
-  integer                        :: n,m, i
-  double precision               :: prod, Wallis
-  prod = 1.d0
-  do i = 0,shiftr(n,1)-1
-    prod = prod/ (1.d0 + dfloat(m+1)/dfloat(n-i-i-1))
-  enddo
-  V_phi = 4.d0 * prod * Wallis(m)
-end
-
-
-double precision function V_theta(n,m)
-  implicit none
-  BEGIN_DOC
-  ! Computes the angular $\theta$ part of the nuclear attraction integral:
-  !
-  ! $\int_{0}^{\pi} \cos(\theta)^n \sin(\theta)^m d\theta$
-  END_DOC
-  integer                        :: n,m,i
-  double precision               :: Wallis, prod
-  include 'utils/constants.include.F'
-  V_theta = 0.d0
-  prod = 1.d0
-  do i = 0,shiftr(n,1)-1
-    prod = prod / (1.d0 + dfloat(m+1)/dfloat(n-i-i-1))
-  enddo
-  V_theta = (prod+prod) * Wallis(m)
-end
-
-
-double precision function Wallis(n)
-  implicit none
-  BEGIN_DOC
-  ! Wallis integral:
-  !
-  ! $\int_{0}^{\pi} \cos(\theta)^n d\theta$.
-  END_DOC
-  double precision               :: fact
-  integer                        :: n,p
-  include 'utils/constants.include.F'
-  if(iand(n,1).eq.0)then
-    Wallis = fact(shiftr(n,1))
-    Wallis = pi * fact(n) / (dble(ibset(0_8,n)) * (Wallis+Wallis)*Wallis)
-  else
-    p = shiftr(n,1)
-    Wallis = fact(p)
-    Wallis = dble(ibset(0_8,p+p)) * Wallis*Wallis / fact(p+p+1)
-  endif
-
-end
-
-

src/ao_two_e_ints/EZFIO.cfg

@@ -4,13 +4,6 @@ doc: Read/Write |AO| integrals from/to disk [ Write | Read | None ]
 interface: ezfio,provider,ocaml
 default: None
 
-[ao_integrals_threshold]
-type: Threshold
-doc: If | (pq|rs) | < `ao_integrals_threshold` then (pq|rs) is zero
-interface: ezfio,provider,ocaml
-default: 1.e-15
-ezfio_name: threshold_ao
-
 [do_direct_integrals]
 type: logical
 doc: Compute integrals on the fly (very slow, only for debugging)
@@ -22,4 +15,4 @@ ezfio_name: direct
 type: logical
 doc: Perform Cholesky decomposition of AO integrals
 interface: ezfio,provider,ocaml
-default: True
+default: False

src/ao_two_e_ints/two_e_integrals.irp.f

@@ -1,23 +1,42 @@
-double precision function ao_two_e_integral(i,j,k,l)
+
-  implicit none
+! ---
+
+double precision function ao_two_e_integral(i, j, k, l)
+
   BEGIN_DOC
   !  integral of the AO basis <ik|jl> or (ij|kl)
   !     i(r1) j(r1) 1/r12 k(r2) l(r2)
   END_DOC
 
-  integer,intent(in)             :: i,j,k,l
+  implicit none
-  integer                        :: p,q,r,s
-  double precision               :: I_center(3),J_center(3),K_center(3),L_center(3)
-  integer                        :: num_i,num_j,num_k,num_l,dim1,I_power(3),J_power(3),K_power(3),L_power(3)
-  double precision               :: integral
   include 'utils/constants.include.F'
+
+  integer, intent(in)            :: i, j, k, l
+
+  integer                        :: p, q, r, s
+  integer                        :: num_i,num_j,num_k,num_l,dim1,I_power(3),J_power(3),K_power(3),L_power(3)
+  integer                        :: iorder_p(3), iorder_q(3)
+  double precision               :: I_center(3), J_center(3), K_center(3), L_center(3)
+  double precision               :: integral
   double precision               :: P_new(0:max_dim,3),P_center(3),fact_p,pp
   double precision               :: Q_new(0:max_dim,3),Q_center(3),fact_q,qq
-  integer                        :: iorder_p(3), iorder_q(3)
+
   double precision               :: ao_two_e_integral_schwartz_accel
 
+  double precision               :: ao_two_e_integral_cosgtos
+
+
+  if(use_cosgtos) then
+    !print *, ' use_cosgtos for ao_two_e_integral ?', use_cosgtos
+
+    ao_two_e_integral = ao_two_e_integral_cosgtos(i, j, k, l)
+
+  else
+
     if (ao_prim_num(i) * ao_prim_num(j) * ao_prim_num(k) * ao_prim_num(l) > 1024 ) then
+
        ao_two_e_integral = ao_two_e_integral_schwartz_accel(i,j,k,l)
+
     else
 
       dim1 = n_pt_max_integrals
@@ -102,8 +121,12 @@ double precision function ao_two_e_integral(i,j,k,l)
 
     endif
 
+  endif
+
 end
 
+! ---
+
 double precision function ao_two_e_integral_schwartz_accel(i,j,k,l)
   implicit none
   BEGIN_DOC
@@ -421,13 +444,16 @@ BEGIN_PROVIDER [ logical, ao_two_e_integrals_in_map ]
 
 END_PROVIDER
 
-BEGIN_PROVIDER [ double precision, ao_two_e_integral_schwartz,(ao_num,ao_num)  ]
+! ---
-  implicit none
+
+BEGIN_PROVIDER [ double precision, ao_two_e_integral_schwartz, (ao_num, ao_num) ]
+
   BEGIN_DOC
   !  Needed to compute Schwartz inequalities
   END_DOC
 
-  integer                        :: i,k
+  implicit none
+  integer          :: i, k
   double precision :: ao_two_e_integral,cpu_1,cpu_2, wall_1, wall_2
 
   ao_two_e_integral_schwartz(1,1) = ao_two_e_integral(1,1,1,1)
@@ -445,6 +471,7 @@ BEGIN_PROVIDER [ double precision, ao_two_e_integral_schwartz,(ao_num,ao_num)  ]
 
 END_PROVIDER
 
+! ---
 
 double precision function general_primitive_integral(dim,            &
       P_new,P_center,fact_p,p,p_inv,iorder_p,                        &

src/becke_numerical_grid/EZFIO.cfg

@@ -64,3 +64,15 @@ doc: Number of angular extra_grid points given from input. Warning, this number
 interface: ezfio,provider,ocaml
 default: 1202
 
+[rad_grid_type]
+type: character*(32)
+doc: method used to sample the radial space. Possible choices are [KNOWLES | GILL]
+interface: ezfio,provider,ocaml
+default: KNOWLES
+
+[extra_rad_grid_type]
+type: character*(32)
+doc: method used to sample the radial space. Possible choices are [KNOWLES | GILL]
+interface: ezfio,provider,ocaml
+default: KNOWLES
+

src/becke_numerical_grid/extra_grid.irp.f

@@ -1,7 +1,9 @@
 
+! ---
+
  BEGIN_PROVIDER [integer, n_points_extra_radial_grid]
 &BEGIN_PROVIDER [integer, n_points_extra_integration_angular]
- implicit none
+
   BEGIN_DOC
   ! n_points_extra_radial_grid = number of radial grid points_extra per atom
   !
@@ -9,7 +11,10 @@
   !
   ! These numbers are automatically set by setting the grid_type_sgn parameter
   END_DOC
-if(.not.my_extra_grid_becke)then
+ 
+  implicit none
+
+  if(.not.my_extra_grid_becke)then
     select case (extra_grid_type_sgn)
       case(0)
         n_points_extra_radial_grid = 23
@@ -27,70 +32,118 @@ if(.not.my_extra_grid_becke)then
         write(*,*) '!!! Quadrature grid not available !!!'
         stop
     end select
-else
+  else
     n_points_extra_radial_grid = my_n_pt_r_extra_grid
     n_points_extra_integration_angular = my_n_pt_a_extra_grid
-endif
+  endif
+
 END_PROVIDER
 
+! ---
+
 BEGIN_PROVIDER [integer, n_points_extra_grid_per_atom]
-  implicit none
+
   BEGIN_DOC
   ! Number of grid points_extra per atom
   END_DOC
+
+  implicit none
   n_points_extra_grid_per_atom = n_points_extra_integration_angular * n_points_extra_radial_grid
 
 END_PROVIDER
 
+! ---
+
  BEGIN_PROVIDER [double precision, grid_points_extra_radial, (n_points_extra_radial_grid)]
 &BEGIN_PROVIDER [double precision, dr_radial_extra_integral]
 
-  implicit none
   BEGIN_DOC
   ! points_extra in [0,1] to map the radial integral [0,\infty]
   END_DOC
-  dr_radial_extra_integral = 1.d0/dble(n_points_extra_radial_grid-1)
+
+  implicit none
   integer :: i
+
+  dr_radial_extra_integral = 1.d0/dble(n_points_extra_radial_grid-1)
   do i = 1, n_points_extra_radial_grid
     grid_points_extra_radial(i) = dble(i-1) * dr_radial_extra_integral
   enddo
 
 END_PROVIDER
 
+! ---
+
 BEGIN_PROVIDER [double precision, grid_points_extra_per_atom, (3,n_points_extra_integration_angular,n_points_extra_radial_grid,nucl_num)]
+
   BEGIN_DOC
   ! x,y,z coordinates of grid points_extra used for integration in 3d space
   END_DOC
+
   implicit none
-  integer                        :: i,j,k
+  integer                    :: i, j, k
-  double precision               :: dr,x_ref,y_ref,z_ref
+  double precision           :: dr, x_ref, y_ref, z_ref
-  double precision               :: knowles_function
+  double precision           :: x, r, tmp
+  double precision, external :: knowles_function
+
+  grid_points_extra_per_atom = 0.d0
+
+  PROVIDE extra_rad_grid_type
+  if(extra_rad_grid_type .eq. "KNOWLES") then
+
     do i = 1, nucl_num
       x_ref = nucl_coord(i,1)
       y_ref = nucl_coord(i,2)
       z_ref = nucl_coord(i,3)
       do j = 1, n_points_extra_radial_grid-1
-      double precision               :: x,r
+
         ! x value for the mapping of the [0, +\infty] to [0,1]
         x = grid_points_extra_radial(j)
-
         ! value of the radial coordinate for the integration
-      r = knowles_function(alpha_knowles(grid_atomic_number(i)),m_knowles,x)
+        r = knowles_function(alpha_knowles(grid_atomic_number(i)), m_knowles, x)
 
         ! explicit values of the grid points_extra centered around each atom
         do k = 1, n_points_extra_integration_angular
-        grid_points_extra_per_atom(1,k,j,i) =                              &
+          grid_points_extra_per_atom(1,k,j,i) = x_ref + angular_quadrature_points_extra(k,1) * r
-            x_ref + angular_quadrature_points_extra(k,1) * r
+          grid_points_extra_per_atom(2,k,j,i) = y_ref + angular_quadrature_points_extra(k,2) * r
-        grid_points_extra_per_atom(2,k,j,i) =                              &
+          grid_points_extra_per_atom(3,k,j,i) = z_ref + angular_quadrature_points_extra(k,3) * r
-            y_ref + angular_quadrature_points_extra(k,2) * r
-        grid_points_extra_per_atom(3,k,j,i) =                              &
-            z_ref + angular_quadrature_points_extra(k,3) * r
         enddo
       enddo
     enddo
+
+  elseif(extra_rad_grid_type .eq. "GILL") then
+    ! GILL & CHIEN, 2002
+
+    do i = 1, nucl_num
+      x_ref = nucl_coord(i,1)
+      y_ref = nucl_coord(i,2)
+      z_ref = nucl_coord(i,3)
+      do j = 1, n_points_extra_radial_grid-1
+
+        r = R_gill * dble(j-1)**2 / dble(n_points_extra_radial_grid-j+1)**2
+
+        ! explicit values of the grid points_extra centered around each atom
+        do k = 1, n_points_extra_integration_angular
+          grid_points_extra_per_atom(1,k,j,i) = x_ref + angular_quadrature_points_extra(k,1) * r
+          grid_points_extra_per_atom(2,k,j,i) = y_ref + angular_quadrature_points_extra(k,2) * r
+          grid_points_extra_per_atom(3,k,j,i) = z_ref + angular_quadrature_points_extra(k,3) * r
+        enddo
+      enddo
+    enddo
+
+  else
+
+    print*, " extra_rad_grid_type = ", extra_rad_grid_type, ' is not implemented'
+    stop
+
+  endif
+
+
 END_PROVIDER
 
+! ---
+
 BEGIN_PROVIDER [double precision, weight_at_r_extra, (n_points_extra_integration_angular,n_points_extra_radial_grid,nucl_num) ]
+
   BEGIN_DOC
   ! Weight function at grid points_extra : w_n(r) according to the equation (22)
   ! of Becke original paper (JCP, 88, 1988)
@@ -99,11 +152,14 @@ BEGIN_PROVIDER [double precision, weight_at_r_extra, (n_points_extra_integration
   ! represented by the last dimension and the points_extra are labelled by the
   ! other dimensions.
   END_DOC
+
   implicit none
-  integer                        :: i,j,k,l,m
+  integer                    :: i, j, k, l, m
   double precision           :: r(3)
-  double precision               :: accu,cell_function_becke
+  double precision           :: accu
   double precision           :: tmp_array(nucl_num)
+  double precision, external :: cell_function_becke
+
   ! run over all points_extra in space
   ! that are referred to each atom
   do j = 1, nucl_num
@@ -114,6 +170,7 @@ BEGIN_PROVIDER [double precision, weight_at_r_extra, (n_points_extra_integration
         r(1) = grid_points_extra_per_atom(1,l,k,j)
         r(2) = grid_points_extra_per_atom(2,l,k,j)
         r(3) = grid_points_extra_per_atom(3,l,k,j)
+
         accu = 0.d0
         ! For each of these points_extra in space, ou need to evaluate the P_n(r)
         do i = 1, nucl_num
@@ -124,6 +181,7 @@ BEGIN_PROVIDER [double precision, weight_at_r_extra, (n_points_extra_integration
         enddo
         accu = 1.d0/accu
         weight_at_r_extra(l,k,j) = tmp_array(j) * accu
+
         if(isnan(weight_at_r_extra(l,k,j)))then
           print*,'isnan(weight_at_r_extra(l,k,j))'
           print*,l,k,j
@@ -144,25 +202,32 @@ BEGIN_PROVIDER [double precision, weight_at_r_extra, (n_points_extra_integration
 
 END_PROVIDER
 
+! ---
+
 
 BEGIN_PROVIDER [double precision, final_weight_at_r_extra, (n_points_extra_integration_angular,n_points_extra_radial_grid,nucl_num) ]
+
   BEGIN_DOC
    ! Total weight on each grid point which takes into account all Lebedev, Voronoi and radial weights.
   END_DOC
+
   implicit none
-  integer                        :: i,j,k,l,m
+  integer                    :: i, j, k, l, m
   double precision           :: r(3)
-  double precision               :: accu,cell_function_becke
   double precision           :: tmp_array(nucl_num)
-  double precision               :: contrib_integration,x
+  double precision           :: contrib_integration, x, tmp
-  double precision               :: derivative_knowles_function,knowles_function
+  double precision, external :: derivative_knowles_function, knowles_function
+
+  PROVIDE extra_rad_grid_type
+  if(extra_rad_grid_type .eq. "KNOWLES") then
+
     ! run over all points_extra in space
     do j = 1, nucl_num  ! that are referred to each atom
       do i = 1, n_points_extra_radial_grid -1 !for each radial grid attached to the "jth" atom
         x = grid_points_extra_radial(i) ! x value for the mapping of the [0, +\infty] to [0,1]
         do k = 1, n_points_extra_integration_angular  ! for each angular point attached to the "jth" atom
           contrib_integration = derivative_knowles_function(alpha_knowles(grid_atomic_number(j)),m_knowles,x)&
-            *knowles_function(alpha_knowles(grid_atomic_number(j)),m_knowles,x)**2
+                              * knowles_function(alpha_knowles(grid_atomic_number(j)),m_knowles,x)**2
           final_weight_at_r_extra(k,i,j) = weights_angular_points_extra(k) * weight_at_r_extra(k,i,j) * contrib_integration * dr_radial_extra_integral
           if(isnan(final_weight_at_r_extra(k,i,j)))then
             print*,'isnan(final_weight_at_r_extra(k,i,j))' 
@@ -174,5 +239,36 @@ BEGIN_PROVIDER [double precision, final_weight_at_r_extra, (n_points_extra_integ
       enddo
     enddo
 
+  elseif(extra_rad_grid_type .eq. "GILL") then
+    ! GILL & CHIEN, 2002
+
+    PROVIDE R_gill
+    tmp = 2.d0 * R_gill * R_gill * R_gill * dble(n_points_extra_radial_grid)
+
+    ! run over all points_extra in space
+    do j = 1, nucl_num  ! that are referred to each atom
+      do i = 1, n_points_extra_radial_grid -1 !for each radial grid attached to the "jth" atom
+        contrib_integration = tmp * dble(i-1)**5 / dble(n_points_extra_radial_grid-i+1)**7
+
+        do k = 1, n_points_extra_integration_angular  ! for each angular point attached to the "jth" atom
+          final_weight_at_r_extra(k,i,j) = weights_angular_points_extra(k) * weight_at_r_extra(k,i,j) * contrib_integration
+          if(isnan(final_weight_at_r_extra(k,i,j)))then
+            print*,'isnan(final_weight_at_r_extra(k,i,j))' 
+            print*,k,i,j
+            write(*,'(100(F16.10,X))') weights_angular_points_extra(k), weight_at_r_extra(k,i,j), contrib_integration
+            stop 
+          endif
+        enddo
+      enddo
+    enddo
+
+  else
+
+    print*, " extra_rad_grid_type = ", extra_rad_grid_type, ' is not implemented'
+    stop
+
+  endif
+
+
 END_PROVIDER
 

src/becke_numerical_grid/extra_grid_vector.irp.f

@@ -1,26 +1,35 @@
 
+! ---
+
 BEGIN_PROVIDER [integer, n_points_extra_final_grid]
-  implicit none
+
   BEGIN_DOC
   ! Number of points_extra which are non zero
   END_DOC
-  integer                        :: i,j,k,l
+
+  implicit none
+  integer :: i, j, k, l
+
   n_points_extra_final_grid = 0
+
   do j = 1, nucl_num
     do i = 1, n_points_extra_radial_grid -1
       do k = 1, n_points_extra_integration_angular
-        if(dabs(final_weight_at_r_extra(k,i,j)) < thresh_extra_grid)then
+        if(dabs(final_weight_at_r_extra(k,i,j)) < thresh_extra_grid) then
           cycle
         endif
         n_points_extra_final_grid += 1
       enddo
     enddo
   enddo
+
   print*,'n_points_extra_final_grid = ',n_points_extra_final_grid
   print*,'n max point         = ',n_points_extra_integration_angular*(n_points_extra_radial_grid*nucl_num - 1)
 !  call ezfio_set_becke_numerical_grid_n_points_extra_final_grid(n_points_extra_final_grid)
 END_PROVIDER
 
+! ---
+
  BEGIN_PROVIDER [double precision, final_grid_points_extra, (3,n_points_extra_final_grid)]
 &BEGIN_PROVIDER [double precision, final_weight_at_r_vector_extra, (n_points_extra_final_grid) ]
 &BEGIN_PROVIDER [integer, index_final_points_extra, (3,n_points_extra_final_grid) ]

src/becke_numerical_grid/grid_becke.irp.f

@@ -1,6 +1,9 @@
+
+! ---
+
  BEGIN_PROVIDER [integer, n_points_radial_grid]
 &BEGIN_PROVIDER [integer, n_points_integration_angular]
- implicit none
+
   BEGIN_DOC
   ! n_points_radial_grid = number of radial grid points per atom
   !
@@ -8,7 +11,10 @@
   !
   ! These numbers are automatically set by setting the grid_type_sgn parameter
   END_DOC
-if(.not.my_grid_becke)then
+ 
+  implicit none
+
+  if(.not.my_grid_becke)then
     select case (grid_type_sgn)
       case(0)
         n_points_radial_grid = 23
@@ -26,78 +32,143 @@ if(.not.my_grid_becke)then
         write(*,*) '!!! Quadrature grid not available !!!'
         stop
     end select
-else
+  else
     n_points_radial_grid         = my_n_pt_r_grid
     n_points_integration_angular = my_n_pt_a_grid
-endif
+  endif
+
 END_PROVIDER
 
+! ---
+
 BEGIN_PROVIDER [integer, n_points_grid_per_atom]
-  implicit none
+
   BEGIN_DOC
   ! Number of grid points per atom
   END_DOC
+
+  implicit none
+
   n_points_grid_per_atom = n_points_integration_angular * n_points_radial_grid
 
 END_PROVIDER
 
-BEGIN_PROVIDER [integer , m_knowles]
+! ---
-  implicit none
+
+BEGIN_PROVIDER [integer, m_knowles]
+
   BEGIN_DOC
   ! value of the "m" parameter in the equation (7) of the paper of Knowles (JCP, 104, 1996)
   END_DOC
+
+  implicit none
+
   m_knowles = 3
+
 END_PROVIDER
 
+! ---
+
+BEGIN_PROVIDER [double precision, R_gill]
+
+  implicit none
+
+  R_gill = 3.d0
+
+END_PROVIDER
+
+! ---
+
  BEGIN_PROVIDER [double precision, grid_points_radial, (n_points_radial_grid)]
 &BEGIN_PROVIDER [double precision, dr_radial_integral]
 
-  implicit none
   BEGIN_DOC
   ! points in [0,1] to map the radial integral [0,\infty]
   END_DOC
-  dr_radial_integral = 1.d0/dble(n_points_radial_grid-1)
+
+  implicit none
   integer :: i
+
+  dr_radial_integral = 1.d0 / dble(n_points_radial_grid-1)
+
   do i = 1, n_points_radial_grid
     grid_points_radial(i) = dble(i-1) * dr_radial_integral
   enddo
 
 END_PROVIDER
 
+! ---
+
 BEGIN_PROVIDER [double precision, grid_points_per_atom, (3,n_points_integration_angular,n_points_radial_grid,nucl_num)]
+
   BEGIN_DOC
   ! x,y,z coordinates of grid points used for integration in 3d space
   END_DOC
+
   implicit none
-  integer                        :: i,j,k
+  integer                    :: i, j, k
-  double precision               :: dr,x_ref,y_ref,z_ref
+  double precision           :: dr, x_ref, y_ref, z_ref
-  double precision               :: knowles_function
+  double precision           :: x, r, tmp
+  double precision, external :: knowles_function
+
+  grid_points_per_atom = 0.d0
+
+  PROVIDE rad_grid_type
+  if(rad_grid_type .eq. "KNOWLES") then
+
     do i = 1, nucl_num
       x_ref = nucl_coord(i,1)
       y_ref = nucl_coord(i,2)
       z_ref = nucl_coord(i,3)
       do j = 1, n_points_radial_grid-1
-      double precision               :: x,r
+
         ! x value for the mapping of the [0, +\infty] to [0,1]
         x = grid_points_radial(j)
-
         ! value of the radial coordinate for the integration
-      r = knowles_function(alpha_knowles(grid_atomic_number(i)),m_knowles,x)
+        r = knowles_function(alpha_knowles(grid_atomic_number(i)), m_knowles, x)
 
         ! explicit values of the grid points centered around each atom
         do k = 1, n_points_integration_angular
-        grid_points_per_atom(1,k,j,i) =                              &
+          grid_points_per_atom(1,k,j,i) = x_ref + angular_quadrature_points(k,1) * r
-            x_ref + angular_quadrature_points(k,1) * r
+          grid_points_per_atom(2,k,j,i) = y_ref + angular_quadrature_points(k,2) * r
-        grid_points_per_atom(2,k,j,i) =                              &
+          grid_points_per_atom(3,k,j,i) = z_ref + angular_quadrature_points(k,3) * r
-            y_ref + angular_quadrature_points(k,2) * r
-        grid_points_per_atom(3,k,j,i) =                              &
-            z_ref + angular_quadrature_points(k,3) * r
         enddo
       enddo
     enddo
+
+  elseif(rad_grid_type .eq. "GILL") then
+    ! GILL & CHIEN, 2002
+
+    do i = 1, nucl_num
+      x_ref = nucl_coord(i,1)
+      y_ref = nucl_coord(i,2)
+      z_ref = nucl_coord(i,3)
+      do j = 1, n_points_radial_grid-1
+
+        r = R_gill * dble(j-1)**2 / dble(n_points_radial_grid-j+1)**2 
+
+        ! explicit values of the grid points centered around each atom
+        do k = 1, n_points_integration_angular
+          grid_points_per_atom(1,k,j,i) = x_ref + angular_quadrature_points(k,1) * r
+          grid_points_per_atom(2,k,j,i) = y_ref + angular_quadrature_points(k,2) * r
+          grid_points_per_atom(3,k,j,i) = z_ref + angular_quadrature_points(k,3) * r
+        enddo
+      enddo
+    enddo
+ 
+  else
+
+    print*, " rad_grid_type = ", rad_grid_type, ' is not implemented'
+    stop
+
+  endif
+
 END_PROVIDER
 
-BEGIN_PROVIDER [double precision, weight_at_r, (n_points_integration_angular,n_points_radial_grid,nucl_num) ]
+! ---
+
+BEGIN_PROVIDER [double precision, weight_at_r, (n_points_integration_angular,n_points_radial_grid,nucl_num)]
+
   BEGIN_DOC
   ! Weight function at grid points : w_n(r) according to the equation (22)
   ! of Becke original paper (JCP, 88, 1988)
@@ -106,11 +177,13 @@ BEGIN_PROVIDER [double precision, weight_at_r, (n_points_integration_angular,n_p
   ! represented by the last dimension and the points are labelled by the
   ! other dimensions.
   END_DOC
+
   implicit none
-  integer                        :: i,j,k,l,m
+  integer                    :: i, j, k, l, m
-  double precision               :: r(3)
+  double precision           :: r(3), accu
-  double precision               :: accu,cell_function_becke
   double precision           :: tmp_array(nucl_num)
+  double precision, external :: cell_function_becke
+
   ! run over all points in space
   ! that are referred to each atom
   do j = 1, nucl_num
@@ -121,17 +194,19 @@ BEGIN_PROVIDER [double precision, weight_at_r, (n_points_integration_angular,n_p
         r(1) = grid_points_per_atom(1,l,k,j)
         r(2) = grid_points_per_atom(2,l,k,j)
         r(3) = grid_points_per_atom(3,l,k,j)
+
         accu = 0.d0
         ! For each of these points in space, ou need to evaluate the P_n(r)
         do i = 1, nucl_num
           ! function defined for each atom "i" by equation (13) and (21) with k == 3
-          tmp_array(i) = cell_function_becke(r,i) ! P_n(r)
+          tmp_array(i) = cell_function_becke(r, i) ! P_n(r)
           ! Then you compute the summ the P_n(r) function for each of the "r" points
           accu += tmp_array(i)
         enddo
         accu = 1.d0/accu
         weight_at_r(l,k,j) = tmp_array(j) * accu
-        if(isnan(weight_at_r(l,k,j)))then
+
+        if(isnan(weight_at_r(l,k,j))) then
           print*,'isnan(weight_at_r(l,k,j))'
           print*,l,k,j
           accu = 0.d0
@@ -151,35 +226,76 @@ BEGIN_PROVIDER [double precision, weight_at_r, (n_points_integration_angular,n_p
 
 END_PROVIDER
 
+! ---
+
+BEGIN_PROVIDER [double precision, final_weight_at_r, (n_points_integration_angular,n_points_radial_grid,nucl_num)]
 
-BEGIN_PROVIDER [double precision, final_weight_at_r, (n_points_integration_angular,n_points_radial_grid,nucl_num) ]
   BEGIN_DOC
   ! Total weight on each grid point which takes into account all Lebedev, Voronoi and radial weights.
   END_DOC
+
   implicit none
-  integer                        :: i,j,k,l,m
+  integer                    :: i, j, k, l, m
   double precision           :: r(3)
-  double precision               :: accu,cell_function_becke
   double precision           :: tmp_array(nucl_num)
-  double precision               :: contrib_integration,x
+  double precision           :: contrib_integration, x, tmp
-  double precision               :: derivative_knowles_function,knowles_function
+  double precision, external :: derivative_knowles_function, knowles_function
+
+  final_weight_at_r = 0.d0
+
+  PROVIDE rad_grid_type
+  if(rad_grid_type .eq. "KNOWLES") then
+
     ! run over all points in space
     do j = 1, nucl_num  ! that are referred to each atom
       do i = 1, n_points_radial_grid -1 !for each radial grid attached to the "jth" atom
         x = grid_points_radial(i) ! x value for the mapping of the [0, +\infty] to [0,1]
+
         do k = 1, n_points_integration_angular  ! for each angular point attached to the "jth" atom
-        contrib_integration = derivative_knowles_function(alpha_knowles(grid_atomic_number(j)),m_knowles,x)&
+          contrib_integration = derivative_knowles_function(alpha_knowles(grid_atomic_number(j)), m_knowles, x) &
-            *knowles_function(alpha_knowles(grid_atomic_number(j)),m_knowles,x)**2
+                              * knowles_function(alpha_knowles(grid_atomic_number(j)), m_knowles, x)**2
+
           final_weight_at_r(k,i,j) = weights_angular_points(k)  * weight_at_r(k,i,j) * contrib_integration * dr_radial_integral
-        if(isnan(final_weight_at_r(k,i,j)))then
+
+          if(isnan(final_weight_at_r(k,i,j))) then
            print*,'isnan(final_weight_at_r(k,i,j))' 
            print*,k,i,j
-         write(*,'(100(F16.10,X))')weights_angular_points(k)  , weight_at_r(k,i,j) , contrib_integration , dr_radial_integral
+           write(*,'(100(F16.10,X))') weights_angular_points(k), weight_at_r(k,i,j), contrib_integration
            stop 
           endif
         enddo
       enddo
     enddo
 
+  elseif(rad_grid_type .eq. "GILL") then
+    ! GILL & CHIEN, 2002
+
+    tmp = 2.d0 * R_gill * R_gill * R_gill * dble(n_points_radial_grid)
+
+    ! run over all points in space
+    do j = 1, nucl_num  ! that are referred to each atom
+      do i = 1, n_points_radial_grid - 1 !for each radial grid attached to the "jth" atom
+        contrib_integration = tmp * dble(i-1)**5 / dble(n_points_radial_grid-i+1)**7
+        do k = 1, n_points_integration_angular  ! for each angular point attached to the "jth" atom
+          final_weight_at_r(k,i,j) = weights_angular_points(k) * weight_at_r(k,i,j) * contrib_integration
+
+          if(isnan(final_weight_at_r(k,i,j))) then
+           print*,'isnan(final_weight_at_r(k,i,j))' 
+           print*,k,i,j
+           write(*,'(100(F16.10,X))') weights_angular_points(k), weight_at_r(k,i,j), contrib_integration, dr_radial_integral
+           stop 
+          endif
+        enddo
+      enddo
+    enddo
+
+  else
+
+    print*, " rad_grid_type = ", rad_grid_type, ' is not implemented'
+    stop
+
+  endif
+
 END_PROVIDER
 
+

src/becke_numerical_grid/grid_becke_vector.irp.f

@@ -21,22 +21,27 @@ BEGIN_PROVIDER [integer, n_points_final_grid]
   call ezfio_set_becke_numerical_grid_n_points_final_grid(n_points_final_grid)
 END_PROVIDER
 
+! ---
+
  BEGIN_PROVIDER [double precision, final_grid_points,      (3,n_points_final_grid)]
-&BEGIN_PROVIDER [double precision, final_weight_at_r_vector, (n_points_final_grid) ]
+&BEGIN_PROVIDER [double precision, final_weight_at_r_vector, (n_points_final_grid)]
-&BEGIN_PROVIDER [integer, index_final_points, (3,n_points_final_grid) ]
+&BEGIN_PROVIDER [integer,          index_final_points,     (3,n_points_final_grid)]
-&BEGIN_PROVIDER [integer, index_final_points_reverse, (n_points_integration_angular,n_points_radial_grid,nucl_num) ]
+&BEGIN_PROVIDER [integer, index_final_points_reverse, (n_points_integration_angular,n_points_radial_grid,nucl_num)]
-  implicit none
+
   BEGIN_DOC
-!  final_grid_points(1:3,j) = (/ x, y, z /) of the jth grid point
+  !  final_grid_points(1:3,j) = (/ x, y, z /) of the jth grid point
-!
+  !
-! final_weight_at_r_vector(i) = Total weight function of the ith grid point which contains the Lebedev, Voronoi and radial weights contributions
+  ! final_weight_at_r_vector(i) = Total weight function of the ith grid point which contains the Lebedev, Voronoi and radial weights contributions
-!
+  !
-! index_final_points(1:3,i) = gives the angular, radial and atomic indices associated to the ith grid point
+  ! index_final_points(1:3,i) = gives the angular, radial and atomic indices associated to the ith grid point
-!
+  !
-! index_final_points_reverse(i,j,k) = index of the grid point having i as angular, j as radial and l as atomic indices
+  ! index_final_points_reverse(i,j,k) = index of the grid point having i as angular, j as radial and l as atomic indices
   END_DOC
-  integer                        :: i,j,k,l,i_count
+
+  implicit none
+  integer          :: i, j, k, l, i_count
   double precision :: r(3)
+
   i_count = 0
   do j = 1, nucl_num
     do i = 1, n_points_radial_grid -1
@@ -59,6 +64,8 @@ END_PROVIDER
 
 END_PROVIDER
 
+! ---
+
 BEGIN_PROVIDER [double precision, final_grid_points_transp, (n_points_final_grid,3)]
   implicit none
   BEGIN_DOC

src/becke_numerical_grid/integration_radial.irp.f

@@ -1,34 +1,53 @@
- double precision function knowles_function(alpha,m,x)
- implicit none
- BEGIN_DOC
-! Function proposed by Knowles (JCP, 104, 1996) for distributing the radial points :
-! the Log "m" function ( equation (7) in the paper )
- END_DOC
- double precision, intent(in) :: alpha,x
- integer, intent(in) :: m
-!print*, x
- knowles_function = -alpha * dlog(1.d0-x**m)
- end
 
- double precision function derivative_knowles_function(alpha,m,x)
+! ---
- implicit none
+
+double precision function knowles_function(alpha, m, x)
+
   BEGIN_DOC
-! Derivative of the function proposed by Knowles (JCP, 104, 1996) for distributing the radial points
+  ! Function proposed by Knowles (JCP, 104, 1996) for distributing the radial points :
+  ! the Log "m" function ( equation (7) in the paper )
   END_DOC
- double precision, intent(in) :: alpha,x
+ 
+  implicit none
+  double precision, intent(in) :: alpha, x
+  integer,          intent(in) :: m
+
+  !print*, x
+  knowles_function = -alpha * dlog(1.d0-x**m)
+
+  return
+end
+
+! ---
+
+double precision function derivative_knowles_function(alpha, m, x)
+
+  BEGIN_DOC
+  ! Derivative of the function proposed by Knowles (JCP, 104, 1996) for distributing the radial points
+  END_DOC
+
+  implicit none
+  double precision, intent(in) :: alpha, x
   integer,          intent(in) :: m
   double precision             :: f
+
   f = x**(m-1)
   derivative_knowles_function = alpha * dble(m) * f / (1.d0 - x*f)
- end
 
- BEGIN_PROVIDER [double precision, alpha_knowles, (100)]
+  return
+end
+
+! ---
+
+BEGIN_PROVIDER [double precision, alpha_knowles, (100)]
+
+  BEGIN_DOC
+  ! Recommended values for the alpha parameters according to the paper of Knowles (JCP, 104, 1996)
+  ! as a function of the nuclear charge
+  END_DOC
+
   implicit none
   integer :: i
- BEGIN_DOC
-! Recommended values for the alpha parameters according to the paper of Knowles (JCP, 104, 1996)
-! as a function of the nuclear charge
- END_DOC
 
   ! H-He
   alpha_knowles(1) = 5.d0
@@ -68,4 +87,7 @@
    alpha_knowles(i) = 7.d0
   enddo
 
- END_PROVIDER
+END_PROVIDER
+
+! ---
+

src/becke_numerical_grid/step_function_becke.irp.f

@@ -20,31 +20,42 @@ double precision function f_function_becke(x)
   f_function_becke = 1.5d0 * x - 0.5d0 * x*x*x
 end
 
-double precision function cell_function_becke(r,atom_number)
+! ---
+
+double precision function cell_function_becke(r, atom_number)
+
+  BEGIN_DOC
+  ! atom_number :: atom on which the cell function of Becke (1988, JCP,88(4))
+  ! r(1:3)                       :: x,y,z coordinantes of the current point
+  END_DOC
+
   implicit none
   double precision, intent(in) :: r(3)
   integer,          intent(in) :: atom_number
-  BEGIN_DOC
-! atom_number :: atom on which the cell function of Becke (1988, JCP,88(4))
-  ! r(1:3)                       :: x,y,z coordinantes of the current point
-  END_DOC
-  double precision               :: mu_ij,nu_ij
-  double precision               :: distance_i,distance_j,step_function_becke
   integer                      :: j
+  double precision             :: mu_ij, nu_ij
+  double precision             :: distance_i, distance_j, step_function_becke
+
   distance_i  = (r(1) - nucl_coord_transp(1,atom_number) ) * (r(1) - nucl_coord_transp(1,atom_number))
   distance_i += (r(2) - nucl_coord_transp(2,atom_number) ) * (r(2) - nucl_coord_transp(2,atom_number))
   distance_i += (r(3) - nucl_coord_transp(3,atom_number) ) * (r(3) - nucl_coord_transp(3,atom_number))
   distance_i  = dsqrt(distance_i)
+
   cell_function_becke = 1.d0
   do j = 1, nucl_num
-    if(j==atom_number)cycle
+    if(j==atom_number) cycle
+
     distance_j  = (r(1) - nucl_coord_transp(1,j) ) * (r(1) - nucl_coord_transp(1,j))
-    distance_j+= (r(2) - nucl_coord_transp(2,j) ) * (r(2) - nucl_coord_transp(2,j))
+    distance_j += (r(2) - nucl_coord_transp(2,j) ) * (r(2) - nucl_coord_transp(2,j))
-    distance_j+= (r(3) - nucl_coord_transp(3,j) ) * (r(3) - nucl_coord_transp(3,j))
+    distance_j += (r(3) - nucl_coord_transp(3,j) ) * (r(3) - nucl_coord_transp(3,j))
     distance_j  = dsqrt(distance_j)
-    mu_ij = (distance_i - distance_j)*nucl_dist_inv(atom_number,j)
+
+    mu_ij = (distance_i - distance_j) * nucl_dist_inv(atom_number,j)
     nu_ij = mu_ij + slater_bragg_type_inter_distance_ua(atom_number,j) * (1.d0 - mu_ij*mu_ij)
+
     cell_function_becke *= step_function_becke(nu_ij)
   enddo
+
+  return
 end
 

src/ccsd/ccsd_t_space_orb.irp.f

@@ -257,7 +257,7 @@ subroutine ccsd_par_t_space_v2(nO,nV,t1,t2,f_o,f_v,v_vvvo,v_vvoo,v_vooo,energy)
             enddo
           enddo
         enddo
-        !$OMP END DO
+        !$OMP END DO NOWAIT
         !$OMP CRITICAL
         energy = energy + e
         !$OMP END CRITICAL
@@ -287,75 +287,175 @@ subroutine form_w_ijk(nO,nV,i,j,k,T_vvoo,T_ovvo,X_vvvo,X_ovoo,W)
   double precision, intent(out) :: W(nV,nV,nV)!,nO,nO,nO)
 
   integer :: l,a,b,c,d
+  double precision, allocatable, dimension(:,:,:) :: X, Y, Z
 
   !W = 0d0
   !do i = 1, nO
   !  do j = 1, nO
   !    do k = 1, nO
 
-  !$OMP PARALLEL &
+  allocate(X(nV,nV,nV))
-  !$OMP SHARED(nO,nV,i,j,k,T_vvoo,T_ovvo,X_vvvo,X_ovoo,W) &
+  allocate(Y(nV,nV,nV))
-  !$OMP PRIVATE(a,b,c,d,l) &
+  allocate(Z(nV,nV,nV))
-  !$OMP DEFAULT(NONE)
+
-  !$OMP DO collapse(2)
+  !$OMP PARALLEL DO
-  do c = 1, nV
   do b = 1, nV
     do a = 1, nV
-        W(a,b,c) = 0d0
-
       do d = 1, nV
-          !W(i,j,k,a,b,c) = W(i,j,k,a,b,c) &
+        Z(d,a,b) = X_vvvo(d,b,a,i)
-          W(a,b,c) = W(a,b,c) &
-          ! chem (bd|ai)
-          ! phys <ba|di>
-          !+ cc_space_v_vvvo(b,a,d,i) * t2(k,j,c,d) &
-          !+ cc_space_v_vvvo(c,a,d,i) * t2(j,k,b,d) & ! bc kj
-          !+ cc_space_v_vvvo(a,c,d,k) * t2(j,i,b,d) & ! prev ac ik
-          !+ cc_space_v_vvvo(b,c,d,k) * t2(i,j,a,d) & ! prev ab ij
-          !+ cc_space_v_vvvo(c,b,d,j) * t2(i,k,a,d) & ! prev bc kj
-          !+ cc_space_v_vvvo(a,b,d,j) * t2(k,i,c,d) ! prev ac ik
-          + X_vvvo(d,b,a,i) * T_vvoo(d,c,k,j) &
-          + X_vvvo(d,c,a,i) * T_vvoo(d,b,j,k) & ! bc kj
-          + X_vvvo(d,a,c,k) * T_vvoo(d,b,j,i) & ! prev ac ik
-          + X_vvvo(d,b,c,k) * T_vvoo(d,a,i,j) & ! prev ab ij
-          + X_vvvo(d,c,b,j) * T_vvoo(d,a,i,k) & ! prev bc kj
-          + X_vvvo(d,a,b,j) * T_vvoo(d,c,k,i) ! prev ac ik
       enddo
+    enddo
+  enddo
+  !$OMP END PARALLEL DO
 
-      enddo
+  call dgemm('T','N',nV*nV,nV,nV, 1.d0, &
-    enddo
+     Z, nV, T_vvoo(1,1,k,j), nV, 0.d0, W, nV*nV)
-  enddo
-  !$OMP END DO nowait
 
-  !$OMP DO collapse(2)
+  !$OMP PARALLEL DO
+  do c = 1, nV
+    do a = 1, nV
+      do d = 1, nV
+        Z(d,a,c) = X_vvvo(d,c,a,i)
+      enddo
+    enddo
+  enddo
+  !$OMP END PARALLEL DO
+
+  call dgemm('T','N',nV*nV,nV,nV, 1.d0, &
+     Z, nV, T_vvoo(1,1,j,k), nV, 0.d0, Y, nV*nV)
+
+  call dgemm('T','N',nV*nV,nV,nV, 1.d0, &
+     X_vvvo(1,1,1,k), nV, T_vvoo(1,1,j,i), nV, 1.d0, Y, nV*nV)
+
+  call dgemm('T','N',nV,nV*nV,nV, 1.d0, &
+     T_vvoo(1,1,i,j), nV, X_vvvo(1,1,1,k), nV, 1.d0, W, nV)
+
+  call dgemm('T','N',nV,nV*nV,nV, 1.d0, &
+     T_vvoo(1,1,i,k), nV, X_vvvo(1,1,1,j), nV, 1.d0, Y, nV)
+
+  call dgemm('T','N',nV*nV,nV,nV, 1.d0, &
+     X_vvvo(1,1,1,j), nV, T_vvoo(1,1,k,i), nV, 1.d0, W, nV*nV)
+
+  deallocate(Z)
+
+
+  allocate(Z(nO,nV,nV))
+
+  call dgemm('T','N',nV*nV,nV,nO, -1.d0, &
+     T_ovvo(1,1,1,i), nO, X_ovoo(1,1,j,k), nO, 1.d0, W, nV*nV)
+
+  call dgemm('T','N',nV*nV,nV,nO, -1.d0, &
+     T_ovvo(1,1,1,i), nO, X_ovoo(1,1,k,j), nO, 1.d0, Y, nV*nV)
+
+  !$OMP PARALLEL DO
+  do c = 1, nV
+    do a = 1, nV
+      do l = 1, nO
+        Z(l,a,c) = T_ovvo(l,c,a,k)
+      enddo
+    enddo
+  enddo
+  !$OMP END PARALLEL DO
+
+  call dgemm('T','N',nV*nV,nV,nO, -1.d0, &
+     Z, nO, X_ovoo(1,1,i,j), nO, 1.d0, Y, nV*nV)
+
+  call dgemm('T','N',nV,nV*nV,nO, -1.d0, &
+     X_ovoo(1,1,j,i), nO, T_ovvo(1,1,1,k), nO, 1.d0, Y, nV)
+
+  call dgemm('T','N',nV,nV*nV,nO, -1.d0, &
+     X_ovoo(1,1,k,i), nO, T_ovvo(1,1,1,j), nO, 1.d0, W, nV)
+
+  !$OMP PARALLEL DO
+  do b = 1, nV
+    do a = 1, nV
+      do l = 1, nO
+        Z(l,a,b) = T_ovvo(l,b,a,j)
+      enddo
+    enddo
+  enddo
+  !$OMP END PARALLEL DO
+
+  call dgemm('T','N',nV*nV,nV,nO, -1.d0, &
+     Z, nO, X_ovoo(1,1,i,k), nO, 1.d0, W, nV*nV)
+
+  !$OMP PARALLEL DO
   do c = 1, nV
     do b = 1, nV
       do a = 1, nV
+        W(a,b,c) = W(a,b,c) + Y(a,c,b)
+      enddo
+    enddo
+  enddo
+  !$OMP END PARALLEL DO
 
-        do l = 1, nO
+  deallocate(X,Y,Z)
-          !W(i,j,k,a,b,c) = W(i,j,k,a,b,c) &
-          W(a,b,c) = W(a,b,c) &
-          ! chem (ck|jl)
-          ! phys <cj|kl>
-          !- cc_space_v_vooo(c,j,k,l) * t2(i,l,a,b) &
-          !- cc_space_v_vooo(b,k,j,l) * t2(i,l,a,c) & ! bc kj
-          !- cc_space_v_vooo(b,i,j,l) * t2(k,l,c,a) & ! prev ac ik
-          !- cc_space_v_vooo(a,j,i,l) * t2(k,l,c,b) & ! prev ab ij
-          !- cc_space_v_vooo(a,k,i,l) * t2(j,l,b,c) & ! prev bc kj
-          !- cc_space_v_vooo(c,i,k,l) * t2(j,l,b,a) ! prev ac ik
-          - X_ovoo(l,c,j,k) * T_ovvo(l,a,b,i) &
-          - X_ovoo(l,b,k,j) * T_ovvo(l,a,c,i) & ! bc kj
-          - X_ovoo(l,b,i,j) * T_ovvo(l,c,a,k) & ! prev ac ik
-          - X_ovoo(l,a,j,i) * T_ovvo(l,c,b,k) & ! prev ab ij
-          - X_ovoo(l,a,k,i) * T_ovvo(l,b,c,j) & ! prev bc kj
-          - X_ovoo(l,c,i,k) * T_ovvo(l,b,a,j) ! prev ac ik
-        enddo
 
-      enddo
+
-    enddo
+!  !$OMP PARALLEL &
-  enddo
+!  !$OMP SHARED(nO,nV,i,j,k,T_vvoo,T_ovvo,X_vvvo,X_ovoo,W) &
-  !$OMP END DO
+!  !$OMP PRIVATE(a,b,c,d,l) &
-  !$OMP END PARALLEL
+!  !$OMP DEFAULT(NONE)
+!
+!  !$OMP DO collapse(2)
+!  do c = 1, nV
+!    do b = 1, nV
+!      do a = 1, nV
+!        W(a,b,c) = 0.d0
+!
+!        do d = 1, nV
+!          !W(i,j,k,a,b,c) = W(i,j,k,a,b,c) &
+!          W(a,b,c) = W(a,b,c) &
+!          ! chem (bd|ai)
+!          ! phys <ba|di>
+!          !+ cc_space_v_vvvo(b,a,d,i) * t2(k,j,c,d) &
+!          !+ cc_space_v_vvvo(c,a,d,i) * t2(j,k,b,d) & ! bc kj
+!          !+ cc_space_v_vvvo(a,c,d,k) * t2(j,i,b,d) & ! prev ac ik
+!          !+ cc_space_v_vvvo(b,c,d,k) * t2(i,j,a,d) & ! prev ab ij
+!          !+ cc_space_v_vvvo(c,b,d,j) * t2(i,k,a,d) & ! prev bc kj
+!          !+ cc_space_v_vvvo(a,b,d,j) * t2(k,i,c,d) ! prev ac ik
+!         + X_vvvo(d,b,a,i) * T_vvoo(d,c,k,j) &
+!         + X_vvvo(d,c,a,i) * T_vvoo(d,b,j,k) & ! bc kj
+!         + X_vvvo(d,a,c,k) * T_vvoo(d,b,j,i) & ! prev ac ik
+!          + X_vvvo(d,b,c,k) * T_vvoo(d,a,i,j) & ! prev ab ij
+!          + X_vvvo(d,c,b,j) * T_vvoo(d,a,i,k) & ! prev bc kj
+!          + X_vvvo(d,a,b,j) * T_vvoo(d,c,k,i) ! prev ac ik
+!        enddo
+!
+!      enddo
+!    enddo
+!  enddo
+!  !$OMP END DO nowait
+!
+!  !$OMP DO collapse(2)
+!  do c = 1, nV
+!    do b = 1, nV
+!      do a = 1, nV
+!
+!        do l = 1, nO
+!          !W(i,j,k,a,b,c) = W(i,j,k,a,b,c) &
+!          W(a,b,c) = W(a,b,c) &
+!          ! chem (ck|jl)
+!          ! phys <cj|kl>
+!          !- cc_space_v_vooo(c,j,k,l) * t2(i,l,a,b) &
+!          !- cc_space_v_vooo(b,k,j,l) * t2(i,l,a,c) & ! bc kj
+!          !- cc_space_v_vooo(b,i,j,l) * t2(k,l,c,a) & ! prev ac ik
+!          !- cc_space_v_vooo(a,j,i,l) * t2(k,l,c,b) & ! prev ab ij
+!          !- cc_space_v_vooo(a,k,i,l) * t2(j,l,b,c) & ! prev bc kj
+!          !- cc_space_v_vooo(c,i,k,l) * t2(j,l,b,a) ! prev ac ik
+!          - T_ovvo(l,a,b,i) * X_ovoo(l,c,j,k) &
+!          - T_ovvo(l,a,c,i) * X_ovoo(l,b,k,j) & ! bc kj
+!          - T_ovvo(l,c,a,k) * X_ovoo(l,b,i,j) & ! prev ac ik
+!          - T_ovvo(l,c,b,k) * X_ovoo(l,a,j,i) & ! prev ab ij
+!          - T_ovvo(l,b,c,j) * X_ovoo(l,a,k,i) & ! prev bc kj
+!          - T_ovvo(l,b,a,j) * X_ovoo(l,c,i,k) ! prev ac ik
+!        enddo
+!
+!      enddo
+!    enddo
+!  enddo
+!  !$OMP END DO
+!  !$OMP END PARALLEL
 
   !    enddo
   !  enddo
@@ -410,3 +510,4 @@ implicit none
   !enddo
 
 end
+

src/ccsd/ccsd_t_space_orb_abc.irp.f

@@ -0,0 +1,252 @@
+! Main
+
+subroutine ccsd_par_t_space_v3(nO,nV,t1,t2,f_o,f_v,v_vvvo,v_vvoo,v_vooo,energy)
+
+  implicit none
+
+  integer, intent(in)           :: nO,nV
+  double precision, intent(in)  :: t1(nO,nV), f_o(nO), f_v(nV)
+  double precision, intent(in)  :: t2(nO,nO,nV,nV)
+  double precision, intent(in)  :: v_vvvo(nV,nV,nV,nO), v_vvoo(nV,nV,nO,nO), v_vooo(nV,nO,nO,nO)
+  double precision, intent(out) :: energy
+
+  double precision, allocatable :: W(:,:,:,:,:,:)
+  double precision, allocatable :: V(:,:,:,:,:,:)
+  double precision, allocatable :: W_abc(:,:,:), V_abc(:,:,:)
+  double precision, allocatable :: W_cab(:,:,:), W_cba(:,:,:)
+  double precision, allocatable :: W_bca(:,:,:), V_cba(:,:,:)
+  double precision, allocatable :: X_vvvo(:,:,:,:), X_ovoo(:,:,:,:), X_vvoo(:,:,:,:)
+  double precision, allocatable :: T_vvoo(:,:,:,:), T_ovvo(:,:,:,:), T_vo(:,:)
+  integer                       :: i,j,k,l,a,b,c,d
+  double precision              :: e,ta,tb, delta, delta_abc
+
+  !allocate(W(nV,nV,nV,nO,nO,nO))
+  !allocate(V(nV,nV,nV,nO,nO,nO))
+  allocate(W_abc(nO,nO,nO), V_abc(nO,nO,nO), W_cab(nO,nO,nO))
+  allocate(W_bca(nO,nO,nO), V_cba(nO,nO,nO), W_cba(nO,nO,nO))
+  allocate(X_vvvo(nV,nV,nV,nO), X_ovoo(nO,nV,nO,nO), X_vvoo(nV,nV,nO,nO))
+  allocate(T_vvoo(nV,nV,nO,nO), T_ovvo(nO,nV,nV,nO), T_vo(nV,nO))
+
+  ! Temporary arrays
+  !$OMP PARALLEL &
+  !$OMP SHARED(nO,nV,T_vvoo,T_ovvo,T_vo,X_vvvo,X_ovoo,X_vvoo, &
+  !$OMP t1,t2,v_vvvo,v_vooo,v_vvoo) &
+  !$OMP PRIVATE(a,b,c,d,i,j,k,l) &
+  !$OMP DEFAULT(NONE)
+
+  !v_vvvo(b,a,d,i) * t2(k,j,c,d) &
+  !X_vvvo(d,b,a,i) * T_vvoo(d,c,k,j)
+
+  !$OMP DO collapse(3)
+  do i = 1, nO
+    do a = 1, nV
+      do b = 1, nV
+        do d = 1, nV
+          X_vvvo(d,b,a,i) = v_vvvo(b,a,d,i)
+        enddo
+      enddo
+    enddo
+  enddo
+  !$OMP END DO nowait
+
+  !$OMP DO collapse(3)
+  do j = 1, nO
+    do k = 1, nO
+      do c = 1, nV
+        do d = 1, nV
+          T_vvoo(d,c,k,j) = t2(k,j,c,d)
+        enddo
+      enddo
+    enddo
+  enddo
+  !$OMP END DO nowait
+
+  !v_vooo(c,j,k,l) * t2(i,l,a,b) &
+  !X_ovoo(l,c,j,k) * T_ovvo(l,a,b,i) &
+
+  !$OMP DO collapse(3)
+  do k = 1, nO
+    do j = 1, nO
+      do c = 1, nV
+        do l = 1, nO
+           X_ovoo(l,c,j,k) = v_vooo(c,j,k,l)
+        enddo
+      enddo
+    enddo
+  enddo
+  !$OMP END DO nowait
+
+  !$OMP DO collapse(3)
+  do i = 1, nO
+    do b = 1, nV
+      do a = 1, nV
+        do l = 1, nO
+          T_ovvo(l,a,b,i) = t2(i,l,a,b)
+        enddo
+      enddo
+    enddo
+  enddo
+  !$OMP END DO nowait
+
+  !v_vvoo(b,c,j,k) * t1(i,a) &
+  !X_vvoo(b,c,k,j) * T1_vo(a,i) &
+
+  !$OMP DO collapse(3)
+  do j = 1, nO
+    do k = 1, nO
+      do c = 1, nV
+        do b = 1, nV
+          X_vvoo(b,c,k,j) = v_vvoo(b,c,j,k)
+        enddo
+      enddo
+    enddo
+  enddo
+  !$OMP END DO nowait
+
+  !$OMP DO collapse(1)
+  do i = 1, nO
+    do a = 1, nV
+      T_vo(a,i) = t1(i,a)
+    enddo
+  enddo
+  !$OMP END DO
+  !$OMP END PARALLEL
+
+  call wall_time(ta)
+  energy = 0d0
+  do c = 1, nV
+    do b = 1, nV
+      do a = 1, nV
+        delta_abc = f_v(a) + f_v(b) + f_v(c)
+        call form_w_abc(nO,nV,a,b,c,T_vvoo,T_ovvo,X_vvvo,X_ovoo,W_abc)
+        call form_w_abc(nO,nV,b,c,a,T_vvoo,T_ovvo,X_vvvo,X_ovoo,W_bca)
+        call form_w_abc(nO,nV,c,a,b,T_vvoo,T_ovvo,X_vvvo,X_ovoo,W_cab)
+        call form_w_abc(nO,nV,c,b,a,T_vvoo,T_ovvo,X_vvvo,X_ovoo,W_cba)
+
+        call form_v_abc(nO,nV,a,b,c,T_vo,X_vvoo,W_abc,V_abc)
+        call form_v_abc(nO,nV,c,b,a,T_vo,X_vvoo,W_cba,V_cba)
+        !$OMP PARALLEL                                               &
+            !$OMP SHARED(energy,nO,a,b,c,W_abc,W_cab,W_bca,V_abc,V_cba,f_o,f_v,delta_abc)&
+            !$OMP PRIVATE(i,j,k,e,delta)                             &
+            !$OMP DEFAULT(NONE)
+        e = 0d0
+        !$OMP DO
+        do i = 1, nO
+          do j = 1, nO
+            do k = 1, nO
+              delta = 1d0 / (f_o(i) + f_o(j) + f_o(k) - delta_abc)
+              !energy = energy + (4d0 * W(i,j,k,a,b,c) + W(i,j,k,b,c,a) + W(i,j,k,c,a,b)) * (V(i,j,k,a,b,c) - V(i,j,k,c,b,a)) / (cc_space_f_o(i) + cc_space_f_o(j) + cc_space_f_o(k) - cc_space_f_v(a) - cc_space_f_v(b) - cc_space_f_v(c))  !delta_ooovvv(i,j,k,a,b,c)
+              e = e + (4d0 * W_abc(i,j,k) + W_bca(i,j,k) + W_cab(i,j,k))&
+                  * (V_abc(i,j,k) - V_cba(i,j,k)) * delta
+            enddo
+          enddo
+        enddo
+        !$OMP END DO NOWAIT
+        !$OMP CRITICAL
+        energy = energy + e
+        !$OMP END CRITICAL
+        !$OMP END PARALLEL
+      enddo
+    enddo
+    call wall_time(tb)
+    write(*,'(F12.2,A5,F12.2,A2)') dble(i)/dble(nO)*100d0, '% in ', tb - ta, ' s'
+  enddo
+
+  energy = energy / 3d0
+
+  deallocate(W_abc,V_abc,W_cab,V_cba,W_bca,X_vvvo,X_ovoo,T_vvoo,T_ovvo,T_vo)
+  !deallocate(V,W)
+end
+
+
+subroutine form_w_abc(nO,nV,a,b,c,T_vvoo,T_ovvo,X_vvvo,X_ovoo,W_abc)
+
+  implicit none
+
+  integer, intent(in)           :: nO,nV,a,b,c
+  !double precision, intent(in) :: t2(nO,nO,nV,nV)
+  double precision, intent(in)  :: T_vvoo(nV,nV,nO,nO), T_ovvo(nO,nV,nV,nO)
+  double precision, intent(in)  :: X_vvvo(nV,nV,nV,nO), X_ovoo(nO,nV,nO,nO)
+  double precision, intent(out) :: W_abc(nO,nO,nO)
+
+  integer :: l,i,j,k,d
+
+
+  !$OMP PARALLEL &
+  !$OMP SHARED(nO,nV,a,b,c,T_vvoo,T_ovvo,X_vvvo,X_ovoo,W_abc) &
+  !$OMP PRIVATE(i,j,k,d,l) &
+  !$OMP DEFAULT(NONE)
+
+  !$OMP DO collapse(3)
+  do k = 1, nO
+    do j = 1, nO
+      do i = 1, nO
+        W_abc(i,j,k) = 0.d0
+
+        do d = 1, nV
+          W_abc(i,j,k) = W_abc(i,j,k) &
+                 + X_vvvo(d,b,a,i) * T_vvoo(d,c,k,j) &
+                 + X_vvvo(d,c,a,i) * T_vvoo(d,b,j,k) &
+                 + X_vvvo(d,a,c,k) * T_vvoo(d,b,j,i) &
+                 + X_vvvo(d,b,c,k) * T_vvoo(d,a,i,j) &
+                 + X_vvvo(d,c,b,j) * T_vvoo(d,a,i,k) &
+                 + X_vvvo(d,a,b,j) * T_vvoo(d,c,k,i)
+
+        enddo
+
+        do l = 1, nO
+          W_abc(i,j,k) = W_abc(i,j,k) &
+              - T_ovvo(l,a,b,i) * X_ovoo(l,c,j,k) &
+              - T_ovvo(l,a,c,i) * X_ovoo(l,b,k,j) & ! bc kj
+              - T_ovvo(l,c,a,k) * X_ovoo(l,b,i,j) & ! prev ac ik
+              - T_ovvo(l,c,b,k) * X_ovoo(l,a,j,i) & ! prev ab ij
+              - T_ovvo(l,b,c,j) * X_ovoo(l,a,k,i) & ! prev bc kj
+              - T_ovvo(l,b,a,j) * X_ovoo(l,c,i,k) ! prev ac ik
+        enddo
+
+      enddo
+    enddo
+  enddo
+  !$OMP END DO
+  !$OMP END PARALLEL
+
+
+end
+
+
+! V_abc
+
+subroutine form_v_abc(nO,nV,a,b,c,T_vo,X_vvoo,W,V)
+
+implicit none
+
+  integer, intent(in)           :: nO,nV,a,b,c
+  !double precision, intent(in)  :: t1(nO,nV)
+  double precision, intent(in)  :: T_vo(nV,nO)
+  double precision, intent(in)  :: X_vvoo(nV,nV,nO,nO)
+  double precision, intent(in)  :: W(nO,nO,nO)
+  double precision, intent(out) :: V(nO,nO,nO)
+
+  integer :: i,j,k
+
+  !$OMP PARALLEL &
+  !$OMP SHARED(nO,nV,a,b,c,T_vo,X_vvoo,W,V) &
+  !$OMP PRIVATE(i,j,k) &
+  !$OMP DEFAULT(NONE)
+  !$OMP DO collapse(2)
+  do k = 1, nO
+    do j = 1, nO
+      do i = 1, nO
+        !V(i,j,k,a,b,c) = V(i,j,k,a,b,c) + W(i,j,k,a,b,c) &
+        V(i,j,k) = W(i,j,k) &
+           + X_vvoo(b,c,k,j) * T_vo(a,i) &
+           + X_vvoo(a,c,k,i) * T_vo(b,j) &
+           + X_vvoo(a,b,j,i) * T_vo(c,k)
+      enddo
+    enddo
+  enddo
+  !$OMP END DO
+  !$OMP END PARALLEL
+
+end
+

src/cosgtos_ao_int/EZFIO.cfg

@@ -0,0 +1,19 @@
+[ao_expoim_cosgtos]
+type: double precision
+doc: imag part for Exponents for each primitive of each cosGTOs |AO|
+size: (ao_basis.ao_num,ao_basis.ao_prim_num_max)
+interface: ezfio, provider
+
+[use_cosgtos]
+type: logical
+doc: If true, use cosgtos for AO integrals
+interface: ezfio,provider,ocaml
+default: False
+
+[ao_integrals_threshold]
+type: Threshold
+doc: If | (pq|rs) | < `ao_integrals_threshold` then (pq|rs) is zero
+interface: ezfio,provider,ocaml
+default: 1.e-15
+ezfio_name: threshold_ao
+

src/cosgtos_ao_int/NEED

@@ -0,0 +1,2 @@
+ezfio_files
+ao_basis

src/cosgtos_ao_int/README.rst

@@ -0,0 +1,4 @@
+==============
+cosgtos_ao_int
+==============
+

src/cosgtos_ao_int/aos_cosgtos.irp.f

@@ -0,0 +1,210 @@
+
+! ---
+
+BEGIN_PROVIDER [ double precision, ao_coef_norm_ord_transp_cosgtos, (ao_prim_num_max, ao_num) ]
+
+  implicit none
+  integer :: i, j
+
+  do j = 1, ao_num
+    do i = 1, ao_prim_num_max
+      ao_coef_norm_ord_transp_cosgtos(i,j) = ao_coef_norm_ord_cosgtos(j,i)
+    enddo
+  enddo
+
+END_PROVIDER
+
+! ---
+
+BEGIN_PROVIDER [ complex*16, ao_expo_ord_transp_cosgtos, (ao_prim_num_max, ao_num) ]
+
+  implicit none
+  integer :: i, j
+
+  do j = 1, ao_num
+    do i = 1, ao_prim_num_max
+      ao_expo_ord_transp_cosgtos(i,j) = ao_expo_ord_cosgtos(j,i)
+    enddo
+  enddo
+
+END_PROVIDER
+
+! ---
+
+BEGIN_PROVIDER [ double precision, ao_coef_norm_cosgtos, (ao_num, ao_prim_num_max) ]
+
+  implicit none
+
+  integer          :: i, j, powA(3), nz
+  double precision :: norm
+  complex*16       :: overlap_x, overlap_y, overlap_z, C_A(3)
+  complex*16       :: integ1, integ2, expo
+
+  nz = 100
+
+  C_A(1) = (0.d0, 0.d0)
+  C_A(2) = (0.d0, 0.d0)
+  C_A(3) = (0.d0, 0.d0)
+
+  ao_coef_norm_cosgtos = 0.d0
+
+  do i = 1, ao_num
+
+    powA(1) = ao_power(i,1)
+    powA(2) = ao_power(i,2)
+    powA(3) = ao_power(i,3)
+
+    ! Normalization of the primitives
+    if(primitives_normalized) then
+
+      do j = 1, ao_prim_num(i)
+
+        expo = ao_expo(i,j) + (0.d0, 1.d0) * ao_expoim_cosgtos(i,j)
+
+        call overlap_cgaussian_xyz(C_A, C_A,        expo, expo, powA, powA, overlap_x, overlap_y, overlap_z, integ1, nz)
+        call overlap_cgaussian_xyz(C_A, C_A, conjg(expo), expo, powA, powA, overlap_x, overlap_y, overlap_z, integ2, nz)
+
+        norm = 2.d0 * real( integ1 + integ2 )
+
+        ao_coef_norm_cosgtos(i,j) = ao_coef(i,j) / dsqrt(norm)
+      enddo
+
+    else
+
+      do j = 1, ao_prim_num(i)
+        ao_coef_norm_cosgtos(i,j) = ao_coef(i,j)
+      enddo
+
+    endif
+
+  enddo
+
+END_PROVIDER
+
+! ---
+
+ BEGIN_PROVIDER [ double precision, ao_coef_norm_ord_cosgtos, (ao_num, ao_prim_num_max) ]
+&BEGIN_PROVIDER [ complex*16      , ao_expo_ord_cosgtos,      (ao_num, ao_prim_num_max) ]
+
+  implicit none
+  integer          :: i, j
+  integer          :: iorder(ao_prim_num_max)
+  double precision :: d(ao_prim_num_max,3)
+
+  d = 0.d0
+
+  do i = 1, ao_num
+
+    do j = 1, ao_prim_num(i)
+      iorder(j) = j
+      d(j,1) = ao_expo(i,j)
+      d(j,2) = ao_coef_norm_cosgtos(i,j)
+      d(j,3) = ao_expoim_cosgtos(i,j)
+    enddo
+
+    call dsort     (d(1,1), iorder, ao_prim_num(i))
+    call dset_order(d(1,2), iorder, ao_prim_num(i))
+    call dset_order(d(1,3), iorder, ao_prim_num(i))
+
+    do j = 1, ao_prim_num(i)
+      ao_expo_ord_cosgtos     (i,j) = d(j,1) + (0.d0, 1.d0) * d(j,3)
+      ao_coef_norm_ord_cosgtos(i,j) = d(j,2)
+    enddo
+
+  enddo
+
+END_PROVIDER
+
+! ---
+
+ BEGIN_PROVIDER [ double precision, ao_overlap_cosgtos,   (ao_num, ao_num) ]
+&BEGIN_PROVIDER [ double precision, ao_overlap_cosgtos_x, (ao_num, ao_num) ]
+&BEGIN_PROVIDER [ double precision, ao_overlap_cosgtos_y, (ao_num, ao_num) ]
+&BEGIN_PROVIDER [ double precision, ao_overlap_cosgtos_z, (ao_num, ao_num) ]
+
+  implicit none
+  integer          :: i, j, n, l, dim1, power_A(3), power_B(3)
+  double precision :: c, overlap, overlap_x, overlap_y, overlap_z
+  complex*16       :: alpha, beta, A_center(3), B_center(3)
+  complex*16       :: overlap1, overlap_x1, overlap_y1, overlap_z1
+  complex*16       :: overlap2, overlap_x2, overlap_y2, overlap_z2
+
+  ao_overlap_cosgtos   = 0.d0
+  ao_overlap_cosgtos_x = 0.d0
+  ao_overlap_cosgtos_y = 0.d0
+  ao_overlap_cosgtos_z = 0.d0
+
+  dim1 = 100
+
+ !$OMP PARALLEL DO SCHEDULE(GUIDED)                                                                 &
+ !$OMP DEFAULT(NONE)                                                                                &
+ !$OMP PRIVATE( A_center, B_center, power_A, power_B, alpha, beta, i, j, n, l, c                    &
+ !$OMP        , overlap_x , overlap_y , overlap_z , overlap                                         &
+ !$OMP        , overlap_x1, overlap_y1, overlap_z1, overlap1                                        &
+ !$OMP        , overlap_x2, overlap_y2, overlap_z2, overlap2 )                                      &
+ !$OMP SHARED( nucl_coord, ao_power, ao_prim_num, ao_num, ao_nucl, dim1                             &
+ !$OMP       , ao_overlap_cosgtos_x, ao_overlap_cosgtos_y, ao_overlap_cosgtos_z, ao_overlap_cosgtos &
+ !$OMP       , ao_coef_norm_ord_transp_cosgtos, ao_expo_ord_transp_cosgtos )
+
+  do j = 1, ao_num
+
+    A_center(1) = nucl_coord(ao_nucl(j),1) * (1.d0, 0.d0) 
+    A_center(2) = nucl_coord(ao_nucl(j),2) * (1.d0, 0.d0)
+    A_center(3) = nucl_coord(ao_nucl(j),3) * (1.d0, 0.d0)
+    power_A(1)  = ao_power(j,1)
+    power_A(2)  = ao_power(j,2)
+    power_A(3)  = ao_power(j,3)
+
+    do i = 1, ao_num
+
+      B_center(1) = nucl_coord(ao_nucl(i),1) * (1.d0, 0.d0) 
+      B_center(2) = nucl_coord(ao_nucl(i),2) * (1.d0, 0.d0)
+      B_center(3) = nucl_coord(ao_nucl(i),3) * (1.d0, 0.d0)
+      power_B(1)  = ao_power(i,1)
+      power_B(2)  = ao_power(i,2)
+      power_B(3)  = ao_power(i,3)
+
+      do n = 1, ao_prim_num(j)
+        alpha = ao_expo_ord_transp_cosgtos(n,j)
+
+        do l = 1, ao_prim_num(i)
+          c    = ao_coef_norm_ord_transp_cosgtos(n,j) * ao_coef_norm_ord_transp_cosgtos(l,i)
+          beta = ao_expo_ord_transp_cosgtos(l,i)
+
+          call overlap_cgaussian_xyz( A_center, B_center, alpha, beta, power_A, power_B &
+                                    , overlap_x1, overlap_y1, overlap_z1, overlap1, dim1 )
+
+          call overlap_cgaussian_xyz( A_center, B_center, conjg(alpha), beta, power_A, power_B &
+                                    , overlap_x2, overlap_y2, overlap_z2, overlap2, dim1       )
+
+          overlap_x = 2.d0 * real( overlap_x1 + overlap_x2 )
+          overlap_y = 2.d0 * real( overlap_y1 + overlap_y2 )
+          overlap_z = 2.d0 * real( overlap_z1 + overlap_z2 )
+          overlap   = 2.d0 * real( overlap1   + overlap2   )
+
+          ao_overlap_cosgtos(i,j) = ao_overlap_cosgtos(i,j) + c * overlap
+
+          if( isnan(ao_overlap_cosgtos(i,j)) ) then
+            print*,'i, j', i, j
+            print*,'l, n', l, n
+            print*,'c, overlap', c, overlap
+            print*, overlap_x, overlap_y, overlap_z
+            stop
+          endif
+
+          ao_overlap_cosgtos_x(i,j) = ao_overlap_cosgtos_x(i,j) + c * overlap_x
+          ao_overlap_cosgtos_y(i,j) = ao_overlap_cosgtos_y(i,j) + c * overlap_y
+          ao_overlap_cosgtos_z(i,j) = ao_overlap_cosgtos_z(i,j) + c * overlap_z
+
+        enddo
+      enddo
+    enddo
+  enddo
+ !$OMP END PARALLEL DO
+
+END_PROVIDER
+
+! ---
+
+
+

src/cosgtos_ao_int/cosgtos_ao_int.irp.f

@@ -0,0 +1,7 @@
+program cosgtos_ao_int
+  implicit none
+  BEGIN_DOC
+! TODO : Put the documentation of the program here
+  END_DOC
+  print *, 'Hello world'
+end

src/cosgtos_ao_int/one_e_Coul_integrals.irp.f

@@ -0,0 +1,535 @@
+
+! ---
+
+BEGIN_PROVIDER [ double precision, ao_integrals_n_e_cosgtos, (ao_num, ao_num)]
+
+  BEGIN_DOC
+  !
+  !  Nucleus-electron interaction, in the cosgtos |AO| basis set.
+  !
+  !  :math:`\langle \chi_i | -\sum_A \frac{1}{|r-R_A|} | \chi_j \rangle`
+  !
+  END_DOC
+
+  implicit none
+  integer          :: num_A, num_B, power_A(3), power_B(3)
+  integer          :: i, j, k, l, n_pt_in, m
+  double precision :: c, Z, A_center(3), B_center(3), C_center(3)
+  complex*16       :: alpha, beta, c1, c2
+
+  complex*16       :: NAI_pol_mult_cosgtos
+
+  ao_integrals_n_e_cosgtos = 0.d0
+
+ !$OMP PARALLEL                                                                           &
+ !$OMP DEFAULT (NONE)                                                                     &
+ !$OMP PRIVATE ( i, j, k, l, m, alpha, beta, A_center, B_center, C_center                 &
+ !$OMP         , power_A, power_B, num_A, num_B, Z, c, c1, c2, n_pt_in )                  &
+ !$OMP SHARED ( ao_num, ao_prim_num, ao_nucl, nucl_coord, ao_power, nucl_num, nucl_charge &
+ !$OMP        , ao_expo_ord_transp_cosgtos, ao_coef_norm_ord_transp_cosgtos               &
+ !$OMP        , n_pt_max_integrals, ao_integrals_n_e_cosgtos )
+
+ n_pt_in = n_pt_max_integrals
+
+ !$OMP DO SCHEDULE (dynamic)
+
+  do j = 1, ao_num
+    num_A         = ao_nucl(j)
+    power_A(1:3)  = ao_power(j,1:3)
+    A_center(1:3) = nucl_coord(num_A,1:3)
+
+    do i = 1, ao_num
+      num_B         = ao_nucl(i)
+      power_B(1:3)  = ao_power(i,1:3)
+      B_center(1:3) = nucl_coord(num_B,1:3)
+
+      do l = 1, ao_prim_num(j)
+        alpha = ao_expo_ord_transp_cosgtos(l,j)
+
+        do m = 1, ao_prim_num(i)
+          beta = ao_expo_ord_transp_cosgtos(m,i)
+
+          c = 0.d0
+          do k = 1, nucl_num
+
+            Z = nucl_charge(k)
+
+            C_center(1:3) = nucl_coord(k,1:3)
+
+            !print *, ' '
+            !print *, A_center, B_center, C_center, power_A, power_B
+            !print *, real(alpha), real(beta)
+
+            c1 = NAI_pol_mult_cosgtos( A_center, B_center, power_A, power_B &
+                                     , alpha, beta, C_center, n_pt_in )
+
+            !c2 = c1
+            c2 = NAI_pol_mult_cosgtos( A_center, B_center, power_A, power_B  &
+                                     , conjg(alpha), beta, C_center, n_pt_in )
+
+            !print *, ' c1 = ', real(c1)
+            !print *, ' c2 = ', real(c2)
+
+            c = c - Z * 2.d0 * real(c1 + c2)
+
+          enddo
+          ao_integrals_n_e_cosgtos(i,j) = ao_integrals_n_e_cosgtos(i,j) &
+                      + ao_coef_norm_ord_transp_cosgtos(l,j)            &
+                      * ao_coef_norm_ord_transp_cosgtos(m,i) * c
+        enddo
+      enddo
+    enddo
+  enddo
+
+ !$OMP END DO
+ !$OMP END PARALLEL
+
+END_PROVIDER
+
+! ---
+
+complex*16 function NAI_pol_mult_cosgtos(A_center, B_center, power_A, power_B, alpha, beta, C_center, n_pt_in)
+
+  BEGIN_DOC
+  !
+  ! Computes the electron-nucleus attraction with two primitves cosgtos.
+  !
+  ! :math:`\langle g_i | \frac{1}{|r-R_c|} | g_j \rangle`
+  !
+  END_DOC
+
+  implicit none
+  include 'utils/constants.include.F'
+
+  integer,          intent(in) :: n_pt_in, power_A(3), power_B(3)
+  double precision, intent(in) :: C_center(3), A_center(3), B_center(3)
+  complex*16,       intent(in) :: alpha, beta
+
+  integer                      :: i, n_pt, n_pt_out
+  double precision             :: dist, const_mod
+  complex*16                   :: p, p_inv, rho, dist_integral, const, const_factor, coeff, factor
+  complex*16                   :: accu, P_center(3)
+  complex*16                   :: d(0:n_pt_in)
+
+  complex*16                   :: V_n_e_cosgtos
+  complex*16                   :: crint
+
+  if ( (A_center(1)/=B_center(1)) .or. (A_center(2)/=B_center(2)) .or. (A_center(3)/=B_center(3)) .or. &
+       (A_center(1)/=C_center(1)) .or. (A_center(2)/=C_center(2)) .or. (A_center(3)/=C_center(3)) ) then
+
+    continue
+
+  else
+
+    NAI_pol_mult_cosgtos = V_n_e_cosgtos( power_A(1), power_A(2), power_A(3) &
+                                        , power_B(1), power_B(2), power_B(3) &
+                                        , alpha, beta )
+    return
+
+  endif
+
+  p     = alpha + beta
+  p_inv = (1.d0, 0.d0) / p
+  rho   = alpha * beta * p_inv
+
+  dist          = 0.d0
+  dist_integral = (0.d0, 0.d0)
+  do i = 1, 3
+    P_center(i)    = (alpha * A_center(i) + beta * B_center(i)) * p_inv
+    dist          += (A_center(i) - B_center(i)) * (A_center(i) - B_center(i))
+    dist_integral += (P_center(i) - C_center(i)) * (P_center(i) - C_center(i))
+  enddo
+
+  const_factor = dist * rho
+  const        = p * dist_integral
+
+  const_mod = dsqrt(real(const_factor)*real(const_factor) + aimag(const_factor)*aimag(const_factor))
+  if(const_mod > 80.d0) then
+    NAI_pol_mult_cosgtos = (0.d0, 0.d0)
+    return
+  endif
+
+  factor = zexp(-const_factor)
+  coeff  = dtwo_pi * factor * p_inv
+
+  do i = 0, n_pt_in
+    d(i) = (0.d0, 0.d0)
+  enddo
+
+  n_pt = 2 * ( (power_A(1) + power_B(1)) + (power_A(2) + power_B(2)) + (power_A(3) + power_B(3)) )
+  if(n_pt == 0) then
+    NAI_pol_mult_cosgtos = coeff * crint(0, const)
+    return
+  endif
+
+  call give_cpolynomial_mult_center_one_e( A_center, B_center, alpha, beta &
+                                         , power_A, power_B, C_center, n_pt_in, d, n_pt_out)
+
+  if(n_pt_out < 0) then
+    NAI_pol_mult_cosgtos = (0.d0, 0.d0)
+    return
+  endif
+
+  accu = (0.d0, 0.d0)
+  do i = 0, n_pt_out, 2
+    accu += crint(shiftr(i, 1), const) * d(i)
+
+!    print *, shiftr(i, 1), real(const), real(d(i)), real(crint(shiftr(i, 1), const))
+  enddo
+  NAI_pol_mult_cosgtos = accu * coeff
+
+end function NAI_pol_mult_cosgtos
+
+! ---
+
+subroutine give_cpolynomial_mult_center_one_e( A_center, B_center, alpha, beta &
+                                             , power_A, power_B, C_center, n_pt_in, d, n_pt_out)
+
+  BEGIN_DOC
+  ! Returns the explicit polynomial in terms of the "t" variable of the following
+  !
+  ! $I_{x1}(a_x, d_x,p,q) \times I_{x1}(a_y, d_y,p,q) \times I_{x1}(a_z, d_z,p,q)$.
+  END_DOC
+
+  implicit none
+
+  integer,          intent(in) :: n_pt_in, power_A(3), power_B(3)
+  double precision, intent(in) :: A_center(3), B_center(3), C_center(3)
+  complex*16,       intent(in) :: alpha, beta
+  integer,         intent(out) :: n_pt_out
+  complex*16,      intent(out) :: d(0:n_pt_in)
+
+  integer                      :: a_x, b_x, a_y, b_y, a_z, b_z
+  integer                      :: n_pt1, n_pt2, n_pt3, dim, i, n_pt_tmp
+  complex*16                   :: p, P_center(3), rho, p_inv, p_inv_2
+  complex*16                   :: R1x(0:2), B01(0:2), R1xp(0:2),R2x(0:2)
+  complex*16                   :: d1(0:n_pt_in), d2(0:n_pt_in), d3(0:n_pt_in)
+
+  ASSERT (n_pt_in > 1)
+
+  p       = alpha + beta
+  p_inv   = (1.d0, 0.d0) / p
+  p_inv_2 = 0.5d0 * p_inv
+
+  do i = 1, 3
+    P_center(i) = (alpha * A_center(i) + beta * B_center(i)) * p_inv
+  enddo
+
+  do i = 0, n_pt_in
+    d(i)  = (0.d0, 0.d0)
+    d1(i) = (0.d0, 0.d0)
+    d2(i) = (0.d0, 0.d0)
+    d3(i) = (0.d0, 0.d0)
+  enddo
+
+  ! ---
+
+  n_pt1 = n_pt_in
+
+  R1x(0)  =  (P_center(1) - A_center(1))
+  R1x(1)  =  (0.d0, 0.d0)
+  R1x(2)  = -(P_center(1) - C_center(1))
+
+  R1xp(0) =  (P_center(1) - B_center(1))
+  R1xp(1) =  (0.d0, 0.d0)
+  R1xp(2) = -(P_center(1) - C_center(1))
+
+  R2x(0)  =  p_inv_2
+  R2x(1)  = (0.d0, 0.d0)
+  R2x(2)  = -p_inv_2
+
+  a_x = power_A(1)
+  b_x = power_B(1)
+  call I_x1_pol_mult_one_e_cosgtos(a_x, b_x, R1x, R1xp, R2x, d1, n_pt1, n_pt_in)
+
+  if(n_pt1 < 0) then
+    n_pt_out = -1
+    do i = 0, n_pt_in
+      d(i) = (0.d0, 0.d0)
+    enddo
+    return
+  endif
+
+  ! ---
+
+  n_pt2 = n_pt_in
+
+  R1x(0)  =  (P_center(2) - A_center(2))
+  R1x(1)  =  (0.d0, 0.d0)
+  R1x(2)  = -(P_center(2) - C_center(2))
+
+  R1xp(0) =  (P_center(2) - B_center(2))
+  R1xp(1) =  (0.d0, 0.d0)
+  R1xp(2) = -(P_center(2) - C_center(2))
+
+  a_y = power_A(2)
+  b_y = power_B(2)
+  call I_x1_pol_mult_one_e_cosgtos(a_y, b_y, R1x, R1xp, R2x, d2, n_pt2, n_pt_in)
+
+  if(n_pt2 < 0) then
+    n_pt_out = -1
+    do i = 0, n_pt_in
+      d(i) = (0.d0, 0.d0)
+    enddo
+    return
+  endif
+
+  ! ---
+
+  n_pt3 = n_pt_in
+
+  R1x(0)  =  (P_center(3) - A_center(3))
+  R1x(1)  =  (0.d0, 0.d0)
+  R1x(2)  = -(P_center(3) - C_center(3))
+
+  R1xp(0) =  (P_center(3) - B_center(3))
+  R1xp(1) =  (0.d0, 0.d0)
+  R1xp(2) = -(P_center(3) - C_center(3))
+
+  a_z = power_A(3)
+  b_z = power_B(3)
+  call I_x1_pol_mult_one_e_cosgtos(a_z, b_z, R1x, R1xp, R2x, d3, n_pt3, n_pt_in)
+
+  if(n_pt3 < 0) then
+    n_pt_out = -1
+    do i = 0, n_pt_in
+      d(i) = (0.d0, 0.d0)
+    enddo
+    return
+  endif
+
+  ! ---
+
+  n_pt_tmp = 0
+  call multiply_cpoly(d1, n_pt1, d2, n_pt2, d, n_pt_tmp)
+  do i = 0, n_pt_tmp
+    d1(i) = (0.d0, 0.d0)
+  enddo
+
+  n_pt_out = 0
+  call multiply_cpoly(d, n_pt_tmp, d3, n_pt3, d1, n_pt_out)
+  do i = 0, n_pt_out
+    d(i) = d1(i)
+  enddo
+
+end subroutine give_cpolynomial_mult_center_one_e
+
+! ---
+
+recursive subroutine I_x1_pol_mult_one_e_cosgtos(a, c, R1x, R1xp, R2x, d, nd, n_pt_in)
+
+  BEGIN_DOC
+  !  Recursive routine involved in the electron-nucleus potential
+  END_DOC
+
+  implicit none
+  include 'utils/constants.include.F'
+
+  integer,    intent(in)    :: a, c, n_pt_in
+  complex*16, intent(in)    :: R1x(0:2), R1xp(0:2), R2x(0:2)
+  integer,    intent(inout) :: nd
+  complex*16, intent(inout) :: d(0:n_pt_in)
+
+  integer                   :: nx, ix, dim, iy, ny
+  complex*16                :: X(0:max_dim)
+  complex*16                :: Y(0:max_dim)
+  !DIR$ ATTRIBUTES ALIGN : $IRP_ALIGN :: X, Y
+
+  dim = n_pt_in
+
+  if( (a==0) .and. (c==0)) then
+
+    nd   = 0
+    d(0) = (1.d0, 0.d0)
+    return
+
+  elseif( (c < 0) .or. (nd < 0) ) then
+
+    nd = -1
+    return
+
+  elseif((a == 0) .and. (c .ne. 0)) then
+
+    call I_x2_pol_mult_one_e_cosgtos(c, R1x, R1xp, R2x, d, nd, n_pt_in)
+
+  elseif(a == 1) then
+
+    nx = nd
+    do ix = 0, n_pt_in
+      X(ix) = (0.d0, 0.d0)
+      Y(ix) = (0.d0, 0.d0)
+    enddo
+
+    call I_x2_pol_mult_one_e_cosgtos(c-1, R1x, R1xp, R2x, X, nx, n_pt_in)
+
+    do ix = 0, nx
+      X(ix) *= dble(c)
+    enddo
+
+    call multiply_cpoly(X, nx, R2x, 2, d, nd)
+
+    ny = 0
+    call I_x2_pol_mult_one_e_cosgtos(c, R1x, R1xp, R2x, Y, ny, n_pt_in)
+    call multiply_cpoly(Y, ny, R1x, 2, d, nd)
+
+  else
+
+    nx = 0
+    do ix = 0, n_pt_in
+      X(ix) = (0.d0, 0.d0)
+      Y(ix) = (0.d0, 0.d0)
+    enddo
+
+    call I_x1_pol_mult_one_e_cosgtos(a-2, c, R1x, R1xp, R2x, X, nx, n_pt_in)
+
+    do ix = 0, nx
+      X(ix) *= dble(a-1)
+    enddo
+    call multiply_cpoly(X, nx, R2x, 2, d, nd)
+
+    nx = nd
+    do ix = 0, n_pt_in
+      X(ix) = (0.d0, 0.d0)
+    enddo
+
+    call I_x1_pol_mult_one_e_cosgtos(a-1, c-1, R1x, R1xp, R2x, X, nx, n_pt_in)
+    do ix = 0, nx
+      X(ix) *= dble(c)
+    enddo
+
+    call multiply_cpoly(X, nx, R2x, 2, d, nd)
+
+    ny = 0
+    call I_x1_pol_mult_one_e_cosgtos(a-1, c, R1x, R1xp, R2x, Y, ny, n_pt_in)
+    call multiply_cpoly(Y, ny, R1x, 2, d, nd)
+
+  endif
+
+end subroutine I_x1_pol_mult_one_e_cosgtos
+
+! ---
+
+recursive subroutine I_x2_pol_mult_one_e_cosgtos(c, R1x, R1xp, R2x, d, nd, dim)
+
+  BEGIN_DOC
+  !  Recursive routine involved in the electron-nucleus potential
+  END_DOC
+
+  implicit none
+  include 'utils/constants.include.F'
+
+  integer,    intent(in)    :: dim, c
+  complex*16, intent(in)    :: R1x(0:2), R1xp(0:2), R2x(0:2)
+  integer,    intent(inout) :: nd
+  complex*16, intent(out)   :: d(0:max_dim)
+
+  integer                   :: i, nx, ix, ny
+  complex*16                :: X(0:max_dim), Y(0:max_dim)
+  !DIR$ ATTRIBUTES ALIGN : $IRP_ALIGN :: X, Y
+
+  if(c == 0) then
+
+    nd = 0
+    d(0) = (1.d0, 0.d0)
+    return
+
+  elseif((nd < 0) .or. (c < 0)) then
+
+    nd = -1
+    return
+
+  else
+
+    nx = 0
+    do ix = 0, dim
+      X(ix) = (0.d0, 0.d0)
+      Y(ix) = (0.d0, 0.d0)
+    enddo
+
+    call I_x1_pol_mult_one_e_cosgtos(0, c-2, R1x, R1xp, R2x, X, nx, dim)
+
+    do ix = 0, nx
+      X(ix) *= dble(c-1)
+    enddo
+
+    call multiply_cpoly(X, nx, R2x, 2, d, nd)
+
+    ny = 0
+    do ix = 0, dim
+      Y(ix) = (0.d0, 0.d0)
+    enddo
+
+    call I_x1_pol_mult_one_e_cosgtos(0, c-1, R1x, R1xp, R2x, Y, ny, dim)
+
+    if(ny .ge. 0) then
+      call multiply_cpoly(Y, ny, R1xp, 2, d, nd)
+    endif
+
+  endif
+
+end subroutine I_x2_pol_mult_one_e_cosgtos
+
+! ---
+
+complex*16 function V_n_e_cosgtos(a_x, a_y, a_z, b_x, b_y, b_z, alpha, beta)
+
+  BEGIN_DOC
+  ! Primitve nuclear attraction between the two primitves centered on the same atom.
+  !
+  ! $p_1 = x^{a_x} y^{a_y} z^{a_z} \exp(-\alpha r^2)$
+  !
+  ! $p_2 = x^{b_x} y^{b_y} z^{b_z} \exp(-\beta  r^2)$
+  END_DOC
+
+  implicit none
+
+  integer,    intent(in) :: a_x, a_y, a_z, b_x, b_y, b_z
+  complex*16, intent(in) :: alpha, beta
+
+  double precision       :: V_phi, V_theta
+  complex*16             :: V_r_cosgtos
+
+  if( (iand(a_x + b_x, 1) == 1) .or. &
+      (iand(a_y + b_y, 1) == 1) .or. &
+      (iand(a_z + b_z, 1) == 1) ) then
+
+    V_n_e_cosgtos = (0.d0, 0.d0)
+
+  else
+
+    V_n_e_cosgtos = V_r_cosgtos(a_x + b_x + a_y + b_y + a_z + b_z + 1, alpha + beta) &
+                  * V_phi(a_x + b_x, a_y + b_y)                                      &
+                  * V_theta(a_z + b_z, a_x + b_x + a_y + b_y + 1)
+  endif
+
+end function V_n_e_cosgtos
+
+! ---
+
+complex*16 function V_r_cosgtos(n, alpha)
+
+  BEGIN_DOC
+  ! Computes the radial part of the nuclear attraction integral:
+  !
+  ! $\int_{0}^{\infty} r^n  \exp(-\alpha  r^2)  dr$
+  !
+  END_DOC
+
+  implicit none
+  include 'utils/constants.include.F'
+
+  integer   , intent(in) :: n
+  complex*16, intent(in) :: alpha
+
+  double precision       :: fact
+
+  if(iand(n, 1) .eq. 1) then
+    V_r_cosgtos = 0.5d0 * fact(shiftr(n, 1)) / (alpha**(shiftr(n, 1) + 1))
+  else
+    V_r_cosgtos = sqpi * fact(n) / fact(shiftr(n, 1)) * (0.5d0/zsqrt(alpha))**(n+1)
+  endif
+
+end function V_r_cosgtos
+
+! ---
+

src/cosgtos_ao_int/one_e_kin_integrals.irp.f

@@ -0,0 +1,223 @@
+
+! ---
+
+ BEGIN_PROVIDER [ double precision, ao_deriv2_cosgtos_x, (ao_num, ao_num) ]
+&BEGIN_PROVIDER [ double precision, ao_deriv2_cosgtos_y, (ao_num, ao_num) ]
+&BEGIN_PROVIDER [ double precision, ao_deriv2_cosgtos_z, (ao_num, ao_num) ]
+
+  implicit none
+  integer          :: i, j, n, l, dim1, power_A(3), power_B(3)
+  double precision :: c, deriv_tmp
+  complex*16       :: alpha, beta, A_center(3), B_center(3)
+  complex*16       :: overlap_x, overlap_y, overlap_z, overlap
+  complex*16       :: overlap_x0_1, overlap_y0_1, overlap_z0_1
+  complex*16       :: overlap_x0_2, overlap_y0_2, overlap_z0_2 
+  complex*16       :: overlap_m2_1, overlap_p2_1
+  complex*16       :: overlap_m2_2, overlap_p2_2
+  complex*16       :: deriv_tmp_1, deriv_tmp_2
+
+
+  dim1 = 100
+
+  ! -- Dummy call to provide everything
+
+  A_center(:) = (0.0d0, 0.d0)
+  B_center(:) = (1.0d0, 0.d0)
+  alpha       = (1.0d0, 0.d0)
+  beta        = (0.1d0, 0.d0)
+  power_A     = 1
+  power_B     = 0
+  call overlap_cgaussian_xyz( A_center, B_center, alpha, beta, power_A, power_B       &
+                            , overlap_x0_1, overlap_y0_1, overlap_z0_1, overlap, dim1 )
+
+  ! ---
+
+ !$OMP PARALLEL DO SCHEDULE(GUIDED)                                                                  &
+ !$OMP DEFAULT(NONE)                                                                                 &
+ !$OMP PRIVATE( A_center, B_center, power_A, power_B, alpha, beta, i, j, l, n, c                     &
+ !$OMP        , deriv_tmp, deriv_tmp_1, deriv_tmp_2                                                  &
+ !$OMP        , overlap_x, overlap_y, overlap_z, overlap                                             &
+ !$OMP        , overlap_m2_1, overlap_p2_1, overlap_m2_2, overlap_p2_2                               &
+ !$OMP        , overlap_x0_1, overlap_y0_1, overlap_z0_1, overlap_x0_2, overlap_y0_2, overlap_z0_2 ) &
+ !$OMP SHARED( nucl_coord, ao_power, ao_prim_num, ao_num, ao_nucl, dim1                              &
+ !$OMP       , ao_coef_norm_ord_transp_cosgtos, ao_expo_ord_transp_cosgtos                           & 
+ !$OMP       , ao_deriv2_cosgtos_x, ao_deriv2_cosgtos_y, ao_deriv2_cosgtos_z ) 
+
+  do j = 1, ao_num
+    A_center(1) = nucl_coord(ao_nucl(j),1) * (1.d0, 0.d0)
+    A_center(2) = nucl_coord(ao_nucl(j),2) * (1.d0, 0.d0)
+    A_center(3) = nucl_coord(ao_nucl(j),3) * (1.d0, 0.d0)
+    power_A(1)  = ao_power(j,1)
+    power_A(2)  = ao_power(j,2)
+    power_A(3)  = ao_power(j,3)
+
+    do i = 1, ao_num
+      B_center(1) = nucl_coord(ao_nucl(i),1) * (1.d0, 0.d0) 
+      B_center(2) = nucl_coord(ao_nucl(i),2) * (1.d0, 0.d0)
+      B_center(3) = nucl_coord(ao_nucl(i),3) * (1.d0, 0.d0)
+      power_B(1)  = ao_power(i,1)
+      power_B(2)  = ao_power(i,2)
+      power_B(3)  = ao_power(i,3)
+
+      ao_deriv2_cosgtos_x(i,j) = 0.d0
+      ao_deriv2_cosgtos_y(i,j) = 0.d0
+      ao_deriv2_cosgtos_z(i,j) = 0.d0
+
+      do n = 1, ao_prim_num(j)
+        alpha = ao_expo_ord_transp_cosgtos(n,j)
+
+        do l = 1, ao_prim_num(i)
+          c    = ao_coef_norm_ord_transp_cosgtos(n,j) * ao_coef_norm_ord_transp_cosgtos(l,i)
+          beta = ao_expo_ord_transp_cosgtos(l,i)
+
+          call overlap_cgaussian_xyz( A_center, B_center, alpha, beta, power_A, power_B       &
+                                    , overlap_x0_1, overlap_y0_1, overlap_z0_1, overlap, dim1 )
+
+          call overlap_cgaussian_xyz( A_center, B_center, alpha, conjg(beta), power_A, power_B &
+                                    , overlap_x0_2, overlap_y0_2, overlap_z0_2, overlap, dim1  )
+
+          ! ---
+
+          power_A(1) = power_A(1) - 2
+          if(power_A(1) > -1) then
+            call overlap_cgaussian_xyz( A_center, B_center, alpha, beta, power_A, power_B &
+                                      , overlap_m2_1, overlap_y, overlap_z, overlap, dim1 )
+
+            call overlap_cgaussian_xyz( A_center, B_center, alpha, conjg(beta), power_A, power_B &
+                                      , overlap_m2_2, overlap_y, overlap_z, overlap, dim1        )
+          else
+            overlap_m2_1 = (0.d0, 0.d0)
+            overlap_m2_2 = (0.d0, 0.d0)
+          endif
+
+          power_A(1) = power_A(1) + 4
+          call overlap_cgaussian_xyz( A_center, B_center, alpha, beta, power_A, power_B &
+                                    , overlap_p2_1, overlap_y, overlap_z, overlap, dim1 )
+
+          call overlap_cgaussian_xyz( A_center, B_center, alpha, conjg(beta), power_A, power_B &
+                                    , overlap_p2_2, overlap_y, overlap_z, overlap, dim1        )
+
+          power_A(1) = power_A(1) - 2
+
+          deriv_tmp_1 = ( -2.d0 * alpha * (2.d0 * power_A(1) + 1.d0) * overlap_x0_1 &
+                        + power_A(1) * (power_A(1) - 1.d0) * overlap_m2_1           &
+                        + 4.d0 * alpha * alpha * overlap_p2_1 ) * overlap_y0_1 * overlap_z0_1
+
+          deriv_tmp_2 = ( -2.d0 * alpha * (2.d0 * power_A(1) + 1.d0) * overlap_x0_2 &
+                        + power_A(1) * (power_A(1) - 1.d0) * overlap_m2_2           &
+                        + 4.d0 * alpha * alpha * overlap_p2_2 ) * overlap_y0_2 * overlap_z0_2
+
+          deriv_tmp = 2.d0 * real(deriv_tmp_1 + deriv_tmp_2)
+
+          ao_deriv2_cosgtos_x(i,j) += c * deriv_tmp
+
+          ! ---
+
+          power_A(2) = power_A(2) - 2
+          if(power_A(2) > -1) then
+            call overlap_cgaussian_xyz( A_center, B_center, alpha, beta, power_A, power_B &
+                                      , overlap_x, overlap_m2_1, overlap_y, overlap, dim1 )
+
+            call overlap_cgaussian_xyz( A_center, B_center, alpha, conjg(beta), power_A, power_B &
+                                      , overlap_x, overlap_m2_2, overlap_y, overlap, dim1        )
+          else
+            overlap_m2_1 = (0.d0, 0.d0)
+            overlap_m2_2 = (0.d0, 0.d0)
+          endif
+
+          power_A(2) = power_A(2) + 4
+          call overlap_cgaussian_xyz( A_center, B_center, alpha, beta, power_A, power_B &
+                                    , overlap_x, overlap_p2_1, overlap_y, overlap, dim1 )
+
+          call overlap_cgaussian_xyz( A_center, B_center, alpha, conjg(beta), power_A, power_B &
+                                    , overlap_x, overlap_p2_2, overlap_y, overlap, dim1        )
+
+          power_A(2) = power_A(2) - 2
+
+          deriv_tmp_1 = ( -2.d0 * alpha * (2.d0 * power_A(2) + 1.d0) * overlap_y0_1 &
+                        + power_A(2) * (power_A(2) - 1.d0) * overlap_m2_1           &
+                        + 4.d0 * alpha * alpha * overlap_p2_1 ) * overlap_x0_1 * overlap_z0_1
+
+          deriv_tmp_2 = ( -2.d0 * alpha * (2.d0 * power_A(2) + 1.d0) * overlap_y0_2 &
+                        + power_A(2) * (power_A(2) - 1.d0) * overlap_m2_2           &
+                        + 4.d0 * alpha * alpha * overlap_p2_2 ) * overlap_x0_2 * overlap_z0_2
+
+          deriv_tmp = 2.d0 * real(deriv_tmp_1 + deriv_tmp_2)
+
+          ao_deriv2_cosgtos_y(i,j) += c * deriv_tmp
+
+          ! ---
+
+          power_A(3) = power_A(3) - 2
+          if(power_A(3) > -1) then
+            call overlap_cgaussian_xyz( A_center, B_center, alpha, beta, power_A, power_B &
+                                      , overlap_x, overlap_y, overlap_m2_1, overlap, dim1 )
+
+            call overlap_cgaussian_xyz( A_center, B_center, alpha, conjg(beta), power_A, power_B &
+                                      , overlap_x, overlap_y, overlap_m2_2, overlap, dim1        )
+          else
+            overlap_m2_1 = (0.d0, 0.d0)
+            overlap_m2_2 = (0.d0, 0.d0)
+          endif
+
+          power_A(3) = power_A(3) + 4
+          call overlap_cgaussian_xyz( A_center, B_center, alpha, beta, power_A, power_B &
+                                    , overlap_x, overlap_y, overlap_p2_1, overlap, dim1 )
+
+          call overlap_cgaussian_xyz( A_center, B_center, alpha, conjg(beta), power_A, power_B &
+                                    , overlap_x, overlap_y, overlap_p2_2, overlap, dim1        )
+
+          power_A(3) = power_A(3) - 2
+          
+          deriv_tmp_1 = ( -2.d0 * alpha * (2.d0 * power_A(3) + 1.d0) * overlap_z0_1 &
+                        + power_A(3) * (power_A(3) - 1.d0) * overlap_m2_1           &
+                        + 4.d0 * alpha * alpha * overlap_p2_1 ) * overlap_x0_1 * overlap_y0_1
+
+          deriv_tmp_2 = ( -2.d0 * alpha * (2.d0 * power_A(3) + 1.d0) * overlap_z0_2 &
+                        + power_A(3) * (power_A(3) - 1.d0) * overlap_m2_2           &
+                        + 4.d0 * alpha * alpha * overlap_p2_2 ) * overlap_x0_2 * overlap_y0_2
+
+          deriv_tmp = 2.d0 * real(deriv_tmp_1 + deriv_tmp_2)
+
+          ao_deriv2_cosgtos_z(i,j) += c * deriv_tmp
+
+          ! ---
+
+        enddo
+      enddo
+    enddo
+  enddo
+ !$OMP END PARALLEL DO
+
+END_PROVIDER
+
+! ---
+
+BEGIN_PROVIDER [double precision, ao_kinetic_integrals_cosgtos, (ao_num, ao_num)]
+
+  BEGIN_DOC
+  ! 
+  ! Kinetic energy integrals in the cosgtos |AO| basis.
+  !
+  ! $\langle \chi_i |\hat{T}| \chi_j \rangle$
+  !
+  END_DOC
+
+  implicit none
+  integer :: i, j
+
+ !$OMP PARALLEL DO DEFAULT(NONE) &
+ !$OMP  PRIVATE(i, j)            &
+ !$OMP  SHARED(ao_num, ao_kinetic_integrals_cosgtos, ao_deriv2_cosgtos_x, ao_deriv2_cosgtos_y, ao_deriv2_cosgtos_z)
+  do j = 1, ao_num
+    do i = 1, ao_num
+      ao_kinetic_integrals_cosgtos(i,j) = -0.5d0 * ( ao_deriv2_cosgtos_x(i,j) &
+                                                   + ao_deriv2_cosgtos_y(i,j) &
+                                                   + ao_deriv2_cosgtos_z(i,j) )
+    enddo
+  enddo
+ !$OMP END PARALLEL DO
+
+END_PROVIDER
+
+! ---

src/iterations/print_extrapolation.irp.f

@@ -25,7 +25,7 @@ subroutine print_extrapolated_energy
   write(*,*)  'minimum PT2 ', 'Extrapolated energy'
   write(*,*)  '=========== ', '==================='
   do k=2,N_iter_p
-    write(*,'(F11.4,2X,F18.8)') pt2_iterations(1,k), extrapolated_energy(k,1)
+    write(*,'(F11.4,2X,F18.8)') pt2_iterations(1,N_iter_p+1-k), extrapolated_energy(k,1)
   enddo
   write(*,*)  '=========== ', '==================='
 

src/mo_basis/utils.irp.f

@@ -3,7 +3,6 @@ subroutine save_mos
   double precision, allocatable  :: buffer(:,:)
   integer                        :: i,j
 
-  call system('$QP_ROOT/scripts/save_current_mos.sh '//trim(ezfio_filename))
   call ezfio_set_mo_basis_mo_num(mo_num)
   call ezfio_set_mo_basis_mo_label(mo_label)
   call ezfio_set_mo_basis_ao_md5(ao_md5)
@@ -27,7 +26,7 @@ subroutine save_mos_no_occ
   double precision, allocatable  :: buffer(:,:)
   integer                        :: i,j
 
-  call system('$QP_ROOT/scripts/save_current_mos.sh '//trim(ezfio_filename))
+!  call system('$QP_ROOT/scripts/save_current_mos.sh '//trim(ezfio_filename))
  !call ezfio_set_mo_basis_mo_num(mo_num)
  !call ezfio_set_mo_basis_mo_label(mo_label)
  !call ezfio_set_mo_basis_ao_md5(ao_md5)
@@ -48,7 +47,7 @@ subroutine save_mos_truncated(n)
   double precision, allocatable  :: buffer(:,:)
   integer                        :: i,j,n
 
-  call system('$QP_ROOT/scripts/save_current_mos.sh '//trim(ezfio_filename))
+!  call system('$QP_ROOT/scripts/save_current_mos.sh '//trim(ezfio_filename))
 
   call ezfio_set_mo_basis_mo_num(n)
   call ezfio_set_mo_basis_mo_label(mo_label)

src/mo_localization/84.mo_localization.bats

@@ -0,0 +1,97 @@
+#!/usr/bin/env bats
+
+source $QP_ROOT/tests/bats/common.bats.sh
+source $QP_ROOT/quantum_package.rc
+
+zero () {
+    if [ -z "$1" ]; then echo 0.0; else echo $1; fi
+}
+
+function run() {
+  thresh1=1e-10
+  thresh2=1e-12
+  thresh3=1e-4
+  test_exe scf || skip
+  qp set_file $1
+  qp edit --check
+  qp reset -d
+  qp set_frozen_core
+  qp set localization localization_method boys
+  file="$(echo $1 | sed 's/.ezfio//g')"
+  energy="$(cat $1/hartree_fock/energy)"
+  fb_err1="$(qp run debug_gradient_loc | grep 'Max error' | tail -n 1 | awk '{print $3}')"
+  fb_err2="$(qp run debug_hessian_loc | grep 'Max error' | tail -n 1 | awk '{print $3}')"
+  qp run localization > $file.loc.out
+  fb_energy="$(qp run print_energy | grep -A 1 'Nuclear repulsion energy' | tail -n 1 )"
+  fb_c="$(cat $file.loc.out | grep 'Criterion:Core' | tail -n 1 | awk '{print $3}')i"
+  fb_i="$(cat $file.loc.out | grep 'Criterion:Inactive' | tail -n 1 | awk '{print $3}')"
+  fb_a="$(cat $file.loc.out | grep 'Criterion:Active' | tail -n 1 | awk '{print $3}')"
+  fb_v="$(cat $file.loc.out | grep 'Criterion:Virtual' | tail -n 1 | awk '{print $3}')"
+  qp reset -a
+  qp run scf
+  qp set_frozen_core
+  qp set localization localization_method pipek 
+  pm_err1="$(qp run debug_gradient_loc | grep 'Max error' | tail -n 1 | awk '{print $3}')"
+  pm_err2="$(qp run debug_hessian_loc | grep 'Max error' | tail -n 1 | awk '{print $3}')"
+  qp run localization > $file.loc.out
+  pm_c="$(cat $file.loc.out | grep 'Criterion:Core' | tail -n 1 | awk '{print $3}')i"
+  pm_i="$(cat $file.loc.out | grep 'Criterion:Inactive' | tail -n 1 | awk '{print $3}')"
+  pm_a="$(cat $file.loc.out | grep 'Criterion:Active' | tail -n 1 | awk '{print $3}')"
+  pm_v="$(cat $file.loc.out | grep 'Criterion:Virtual' | tail -n 1 | awk '{print $3}')"
+  pm_energy="$(qp run print_energy | grep -A 1 'Nuclear repulsion energy' | tail -n 1 )"
+  qp set localization localization_method boys
+  qp reset -a
+  qp run scf
+  qp set_frozen_core
+  eq $energy $fb_energy $thresh1 
+  eq $fb_err1 0.0 $thresh2
+  eq $fb_err2 0.0 $thresh2
+  eq $energy $pm_energy $thresh1
+  eq $pm_err1 0.0 $thresh2
+  eq $pm_err2 0.0 $thresh2
+  fb_c=$(zero $fb_c)
+  fb_i=$(zero $fb_i)
+  fb_a=$(zero $fb_a)
+  fb_v=$(zero $fb_v)
+  pm_c=$(zero $pm_c)
+  pm_i=$(zero $pm_i)
+  pm_a=$(zero $pm_a)
+  pm_v=$(zero $pm_v)
+  eq $fb_c $2 $thresh3
+  eq $fb_i $3 $thresh3
+  eq $fb_a $4 $thresh3
+  eq $fb_v $5 $thresh3
+  eq $pm_c $6 $thresh3
+  eq $pm_i $7 $thresh3
+  eq $pm_a $8 $thresh3
+  eq $pm_v $9 $thresh3
+}
+
+@test "b2_stretched" {
+run  b2_stretched.ezfio -32.1357551678876 -47.0041982094667 0.0 -223.470015856259 -1.99990778964451 -2.51376723927071 0.0 -12.8490602539275
+}
+
+@test "clo" {
+run  clo.ezfio -44.1624001765291 -32.4386660941387 0.0 -103.666309287187 -5.99985418946811 -5.46871580225222 0.0 -20.2480064922275
+}
+
+@test "clf" {
+run  clf.ezfio -47.5143398826967 -35.7206886315104 0.0 -107.043029033468 -5.99994222062230 -6.63916513458470 0.0 -19.7035159913484
+}
+
+@test "h2o2" {
+run  h2o2.ezfio -7.76848143170524 -30.9694344369829 0.0 -175.898343829453 -1.99990497554575 -5.62980322957485 0.0 -33.5699813186666
+}
+
+@test "h2o" {
+run  h2o.ezfio 0.0 -2.52317434969591 0.0 -45.3136377925359 0.0 -3.01248365356981 0.0 -22.4470831240924
+}
+
+@test "h3coh" {
+run  h3coh.ezfio -3.66763692804590 -24.0463089480870 0.0 -111.485948435075 -1.99714061342078 -4.89242181322988 0.0 -23.6405412057679
+}
+
+@test "n2h4" {
+run  n2h4.ezfio -7.46608163002070 -35.7632174051822 0.0 -305.913449004632 -1.99989326143356 -4.62496615892268 0.0 -51.5171904685553
+}
+

src/mo_localization/EZFIO.cfg

@@ -0,0 +1,54 @@
+[localization_method]
+type: character*(32)
+doc: Method for the orbital localization. boys: Foster-Boys, pipek: Pipek-Mezey.
+interface: ezfio,provider,ocaml
+default: boys
+
+[localization_max_nb_iter]
+type: integer
+doc: Maximal number of iterations for the orbital localization.
+interface: ezfio,provider,ocaml
+default: 1000
+
+[localization_use_hessian]
+type: logical
+doc: If true, it uses the trust region algorithm with the gradient and the diagonal of the hessian. Else it computes the rotation between each pair of MOs that should be applied to maximize/minimize the localization criterion. The last option is not easy to converge. 
+interface: ezfio,provider,ocaml
+default: true
+
+[auto_mo_class]
+type: logical
+doc: If true, set automatically the classes.
+interface: ezfio,provider,ocaml
+default: true
+
+[thresh_loc_max_elem_grad]
+type: double precision
+doc: Threshold for the convergence, the localization exits when the largest element in the gradient is smaller than thresh_localization_max_elem_grad.
+interface: ezfio,provider,ocaml
+default: 1.e-6
+
+[kick_in_mos]
+type: logical
+doc: If True, it applies a rotation of an angle angle_pre_rot between the MOs of a same mo_class before the localization.
+interface: ezfio,provider,ocaml
+default: true
+
+[angle_pre_rot]
+type: double precision
+doc: To define the angle for the rotation of the MOs before the localization (in rad).
+interface: ezfio,provider,ocaml
+default: 0.1
+
+[sort_mos_by_e]
+type: logical
+doc: If True, the MOs are sorted using the diagonal elements of the Fock matrix.
+interface: ezfio,provider,ocaml
+default: false
+
+[debug_hf]
+type: logical
+doc: If True, prints the HF energy before/after the different steps of the localization. Only for debugging.
+interface: ezfio,provider,ocaml
+default: false
+

src/mo_localization/NEED

@@ -0,0 +1,3 @@
+hartree_fock
+utils_trust_region
+determinants

src/mo_localization/README.md

@@ -0,0 +1,113 @@
+# Orbital localisation
+To localize the MOs:  
+```
+qp run localization  
+```
+By default, the different otbital classes are automatically set by splitting  
+the orbitales in the following classes:  
+- Core -> Core  
+- Active, doubly occupied -> Inactive  
+- Active, singly occupied -> Active  
+- Active, empty -> Virtual  
+- Deleted -> Deleted  
+The orbitals will be localized among each class, excpect the deleted ones.
+If you want to choose another splitting, you can set
+```
+qp set mo_localization auto_mo_class false
+```
+and define the classes with
+```
+qp set_mo_class -c [] -a [] -v [] -i [] -d [] 
+```
+for more information
+```
+qp set_mo_class -q
+```
+We don't care about the name of the   
+mo classes. The algorithm just localizes all the MOs of  
+a given class between them, for all the classes, except the deleted MOs.  
+If you are using the last option don't forget to reset the initial mo classes  
+after the localization.
+
+Before the localization, a kick is done for each mo class  
+(except the deleted ones) to break the MOs. This is done by   
+doing a given rotation between the MOs.
+This feature can be removed by setting:
+```
+qp set localization kick_in_mos false
+```
+and the default angle for the rotation can be changed with:
+```
+qp set localization angle_pre_rot 1e-3 # or something else
+```
+
+After the localization, the MOs of each class (except the deleted ones)  
+can be sorted between them using the diagonal elements of  
+the fock matrix with:
+```
+qp set localization sort_mos_by_e true
+```
+
+You can check the Hartree-Fock energy before/during/after the localization  
+by putting (only for debugging):
+```
+qp set localization debug_hf true 
+```
+
+## Foster-Boys & Pipek-Mezey
+Foster-Boys:  
+``` 
+qp set localization localization_method boys 
+``` 
+ 
+Pipek-Mezey:  
+``` 
+qp set localization localization_method pipek 
+``` 
+
+# Break the spatial symmetry of the MOs
+This program work exactly as the localization.  
+To break the spatial symmetry of the MOs:   
+```
+qp run break_spatial_sym
+```
+The default angle for the rotations is too big for this kind of
+application, a value between 1e-3 and 1e-6 should break the spatial
+symmetry with just a small change in the energy:
+```
+qp set localization angle_pre_rot 1e-3
+``` 
+
+# With or without hessian + trust region
+With hessian +  trust region
+```
+qp set localization localisation_use_hessian true
+```
+It uses the trust region algorithm with the diagonal of the hessian of the 
+localization criterion with respect to the MO rotations.   
+
+Without the hessian and the trust region
+```
+qp set localization localisation_use_hessian false
+```
+By doing so it does not require to store the hessian but the
+convergence is not easy, in particular for virtual MOs.
+It seems that it not possible to converge with Pipek-Mezey
+localization with this approach.
+
+# Parameters
+Some other parameters are available for the localization (qp edit for more details).
+
+# Tests
+```
+qp test
+```
+
+# Org files
+The org files are stored in the directory org in order to avoid overwriting on user changes.
+The org files can be modified, to export the change to the source code, run
+```
+./TANGLE_org_mode.sh
+mv *.irp.f ../.
+```
+ 

src/mo_localization/break_spatial_sym.irp.f

@@ -0,0 +1,27 @@
+! ! A small program to break the spatial symmetry of the MOs.
+
+! ! You have to defined your MO classes or set security_mo_class to false
+! ! with:
+! ! qp set orbital_optimization security_mo_class false
+
+! ! The default angle for the rotations is too big for this kind of
+! ! application, a value between 1e-3 and 1e-6 should break the spatial
+! ! symmetry with just a small change in the energy. 
+
+
+program break_spatial_sym
+
+  !BEGIN_DOC
+  ! Break the symmetry of the MOs with a rotation
+  !END_DOC
+
+  implicit none
+
+  kick_in_mos = .True.
+  TOUCH kick_in_mos
+
+  call set_classes_loc 
+  call apply_pre_rotation
+  call unset_classes_loc 
+  
+end

src/mo_localization/debug_gradient_loc.irp.f

@@ -0,0 +1,65 @@
+program debug_gradient_loc
+
+  !BEGIN_DOC
+  ! Check if the gradient is correct
+  !END_DOC
+
+  implicit none
+
+  integer :: list_size, n
+  integer, allocatable :: list(:)
+  double precision, allocatable :: v_grad(:), v_grad2(:)
+  double precision :: norm, max_elem, threshold, max_error
+  integer :: i, nb_error
+
+  threshold = 1d-12
+
+  list_size = dim_list_act_orb
+
+  allocate(list(list_size))
+  
+  list = list_act
+
+  n = list_size*(list_size-1)/2
+  
+  allocate(v_grad(n),v_grad2(n))
+
+  if (localization_method == 'boys') then
+    print*,'Foster-Boys'
+    call gradient_FB(n,list_size,list,v_grad,max_elem,norm)
+    call gradient_FB_omp(n,list_size,list,v_grad2,max_elem,norm)
+  elseif (localization_method == 'pipek') then
+    print*,'Pipek-Mezey'
+    call gradient_PM(n,list_size,list,v_grad,max_elem,norm)
+    call gradient_PM(n,list_size,list,v_grad2,max_elem,norm) 
+  else
+    print*,'Unknown localization_method, please select boys or pipek'
+    call abort
+  endif
+ 
+  do i = 1, n
+    print*,i,v_grad(i)
+  enddo
+
+  v_grad = v_grad - v_grad2
+
+  nb_error = 0
+  max_elem = 0d0
+
+  do i = 1, n
+    if (dabs(v_grad(i)) > threshold) then
+      print*,v_grad(i)
+      nb_error = nb_error + 1
+      if (dabs(v_grad(i)) > max_elem) then
+        max_elem = v_grad(i)
+      endif
+    endif
+  enddo
+
+  print*,'Threshold error', threshold
+  print*, 'Nb error', nb_error
+  print*,'Max error', max_elem
+
+  deallocate(v_grad,v_grad2)
+ 
+end

src/mo_localization/debug_hessian_loc.irp.f

@@ -0,0 +1,65 @@
+program debug_hessian_loc
+
+  !BEGIN_DOC
+  ! Check if the hessian is correct
+  !END_DOC
+  
+  implicit none
+
+  integer :: list_size, n
+  integer, allocatable :: list(:)
+  double precision, allocatable :: H(:), H2(:)
+  double precision :: threshold, max_error, max_elem
+  integer :: i, nb_error
+
+  threshold = 1d-12
+
+  list_size = dim_list_act_orb
+
+  allocate(list(list_size))
+  
+  list = list_act
+
+  n = list_size*(list_size-1)/2
+  
+  allocate(H(n),H2(n))
+
+  if (localization_method == 'boys') then
+    print*,'Foster-Boys'
+    call hessian_FB(n,list_size,list,H)
+    call hessian_FB_omp(n,list_size,list,H2)
+  elseif(localization_method == 'pipek') then
+    print*,'Pipek-Mezey'
+    call hessian_PM(n,list_size,list,H)
+    call hessian_PM(n,list_size,list,H2)
+  else
+    print*,'Unknown localization_method, please select boys or pipek'
+    call abort
+  endif
+ 
+  do i = 1, n
+    print*,i,H(i)
+  enddo
+
+  H = H - H2
+
+  nb_error = 0
+  max_elem = 0d0
+
+  do i = 1, n
+    if (dabs(H(i)) > threshold) then
+      print*,H(i)
+      nb_error = nb_error + 1
+      if (dabs(H(i)) > max_elem) then
+        max_elem = H(i)
+      endif
+    endif
+  enddo
+
+  print*,'Threshold error', threshold
+  print*, 'Nb error', nb_error
+  print*,'Max error', max_elem
+
+  deallocate(H,H2)
+  
+end

src/mo_localization/kick_the_mos.irp.f

@@ -0,0 +1,16 @@
+program kick_the_mos
+
+  !BEGIN_DOC
+  ! To do a small rotation of the MOs
+  !END_DOC
+
+  implicit none
+
+  kick_in_mos = .True.
+  TOUCH kick_in_mos
+
+  call set_classes_loc
+  call apply_pre_rotation
+  call unset_classes_loc
+  
+end

src/mo_localization/localization.irp.f

@@ -0,0 +1,520 @@
+program localization
+
+  implicit none
+
+  call set_classes_loc
+  call run_localization
+  call unset_classes_loc
+  
+end
+
+
+
+
+! Variables:
+! | pre_rot(mo_num, mo_num)   | double precision | Matrix for the pre rotation                       |
+! | R(mo_num,mo_num)          | double precision | Rotation matrix                                   |
+! | tmp_R(:,:)                | double precision | Rottation matrix in a subsapce                    |
+! | prev_mos(ao_num, mo_num)  | double precision | Previous mo_coef                                  |
+! | spatial_extent(mo_num)    | double precision | Spatial extent of the orbitals                    |
+! | criterion                 | double precision | Localization criterion                            |
+! | prev_criterion            | double precision | Previous criterion                                |
+! | criterion_model           | double precision | Estimated next criterion                          |
+! | rho                       | double precision | Ratio to measure the agreement between the model  |
+! |                           |                  | and the reality                                   |
+! | delta                     | double precision | Radisu of the trust region                        |
+! | norm_grad                 | double precision | Norm of the gradient                              |
+! | info                      | integer          | for dsyev from Lapack                             |
+! | max_elem                  | double precision | maximal element in the gradient                   |
+! | v_grad(:)                 | double precision | Gradient                                          |
+! | H(:,:)                    | double precision | Hessian (diagonal)                                |
+! | e_val(:)                  | double precision | Eigenvalues of the hessian                        |
+! | W(:,:)                    | double precision | Eigenvectors of the hessian                       |
+! | tmp_x(:)                  | double precision | Step in 1D (in a subaspace)                       |
+! | tmp_m_x(:,:)              | double precision | Step in 2D (in a subaspace)                       |
+! | tmp_list(:)               | double precision | List of MOs in a mo_class                         |
+! | i,j,k                     | integer          | Indexes in the full MO space                      |
+! | tmp_i, tmp_j, tmp_k       | integer          | Indexes in a subspace                             |
+! | l                         | integer          | Index for the mo_class                            |
+! | key(:)                    | integer          | Key to sort the eigenvalues of the hessian        |
+! | nb_iter                   | integer          | Number of iterations                              |
+! | must_exit                 | logical          | To exit the trust region loop                     |
+! | cancel_step               | logical          | To cancel a step                                  |
+! | not_*converged            | logical          | To localize the different mo classes              |
+! | t*                        | double precision | To measure the time                               |
+! | n                         | integer          | mo_num*(mo_num-1)/2, number of orbital parameters |
+! | tmp_n                     | integer          | dim_subspace*(dim_subspace-1)/2                   |
+! |                           |                  | Number of dimension in the subspace               |
+
+! Variables in qp_edit for the localization:
+! | localization_method      |
+! | localization_max_nb_iter |
+! | default_mo_class         |
+! | thresh_loc_max_elem_grad |
+! | kick_in_mos              |
+! | angle_pre_rot            |
+
+! + all the variables for the trust region
+
+! Cf. qp_edit orbital optimization
+
+
+subroutine run_localization
+
+  include 'pi.h'
+
+  BEGIN_DOC
+  ! Orbital localization
+  END_DOC
+
+  implicit none
+
+  ! Variables
+  double precision, allocatable :: pre_rot(:,:), R(:,:)
+  double precision, allocatable :: prev_mos(:,:), spatial_extent(:), tmp_R(:,:)
+  double precision              :: criterion, norm_grad
+  integer                       :: i,j,k,l,p, tmp_i, tmp_j, tmp_k
+  integer                       :: info
+  integer                       :: n, tmp_n, tmp_list_size
+  double precision, allocatable :: v_grad(:), H(:), tmp_m_x(:,:), tmp_x(:),W(:),e_val(:)
+  double precision              :: max_elem, t1, t2, t3, t4, t5, t6
+  integer, allocatable          :: tmp_list(:), key(:)
+  double precision              :: prev_criterion, rho, delta, criterion_model
+  integer                       :: nb_iter, nb_sub_iter
+  logical                       :: not_converged, not_core_converged
+  logical                       :: not_act_converged, not_inact_converged, not_virt_converged
+  logical                       :: use_trust_region, must_exit, cancel_step,enforce_step_cancellation
+
+  n = mo_num*(mo_num-1)/2
+
+  ! Allocation
+  allocate(spatial_extent(mo_num))
+  allocate(pre_rot(mo_num, mo_num), R(mo_num, mo_num))
+  allocate(prev_mos(ao_num, mo_num))
+
+  ! Locality before the localization
+  call compute_spatial_extent(spatial_extent)
+
+  ! Choice of the method
+  print*,''
+  print*,'Localization method:',localization_method
+  if (localization_method == 'boys') then
+    print*,'Foster-Boys localization'
+  elseif (localization_method == 'pipek') then
+    print*,'Pipek-Mezey localization'
+  else
+    print*,'Unknown localization_method, please select boys or pipek'
+    call abort
+  endif
+  print*,''
+
+  ! Localization criterion (FB, PM, ...) for each mo_class
+  print*,'### Before the pre rotation'
+  
+  ! Debug
+  if (debug_hf) then
+    print*,'HF energy:', HF_energy
+  endif
+  
+  do l = 1, 4
+    if (l==1) then ! core
+      tmp_list_size = dim_list_core_orb
+    elseif (l==2) then ! act
+      tmp_list_size = dim_list_act_orb
+    elseif (l==3) then ! inact
+      tmp_list_size = dim_list_inact_orb
+    else ! virt
+      tmp_list_size = dim_list_virt_orb
+    endif
+
+     ! Allocation tmp array  
+    allocate(tmp_list(tmp_list_size))
+
+    ! To give the list of MOs in a mo_class
+    if (l==1) then ! core
+      tmp_list = list_core
+    elseif (l==2) then
+      tmp_list = list_act
+    elseif (l==3) then
+      tmp_list = list_inact
+    else
+      tmp_list = list_virt
+    endif
+
+    if (tmp_list_size >= 2) then
+      call criterion_localization(tmp_list_size, tmp_list,criterion)
+      print*,'Criterion:', criterion, mo_class(tmp_list(1))
+    endif
+
+    deallocate(tmp_list)    
+
+  enddo
+
+  ! Debug
+  !print*,'HF', HF_energy
+
+! Loc
+
+! Pre rotation, to give a little kick in the MOs
+  call apply_pre_rotation()
+
+  ! Criterion after the pre rotation
+  ! Localization criterion (FB, PM, ...) for each mo_class
+  print*,'### After the pre rotation'
+  
+  ! Debug
+  if (debug_hf) then
+    touch mo_coef
+    print*,'HF energy:', HF_energy
+  endif
+  
+  do l = 1, 4
+    if (l==1) then ! core
+      tmp_list_size = dim_list_core_orb
+    elseif (l==2) then ! act
+      tmp_list_size = dim_list_act_orb
+    elseif (l==3) then ! inact
+      tmp_list_size = dim_list_inact_orb
+    else ! virt
+      tmp_list_size = dim_list_virt_orb
+    endif
+    
+    if (tmp_list_size >= 2) then
+      ! Allocation tmp array  
+      allocate(tmp_list(tmp_list_size))
+
+      ! To give the list of MOs in a mo_class
+      if (l==1) then ! core
+        tmp_list = list_core
+      elseif (l==2) then
+        tmp_list = list_act
+      elseif (l==3) then
+        tmp_list = list_inact
+      else
+        tmp_list = list_virt
+      endif
+
+      call criterion_localization(tmp_list_size, tmp_list,criterion)
+      print*,'Criterion:', criterion, trim(mo_class(tmp_list(1)))
+      
+      deallocate(tmp_list)    
+    endif
+    
+  enddo
+
+  ! Debug
+  !print*,'HF', HF_energy
+
+  print*,''
+  print*,'========================'
+  print*,'  Orbital localization'
+  print*,'========================'
+  print*,'' 
+
+  !Initialization
+  not_converged = .TRUE.
+
+  ! To do the localization only if there is at least 2 MOs
+  if (dim_list_core_orb >= 2) then
+    not_core_converged = .TRUE.
+  else
+    not_core_converged = .FALSE. 
+  endif
+  
+  if (dim_list_act_orb >= 2) then
+    not_act_converged = .TRUE.
+  else
+    not_act_converged = .FALSE.
+  endif
+
+  if (dim_list_inact_orb >= 2) then
+    not_inact_converged = .TRUE.
+  else
+    not_inact_converged = .FALSE.
+  endif
+
+  if (dim_list_virt_orb >= 2) then
+    not_virt_converged = .TRUE.
+  else
+    not_virt_converged = .FALSE.
+  endif
+ 
+  ! Loop over the mo_classes
+  do l = 1, 4
+
+    if (l==1) then ! core
+      not_converged = not_core_converged
+      tmp_list_size = dim_list_core_orb
+    elseif (l==2) then ! act
+      not_converged = not_act_converged
+      tmp_list_size = dim_list_act_orb
+    elseif (l==3) then ! inact
+      not_converged = not_inact_converged
+      tmp_list_size = dim_list_inact_orb
+    else ! virt
+      not_converged = not_virt_converged
+      tmp_list_size = dim_list_virt_orb
+    endif
+
+    ! Next iteration if converged = true 
+    if (.not. not_converged) then
+      cycle
+    endif
+ 
+    ! Allocation tmp array  
+    allocate(tmp_list(tmp_list_size))
+
+    ! To give the list of MOs in a mo_class
+    if (l==1) then ! core
+      tmp_list = list_core
+    elseif (l==2) then
+      tmp_list = list_act
+    elseif (l==3) then
+      tmp_list = list_inact
+    else
+      tmp_list = list_virt
+    endif
+
+    ! Display
+    if (not_converged) then
+      print*,''
+      print*,'###', trim(mo_class(tmp_list(1))), 'MOs ###'
+      print*,''
+    endif
+
+    ! Size for the 2D -> 1D transformation 
+    tmp_n = tmp_list_size * (tmp_list_size - 1)/2
+
+    ! Without hessian + trust region 
+    if (.not. localization_use_hessian) then
+       
+      ! Allocation of temporary arrays
+      allocate(v_grad(tmp_n), tmp_m_x(tmp_list_size, tmp_list_size))
+      allocate(tmp_R(tmp_list_size, tmp_list_size), tmp_x(tmp_n))
+
+      ! Criterion
+      call criterion_localization(tmp_list_size, tmp_list, prev_criterion)
+
+      ! Init
+      nb_iter = 0
+      delta = 1d0
+
+      !Loop
+      do while (not_converged)
+         
+        print*,''
+        print*,'***********************'
+        print*,'Iteration', nb_iter
+        print*,'***********************'
+        print*,''
+        
+        ! Angles of rotation
+        call theta_localization(tmp_list, tmp_list_size, tmp_m_x, max_elem)
+        tmp_m_x = - tmp_m_x * delta
+
+        ! Rotation submatrix
+        call rotation_matrix(tmp_m_x, tmp_list_size, tmp_R, tmp_list_size, tmp_list_size, &
+             info, enforce_step_cancellation)
+
+        ! To ensure that the rotation matrix is unitary
+        if (enforce_step_cancellation) then
+          print*, 'Step cancellation, too large error in the rotation matrix'
+          delta = delta * 0.5d0
+          cycle
+        else
+          delta = min(delta * 2d0, 1d0)
+        endif
+
+        ! Full rotation matrix and application of the rotation
+        call sub_to_full_rotation_matrix(tmp_list_size, tmp_list, tmp_R, R)
+        call apply_mo_rotation(R, prev_mos)
+
+        ! Update the needed data
+        call update_data_localization()
+
+        ! New criterion
+        call criterion_localization(tmp_list_size, tmp_list, criterion)
+        print*,'Criterion:', trim(mo_class(tmp_list(1))), nb_iter, criterion
+        print*,'Max elem :', max_elem
+        print*,'Delta    :', delta
+        
+        nb_iter = nb_iter + 1
+
+        ! Exit
+        if (nb_iter >= localization_max_nb_iter .or. dabs(max_elem) < thresh_loc_max_elem_grad) then
+           not_converged = .False.
+        endif
+      enddo
+
+      ! Save the changes
+      call update_data_localization()
+      call save_mos()
+      TOUCH mo_coef
+
+      ! Deallocate
+      deallocate(v_grad, tmp_m_x, tmp_list)
+      deallocate(tmp_R, tmp_x)
+
+    ! Trust region
+    else
+    
+      ! Allocation of temporary arrays
+      allocate(v_grad(tmp_n), H(tmp_n), tmp_m_x(tmp_list_size, tmp_list_size))
+      allocate(tmp_R(tmp_list_size, tmp_list_size))
+      allocate(tmp_x(tmp_n), W(tmp_n), e_val(tmp_n), key(tmp_n))
+
+      ! ### Initialization ###
+      delta = 0d0 ! can be deleted (normally)
+      nb_iter = 0 ! Must start at 0 !!!
+      rho = 0.5d0 ! Must be 0.5
+
+      ! Compute the criterion before the loop
+      call criterion_localization(tmp_list_size, tmp_list, prev_criterion)
+
+      ! Loop until the convergence
+      do while (not_converged)
+
+        print*,''
+        print*,'***********************'
+        print*,'Iteration', nb_iter
+        print*,'***********************'
+        print*,''
+  
+        ! Gradient
+        call gradient_localization(tmp_n, tmp_list_size, tmp_list, v_grad, max_elem, norm_grad)
+        ! Diagonal hessian
+        call hessian_localization(tmp_n, tmp_list_size, tmp_list, H)
+        
+        ! Diagonalization of the diagonal hessian by hands
+        !call diagonalization_hessian(tmp_n,H,e_val,w)
+        do i = 1, tmp_n
+          e_val(i) = H(i)
+        enddo
+
+        ! Key list for dsort
+        do i = 1, tmp_n 
+          key(i) = i
+        enddo
+
+        ! Sort of the eigenvalues
+        call dsort(e_val, key, tmp_n)
+
+        ! Eigenvectors
+        W = 0d0
+        do i = 1, tmp_n
+          W(i) = dble(key(i))
+        enddo
+
+        ! To enter in the loop just after
+        cancel_step = .True.
+        nb_sub_iter = 0 
+
+        ! Loop to reduce the trust radius until the criterion decreases and rho >= thresh_rho
+        do while (cancel_step)
+          print*,'-----------------------------'
+          print*, mo_class(tmp_list(1))
+          print*,'Iteration:', nb_iter
+          print*,'Sub iteration:', nb_sub_iter
+          print*,'Max elem grad:', max_elem
+          print*,'-----------------------------'
+
+          ! Hessian,gradient,Criterion -> x 
+          call trust_region_step_w_expected_e(tmp_n,1, H, W, e_val, v_grad, prev_criterion, &
+               rho, nb_iter, delta, criterion_model, tmp_x, must_exit)
+
+          ! Internal loop exit condition
+          if (must_exit) then
+            print*,'trust_region_step_w_expected_e sent: Exit'
+            exit 
+          endif
+
+          ! 1D tmp -> 2D tmp 
+          call vec_to_mat_v2(tmp_n, tmp_list_size, tmp_x, tmp_m_x)
+
+          ! Rotation submatrix (square matrix tmp_list_size by tmp_list_size)
+          call rotation_matrix(tmp_m_x, tmp_list_size, tmp_R, tmp_list_size, tmp_list_size, &
+               info, enforce_step_cancellation)
+
+          if (enforce_step_cancellation) then
+            print*, 'Step cancellation, too large error in the rotation matrix'
+            rho = 0d0
+            cycle
+          endif
+
+          ! tmp_R to R, subspace to full space
+          call sub_to_full_rotation_matrix(tmp_list_size, tmp_list, tmp_R, R)
+        
+          ! Rotation of the MOs
+          call apply_mo_rotation(R, prev_mos)   
+
+          ! Update the things related to mo_coef
+          call update_data_localization()
+
+          ! Update the criterion
+          call criterion_localization(tmp_list_size, tmp_list, criterion)
+          print*,'Criterion:', trim(mo_class(tmp_list(1))), nb_iter, criterion
+
+          ! Criterion -> step accepted or rejected 
+          call trust_region_is_step_cancelled(nb_iter, prev_criterion, criterion, &
+               criterion_model, rho, cancel_step)
+
+          ! Cancellation of the step, previous MOs
+          if (cancel_step) then
+            mo_coef = prev_mos
+          endif
+
+          nb_sub_iter = nb_sub_iter + 1
+        enddo
+        !call save_mos() !### depend of the time for 1 iteration
+
+        ! To exit the external loop if must_exti = .True.
+        if (must_exit) then
+          exit
+        endif 
+
+        ! Step accepted, nb iteration + 1
+        nb_iter = nb_iter + 1
+
+        ! External loop exit conditions
+        if (DABS(max_elem) < thresh_loc_max_elem_grad) then
+          not_converged = .False.
+        endif
+        if (nb_iter > localization_max_nb_iter) then
+          not_converged = .False.
+        endif
+      enddo
+
+      ! Deallocation of temporary arrays
+      deallocate(v_grad, H, tmp_m_x, tmp_R, tmp_list, tmp_x, W, e_val, key)
+      
+      ! Save the MOs
+      call save_mos()
+      TOUCH mo_coef
+ 
+      ! Debug
+      if (debug_hf) then
+        touch mo_coef
+        print*,'HF energy:', HF_energy
+      endif
+      
+    endif
+  enddo
+
+  ! Seems unecessary
+  TOUCH mo_coef 
+
+  ! To sort the MOs using the diagonal elements of the Fock matrix
+  if (sort_mos_by_e) then
+    call run_sort_by_fock_energies()
+  endif
+
+  ! Debug
+  if (debug_hf) then
+    touch mo_coef
+    print*,'HF energy:', HF_energy
+  endif
+
+  ! Locality after the localization
+  call compute_spatial_extent(spatial_extent)
+
+end

src/mo_localization/org/TANGLE_org_mode.sh

@@ -0,0 +1,7 @@
+#!/bin/sh   
+
+list='ls *.org'
+for element in $list    
+do   
+		emacs --batch $element -f org-babel-tangle
+done

src/mo_localization/org/break_spatial_sym.org

@@ -0,0 +1,28 @@
+! A small program to break the spatial symmetry of the MOs.
+
+! You have to defined your MO classes or set security_mo_class to false
+! with:
+! qp set orbital_optimization security_mo_class false
+
+! The default angle for the rotations is too big for this kind of
+! application, a value between 1e-3 and 1e-6 should break the spatial
+! symmetry with just a small change in the energy. 
+
+#+BEGIN_SRC f90 :comments org :tangle break_spatial_sym.irp.f
+program break_spatial_sym
+
+  !BEGIN_DOC
+  ! Break the symmetry of the MOs with a rotation
+  !END_DOC
+
+  implicit none
+
+  kick_in_mos = .True.
+  TOUCH kick_in_mos
+
+  call set_classes_loc 
+  call apply_pre_rotation
+  call unset_classes_loc 
+  
+end
+#+END_SRC

src/mo_localization/org/debug_gradient_loc.org

@@ -0,0 +1,67 @@
+#+BEGIN_SRC f90 :comments org :tangle debug_gradient_loc.irp.f
+program debug_gradient_loc
+
+  !BEGIN_DOC
+  ! Check if the gradient is correct
+  !END_DOC
+
+  implicit none
+
+  integer :: list_size, n
+  integer, allocatable :: list(:)
+  double precision, allocatable :: v_grad(:), v_grad2(:)
+  double precision :: norm, max_elem, threshold, max_error
+  integer :: i, nb_error
+
+  threshold = 1d-12
+
+  list_size = dim_list_act_orb
+
+  allocate(list(list_size))
+  
+  list = list_act
+
+  n = list_size*(list_size-1)/2
+  
+  allocate(v_grad(n),v_grad2(n))
+
+  if (localization_method == 'boys') then
+    print*,'Foster-Boys'
+    call gradient_FB(n,list_size,list,v_grad,max_elem,norm)
+    call gradient_FB_omp(n,list_size,list,v_grad2,max_elem,norm)
+  elseif (localization_method == 'pipek') then
+    print*,'Pipek-Mezey'
+    call gradient_PM(n,list_size,list,v_grad,max_elem,norm)
+    call gradient_PM(n,list_size,list,v_grad2,max_elem,norm) 
+  else
+    print*,'Unknown localization_method, please select boys or pipek'
+    call abort
+  endif
+ 
+  do i = 1, n
+    print*,i,v_grad(i)
+  enddo
+
+  v_grad = v_grad - v_grad2
+
+  nb_error = 0
+  max_elem = 0d0
+
+  do i = 1, n
+    if (dabs(v_grad(i)) > threshold) then
+      print*,v_grad(i)
+      nb_error = nb_error + 1
+      if (dabs(v_grad(i)) > max_elem) then
+        max_elem = v_grad(i)
+      endif
+    endif
+  enddo
+
+  print*,'Threshold error', threshold
+  print*, 'Nb error', nb_error
+  print*,'Max error', max_elem
+
+  deallocate(v_grad,v_grad2)
+ 
+end
+#+END_SRC

src/mo_localization/org/debug_hessian_loc.org

@@ -0,0 +1,67 @@
+#+BEGIN_SRC f90 :comments org :tangle debug_hessian_loc.irp.f
+program debug_hessian_loc
+
+  !BEGIN_DOC
+  ! Check if the hessian is correct
+  !END_DOC
+  
+  implicit none
+
+  integer :: list_size, n
+  integer, allocatable :: list(:)
+  double precision, allocatable :: H(:), H2(:)
+  double precision :: threshold, max_error, max_elem
+  integer :: i, nb_error
+
+  threshold = 1d-12
+
+  list_size = dim_list_act_orb
+
+  allocate(list(list_size))
+  
+  list = list_act
+
+  n = list_size*(list_size-1)/2
+  
+  allocate(H(n),H2(n))
+
+  if (localization_method == 'boys') then
+    print*,'Foster-Boys'
+    call hessian_FB(n,list_size,list,H)
+    call hessian_FB_omp(n,list_size,list,H2)
+  elseif(localization_method == 'pipek') then
+    print*,'Pipek-Mezey'
+    call hessian_PM(n,list_size,list,H)
+    call hessian_PM(n,list_size,list,H2)
+  else
+    print*,'Unknown localization_method, please select boys or pipek'
+    call abort
+  endif
+ 
+  do i = 1, n
+    print*,i,H(i)
+  enddo
+
+  H = H - H2
+
+  nb_error = 0
+  max_elem = 0d0
+
+  do i = 1, n
+    if (dabs(H(i)) > threshold) then
+      print*,H(i)
+      nb_error = nb_error + 1
+      if (dabs(H(i)) > max_elem) then
+        max_elem = H(i)
+      endif
+    endif
+  enddo
+
+  print*,'Threshold error', threshold
+  print*, 'Nb error', nb_error
+  print*,'Max error', max_elem
+
+  deallocate(H,H2)
+  
+end
+#+END_SRC

src/mo_localization/org/kick_the_mos.org

@@ -0,0 +1,18 @@
+#+BEGIN_SRC f90 :comments org :tangle kick_the_mos.irp.f
+program kick_the_mos
+
+  !BEGIN_DOC
+  ! To do a small rotation of the MOs
+  !END_DOC
+
+  implicit none
+
+  kick_in_mos = .True.
+  TOUCH kick_in_mos
+
+  call set_classes_loc
+  call apply_pre_rotation
+  call unset_classes_loc
+  
+end
+#+END_SRC

src/mo_optimization/83.mo_optimization.bats

@@ -0,0 +1,62 @@
+#!/usr/bin/env bats
+
+source $QP_ROOT/tests/bats/common.bats.sh
+source $QP_ROOT/quantum_package.rc
+
+
+function run() {
+  thresh=2e-3
+  test_exe scf || skip
+  qp set_file $1
+  qp edit --check
+  qp reset -a
+  qp run scf
+  qp set_frozen_core
+  qp set determinants n_states 2
+  qp set determinants read_wf true
+  qp set mo_two_e_ints io_mo_two_e_integrals None
+  file="$(echo $1 | sed 's/.ezfio//g')"
+  qp run cis
+  qp run debug_gradient_list_opt > $file.debug_g.out
+  err3="$(grep 'Max error:' $file.debug_g.out | awk '{print $3}')"
+  qp run debug_hessian_list_opt > $file.debug_h1.out
+  err1="$(grep 'Max error:' $file.debug_h1.out | awk '{print $3}')"
+  qp run orb_opt > $file.opt1.out
+  energy1="$(grep 'State average energy:' $file.opt1.out | tail -n 1 | awk '{print $4}')"
+  qp set orbital_optimization optimization_method diag
+  qp reset -d 
+  qp run scf
+  qp run cis
+  qp run debug_hessian_list_opt > $file.debug_h2.out
+  err2="$(grep 'Max error_H:' $file.debug_h2.out | awk '{print $3}')"
+  qp run orb_opt > $file.opt2.out
+  energy2="$(grep 'State average energy:' $file.opt2.out | tail -n 1 | awk '{print $4}')"
+  qp set orbital_optimization optimization_method full
+  qp reset -d
+  qp run scf
+  eq $energy1 $2 $thresh
+  eq $energy2 $3 $thresh
+  eq $err1 0.0 1e-12
+  eq $err2 0.0 1e-12
+  eq $err3 0.0 1e-12
+}
+
+@test "b2_stretched" {
+run  b2_stretched.ezfio -48.9852901484277 -48.9852937541510
+}
+
+@test "h2o" {
+run  h2o.ezfio -75.9025622449206 -75.8691844585879
+}
+
+@test "h2s" {
+run  h2s.ezfio -398.576255809878 -398.574145943928
+}
+
+@test "hbo" {
+run  hbo.ezfio -99.9234823022109 -99.9234763597840
+}
+
+@test "hco" {
+run  hco.ezfio -113.204915552241 -113.204905207050
+}

src/mo_optimization/EZFIO.cfg

@@ -0,0 +1,23 @@
+[optimization_method]
+type: character*(32)
+doc: Define the kind of hessian for the orbital optimization full : full hessian, diag : diagonal hessian, none : no hessian
+interface: ezfio,provider,ocaml
+default: full
+
+[n_det_max_opt]
+type: integer
+doc: Maximal number of the determinants in the wf for the orbital optimization (to stop the optimization if n_det > n_det_max_opt)
+interface: ezfio,provider,ocaml
+default: 200000
+
+[optimization_max_nb_iter]
+type: integer
+doc: Maximal number of iterations for the orbital optimization
+interface: ezfio,provider,ocaml
+default: 20
+
+[thresh_opt_max_elem_grad]
+type: double precision
+doc: Threshold for the convergence, the optimization exits when the biggest element in the gradient is smaller than thresh_optimization_max_elem_grad
+interface: ezfio,provider,ocaml
+default: 1.e-5

src/mo_optimization/NEED

@@ -0,0 +1,7 @@
+two_body_rdm
+hartree_fock
+cipsi
+davidson_undressed
+selectors_full
+generators_full
+utils_trust_region

src/mo_optimization/README.md

@@ -0,0 +1,74 @@
+# Orbital optimization
+
+## Methods  
+Different methods are available:  
+- full hessian  
+``` 
+qp set orbital_optimization optimization_method full  
+```  
+- diagonal hessian  
+``` 
+qp set orbital_optimization optimization_method diag  
+``` 
+- identity matrix  
+``` 
+qp set orbital_optimization optimization_method none  
+``` 
+
+After the optimization the ezfio contains the optimized orbitals
+ 
+## For a fixed number of determinants
+To optimize the MOs for the actual determinants:  
+``` 
+qp run orb_opt
+``` 
+ 
+## For a complete optimization, i.e, with a larger and larger wave function
+To optimize the MOs with a larger and larger wave function:  
+``` 
+qp run optimization  
+``` 
+
+The results are stored in the EZFIO in "mo_optimization/result_opt",
+with the following format:  
+(1) (2) (3) (4)  
+1: Number of determinants in the wf,  
+2: Cispi energy before the optimization,   
+3: Cipsi energy after the optimization,  
+4: Energy difference between (2) and (3).  
+ 
+The optimization process if the following: 
+- we do a first cipsi step to obtain a small number of determinants in the wf 
+- we run an orbital optimization for this wf 
+- we do a new cipsi step to double the number of determinants in the wf 
+- we run an orbital optimization for this wf 
+- ... 
+- we do that until the energy difference between (2) and (3) is  
+  smaller than the targeted accuracy for the cispi (targeted_accuracy_cipsi in qp edit) 
+  or the wf is larger than a given size (n_det_max_opt in qp_edit) 
+- after that you can reset your determinants (qp reset -d) and run a clean Cispi calculation  
+  
+### End of the optimization
+You can choos the number of determinants after what the 
+optimization will stop:
+```
+qp set orbital_optimization n_det_max_opt 1e5 # or any number
+```
+## Weight of the states
+You can change the weights of the differents states directly in qp edit.  
+It will affect ths weights used in the orbital optimization.
+
+# Tests
+To run the tests:  
+``` 
+qp test
+``` 
+
+# Org files
+The org files are stored in the directory org in order to avoid overwriting on user changes.
+The org files can be modified, to export the change to the source code, run
+```
+./TANGLE_org_mode.sh
+mv *.irp.f ../.
+```
+

src/mo_optimization/class.irp.f

@@ -0,0 +1,12 @@
+ BEGIN_PROVIDER [ logical, do_only_1h1p ]
+&BEGIN_PROVIDER [ logical, do_only_cas  ]
+&BEGIN_PROVIDER [ logical, do_ddci ]
+ implicit none
+ BEGIN_DOC
+ ! In the FCI case, all those are always false
+ END_DOC
+ do_only_1h1p = .False.
+ do_only_cas  = .False.
+ do_ddci = .False.
+END_PROVIDER
+

src/mo_optimization/constants.h

@@ -0,0 +1 @@
+  logical, parameter :: debug=.False.

src/mo_optimization/debug_gradient_list_opt.irp.f

@@ -0,0 +1,78 @@
+! Debug the gradient
+
+! *Program to check the gradient*
+
+! The program compares the result of the first and last code for the
+! gradient.
+
+! Provided:
+! | mo_num | integer | number of MOs |
+
+! Internal:
+! | n          | integer          | number of orbitals pairs (p,q) p<q |
+! | v_grad(n)  | double precision | Original gradient                  |
+! | v_grad2(n) | double precision | Gradient                           |
+! | i          | integer          | index                              |
+! | threshold  | double precision | threshold for the errors           |
+! | max_error  | double precision | maximal error in the gradient      |
+! | nb_error   | integer          | number of error in the gradient    |
+
+
+program debug_gradient_list
+  
+  implicit none
+
+  ! Variables
+
+  double precision, allocatable :: v_grad(:), v_grad2(:)
+  integer                       :: n,m
+  integer                       :: i
+  double precision              :: threshold
+  double precision              :: max_error, max_elem, norm
+  integer                       :: nb_error
+  
+  m = dim_list_act_orb
+  ! Definition of n  
+  n = m*(m-1)/2
+
+  PROVIDE mo_two_e_integrals_in_map ! Vérifier pour suppression
+
+  ! Allocation
+  allocate(v_grad(n), v_grad2(n))
+
+  ! Calculation
+
+  call diagonalize_ci ! Vérifier pour suppression
+
+  ! Gradient  
+  call gradient_list_opt(n,m,list_act,v_grad,max_elem,norm)
+  call first_gradient_list_opt(n,m,list_act,v_grad2)
+  
+  
+  v_grad = v_grad - v_grad2
+  nb_error = 0
+  max_error = 0d0 
+  threshold = 1d-12 
+
+  do i = 1, n
+    if (ABS(v_grad(i)) > threshold) then
+       print*,i,v_grad(i)
+       nb_error = nb_error + 1
+
+       if (ABS(v_grad(i)) > max_error) then
+         max_error = v_grad(i)
+       endif
+
+    endif
+  enddo
+ 
+  print*,''
+  print*,'Check the gradient' 
+  print*,'Threshold:', threshold
+  print*,'Nb error:', nb_error
+  print*,'Max error:', max_error
+
+  ! Deallocation
+  deallocate(v_grad,v_grad2)
+
+end program

src/mo_optimization/debug_gradient_opt.irp.f

@@ -0,0 +1,76 @@
+! Debug the gradient
+
+! *Program to check the gradient*
+
+! The program compares the result of the first and last code for the
+! gradient.
+
+! Provided:
+! | mo_num | integer | number of MOs |
+
+! Internal:
+! | n          | integer          | number of orbitals pairs (p,q) p<q |
+! | v_grad(n)  | double precision | Original gradient                  |
+! | v_grad2(n) | double precision | Gradient                           |
+! | i          | integer          | index                              |
+! | threshold  | double precision | threshold for the errors           |
+! | max_error  | double precision | maximal error in the gradient      |
+! | nb_error   | integer          | number of error in the gradient    |
+
+
+program debug_gradient
+  
+  implicit none
+
+  ! Variables
+
+  double precision, allocatable :: v_grad(:), v_grad2(:)
+  integer                       :: n
+  integer                       :: i
+  double precision              :: threshold
+  double precision              :: max_error, max_elem
+  integer                       :: nb_error
+  
+  ! Definition of n  
+  n = mo_num*(mo_num-1)/2
+
+  PROVIDE mo_two_e_integrals_in_map ! Vérifier pour suppression
+
+  ! Allocation
+  allocate(v_grad(n), v_grad2(n))
+
+  ! Calculation
+
+  call diagonalize_ci ! Vérifier pour suppression
+
+  ! Gradient  
+  call first_gradient_opt(n,v_grad)
+  call gradient_opt(n,v_grad2,max_elem)
+  
+  v_grad = v_grad - v_grad2
+  nb_error = 0
+  max_error = 0d0 
+  threshold = 1d-12 
+
+  do i = 1, n
+    if (ABS(v_grad(i)) > threshold) then
+       print*,v_grad(i)
+       nb_error = nb_error + 1
+
+       if (ABS(v_grad(i)) > max_error) then
+         max_error = v_grad(i)
+       endif
+
+    endif
+  enddo
+ 
+  print*,''
+  print*,'Check the gradient' 
+  print*,'Threshold :', threshold
+  print*,'Nb error :', nb_error
+  print*,'Max error :', max_error
+
+  ! Deallocation
+  deallocate(v_grad,v_grad2)
+
+end program

src/mo_optimization/debug_hessian_list_opt.irp.f

@@ -0,0 +1,147 @@
+! Debug the hessian
+
+! *Program to check the hessian matrix*
+
+! The program compares the result of the first and last code for the
+! hessian. First of all the 4D hessian and after the 2D hessian.
+
+! Provided:
+! | mo_num                     | integer | number of MOs                        |
+! | optimization_method        | string  | Method for the orbital optimization: |
+! |                            |         | - 'full' -> full hessian             |
+! |                            |         | - 'diag' -> diagonal hessian         |
+! | dim_list_act_orb           | integer | number of active MOs                 |
+! | list_act(dim_list_act_orb) | integer | list of the actives MOs              |
+! |                            |         |                                      |
+
+! Internal:
+! | m                                 | integer          | number of MOs in the list          |
+! |                                   |                  | (active MOs)                       |
+! | n                                 | integer          | number of orbitals pairs (p,q) p<q |
+! |                                   |                  | n = m*(m-1)/2                      |
+! | H(n,n)                            | double precision | Original hessian matrix (2D)       |
+! | H2(n,n)                           | double precision | Hessian matrix (2D)                |
+! | h_f(mo_num,mo_num,mo_num,mo_num)  | double precision | Original hessian matrix (4D)       |
+! | h_f2(mo_num,mo_num,mo_num,mo_num) | double precision | Hessian matrix (4D)                |
+! | i,j,p,q,k                         | integer          | indexes                            |
+! | threshold                         | double precision | threshold for the errors           |
+! | max_error                         | double precision | maximal error in the 4D hessian    |
+! | max_error_H                       | double precision | maximal error in the 2D hessian    |
+! | nb_error                          | integer          | number of errors in the 4D hessian |
+! | nb_error_H                        | integer          | number of errors in the 2D hessian |
+
+
+program debug_hessian_list_opt
+
+  implicit none
+
+  ! Variables
+
+  double precision, allocatable :: H(:,:),H2(:,:), h_f(:,:,:,:), h_f2(:,:,:,:)
+  integer                       :: n,m
+  integer                       :: i,j,k,l
+  double precision              :: max_error, max_error_H
+  integer                       :: nb_error, nb_error_H
+  double precision              :: threshold
+  
+  m = dim_list_act_orb !mo_num
+
+  ! Definition of n  
+  n = m*(m-1)/2
+
+  PROVIDE mo_two_e_integrals_in_map ! Vérifier pour suppression
+
+  ! Hessian 
+  if (optimization_method == 'full') then
+    print*,'Use the full hessian matrix'
+    allocate(H(n,n),H2(n,n))  
+    allocate(h_f(m,m,m,m),h_f2(m,m,m,m))
+
+    call hessian_list_opt(n,m,list_act,H,h_f)
+    call first_hessian_list_opt(n,m,list_act,H2,h_f2)
+    !call hessian_opt(n,H2,h_f2)
+
+    ! Difference
+    h_f = h_f - h_f2
+    H = H - H2
+    max_error = 0d0
+    nb_error = 0    
+    threshold = 1d-12
+
+    do l = 1, m
+      do k= 1, m
+        do j = 1, m
+          do i = 1, m
+            if (ABS(h_f(i,j,k,l)) > threshold) then
+              print*,h_f(i,j,k,l)
+              nb_error = nb_error + 1
+              if (ABS(h_f(i,j,k,l)) > ABS(max_error)) then
+                max_error = h_f(i,j,k,l)
+              endif
+            endif
+          enddo
+        enddo
+      enddo
+    enddo
+
+    max_error_H = 0d0
+    nb_error_H = 0
+
+    do j = 1, n
+      do i = 1, n
+        if (ABS(H(i,j)) > threshold) then
+          print*, H(i,j)
+          nb_error_H = nb_error_H + 1
+
+          if (ABS(H(i,j)) > ABS(max_error_H)) then
+            max_error_H = H(i,j)
+          endif
+
+        endif
+      enddo
+    enddo 
+
+    ! Deallocation
+    deallocate(H, H2, h_f, h_f2)
+
+  else
+
+    print*, 'Use the diagonal hessian matrix'
+    allocate(H(n,1),H2(n,1))
+    call diag_hessian_list_opt(n,m,list_act,H)
+    call first_diag_hessian_list_opt(n,m,list_act,H2)
+    
+    H = H - H2
+  
+    max_error_H = 0d0
+    nb_error_H = 0
+ 
+    do i = 1, n
+      if (ABS(H(i,1)) > threshold) then
+        print*, H(i,1)
+        nb_error_H = nb_error_H + 1
+ 
+        if (ABS(H(i,1)) > ABS(max_error_H)) then
+          max_error_H = H(i,1)
+        endif
+ 
+      endif
+    enddo
+   
+ endif
+  
+  print*,''
+  if (optimization_method == 'full') then
+    print*,'Check of the full hessian'
+    print*,'Threshold:', threshold
+    print*,'Nb error:', nb_error
+    print*,'Max error:', max_error
+    print*,''
+  else
+    print*,'Check of the diagonal hessian'
+  endif
+   
+  print*,'Nb error_H:', nb_error_H
+  print*,'Max error_H:', max_error_H
+ 
+end program

src/mo_optimization/debug_hessian_opt.irp.f

@@ -0,0 +1,171 @@
+! Debug the hessian
+
+! *Program to check the hessian matrix*
+
+! The program compares the result of the first and last code for the
+! hessian. First of all the 4D hessian and after the 2D hessian.
+
+! Provided:
+! | mo_num | integer | number of MOs |
+
+! Internal:
+! | n                                 | integer          | number of orbitals pairs (p,q) p<q |
+! | H(n,n)                            | double precision | Original hessian matrix (2D)       |
+! | H2(n,n)                           | double precision | Hessian matrix (2D)                |
+! | h_f(mo_num,mo_num,mo_num,mo_num)  | double precision | Original hessian matrix (4D)       |
+! | h_f2(mo_num,mo_num,mo_num,mo_num) | double precision | Hessian matrix (4D)                |
+! | method                            | integer          | - 1: full hessian                  |
+! |                                   |                  | - 2: diagonal hessian              |
+! | i,j,p,q,k                         | integer          | indexes                            |
+! | threshold                         | double precision | threshold for the errors           |
+! | max_error                         | double precision | maximal error in the 4D hessian    |
+! | max_error_H                       | double precision | maximal error in the 2D hessian    |
+! | nb_error                          | integer          | number of errors in the 4D hessian |
+! | nb_error_H                        | integer          | number of errors in the 2D hessian |
+
+
+program debug_hessian
+
+  implicit none
+
+  ! Variables
+
+  double precision, allocatable :: H(:,:),H2(:,:), h_f(:,:,:,:), h_f2(:,:,:,:)
+  integer                       :: n
+  integer                       :: i,j,k,l
+  double precision              :: max_error, max_error_H
+  integer                       :: nb_error, nb_error_H
+  double precision              :: threshold
+  
+  ! Definition of n  
+  n = mo_num*(mo_num-1)/2
+
+  PROVIDE mo_two_e_integrals_in_map ! Vérifier pour suppression
+
+  ! Allocation
+  allocate(H(n,n),H2(n,n))  
+  allocate(h_f(mo_num,mo_num,mo_num,mo_num),h_f2(mo_num,mo_num,mo_num,mo_num))
+
+  ! Calculation
+  
+  ! Hessian 
+  if (optimization_method == 'full') then 
+
+    print*,'Use the full hessian matrix'
+    call hessian_opt(n,H,h_f)
+    call first_hessian_opt(n,H2,h_f2)
+
+    ! Difference
+    h_f = h_f - h_f2
+    H = H - H2
+    max_error = 0d0
+    nb_error = 0    
+    threshold = 1d-12
+
+    do l = 1, mo_num
+      do k= 1, mo_num
+        do j = 1, mo_num
+          do i = 1, mo_num
+            if (ABS(h_f(i,j,k,l)) > threshold) then
+              print*,h_f(i,j,k,l)
+              nb_error = nb_error + 1
+              if (ABS(h_f(i,j,k,l)) > ABS(max_error)) then
+                max_error = h_f(i,j,k,l)
+              endif
+            endif
+          enddo
+        enddo
+      enddo
+    enddo
+
+   max_error_H = 0d0
+   nb_error_H = 0
+
+   do j = 1, n
+     do i = 1, n
+       if (ABS(H(i,j)) > threshold) then
+         print*, H(i,j)
+         nb_error_H = nb_error_H + 1
+
+         if (ABS(H(i,j)) > ABS(max_error_H)) then
+           max_error_H = H(i,j)
+         endif
+
+       endif
+     enddo
+   enddo 
+
+  elseif (optimization_method == 'diag') then
+
+    print*, 'Use the diagonal hessian matrix'
+    call diag_hessian_opt(n,H,h_f)
+    call first_diag_hessian_opt(n,H2,h_f2)
+
+    h_f = h_f - h_f2
+    max_error = 0d0
+    nb_error = 0
+    threshold = 1d-12
+
+    do l = 1, mo_num
+      do k = 1, mo_num
+        do j = 1, mo_num
+          do i = 1, mo_num
+
+            if (ABS(h_f(i,j,k,l)) > threshold) then
+
+              print*,h_f(i,j,k,l)
+              nb_error = nb_error + 1
+
+              if (ABS(h_f(i,j,k,l)) > ABS(max_error)) then
+                max_error = h_f(i,j,k,l)
+              endif
+
+            endif
+
+          enddo
+        enddo
+      enddo
+    enddo
+
+    h=H-H2
+  
+    max_error_H = 0d0
+    nb_error_H = 0
+ 
+    do j = 1, n
+      do i = 1, n
+        if (ABS(H(i,j)) > threshold) then
+          print*, H(i,j)
+          nb_error_H = nb_error_H + 1
+ 
+          if (ABS(H(i,j)) > ABS(max_error_H)) then
+            max_error_H = H(i,j)
+          endif
+ 
+        endif
+      enddo
+    enddo
+  
+  else
+    print*,'Unknown optimization_method, please select full, diag'
+    call abort
+  endif
+  
+  print*,''
+  if (optimization_method == 'full') then
+    print*,'Check the full hessian'
+  else
+    print*,'Check the diagonal hessian'
+  endif
+   
+  print*,'Threshold :', threshold
+  print*,'Nb error :', nb_error
+  print*,'Max error :', max_error
+  print*,''
+  print*,'Nb error_H :', nb_error_H
+  print*,'Max error_H :', max_error_H
+ 
+  ! Deallocation
+  deallocate(H,H2,h_f,h_f2)
+
+end program

src/mo_optimization/diagonalization_hessian.irp.f

@@ -0,0 +1,136 @@
+! Diagonalization of the hessian
+
+! Just a matrix diagonalization using Lapack
+
+! Input:
+! | n      | integer          | mo_num*(mo_num-1)/2 |
+! | H(n,n) | double precision | hessian             |
+
+! Output:
+! | e_val(n) | double precision | eigenvalues of the hessian  |
+! | w(n,n)   | double precision | eigenvectors of the hessian |
+
+! Internal:
+! | nb_negative_nv | integer          | number of negative eigenvalues                  |
+! | lwork          | integer          | for Lapack                                      |
+! | work(lwork,n)  | double precision | temporary array for Lapack                      |
+! | info           | integer          | if 0 -> ok, else problem in the diagonalization |
+! | i,j            | integer          | dummy indexes                                   |
+
+
+subroutine diagonalization_hessian(n,H,e_val,w)
+
+  include 'constants.h'
+
+  implicit none
+
+  ! Variables
+
+  ! in
+  integer, intent(in) :: n
+  double precision, intent(in) :: H(n,n)
+
+  ! out
+  double precision, intent(out) :: e_val(n), w(n,n)
+
+  ! internal
+  double precision, allocatable :: work(:,:)
+  integer, allocatable          :: key(:)
+  integer                       :: info,lwork
+  integer                       :: i,j
+  integer                       :: nb_negative_vp
+  double precision              :: t1,t2,t3,max_elem
+
+  print*,''
+  print*,'---Diagonalization_hessian---'
+
+  call wall_time(t1)
+
+  if (optimization_method == 'full') then
+    ! Allocation
+    ! For Lapack
+    lwork=3*n-1
+
+    allocate(work(lwork,n))
+
+    ! Calculation
+
+    ! Copy the hessian matrix, the eigenvectors will be store in W
+    W=H
+
+    ! Diagonalization of the hessian
+    call dsyev('V','U',n,W,size(W,1),e_val,work,lwork,info)
+
+    if (info /= 0) then
+        print*, 'Error diagonalization : diagonalization_hessian'
+        print*, 'info = ', info
+        call ABORT
+    endif
+
+    if (debug) then
+      print *, 'vp Hess:'
+      write(*,'(100(F10.5))')  real(e_val(:))
+    endif
+
+    ! Number of negative eigenvalues
+    max_elem = 0d0
+    nb_negative_vp = 0
+    do i = 1, n
+      if (e_val(i) < 0d0) then
+        nb_negative_vp = nb_negative_vp + 1
+        if (e_val(i) < max_elem) then
+          max_elem = e_val(i)
+        endif
+        !print*,'e_val < 0 :', e_val(i)
+      endif
+    enddo
+    print*,'Number of negative eigenvalues:', nb_negative_vp
+    print*,'Lowest eigenvalue:',max_elem
+
+    !nb_negative_vp = 0
+    !do i = 1, n
+    !  if (e_val(i) < -thresh_eig) then
+    !    nb_negative_vp = nb_negative_vp + 1
+    !  endif
+    !enddo
+    !print*,'Number of negative eigenvalues <', -thresh_eig,':', nb_negative_vp  
+
+    ! Deallocation
+    deallocate(work)
+
+  elseif (optimization_method == 'diag') then
+    ! Diagonalization of the diagonal hessian by hands
+    allocate(key(n))
+    
+    do i = 1, n
+      e_val(i) = H(i,i)
+    enddo
+
+    ! Key list for dsort
+    do i = 1, n 
+      key(i) = i
+    enddo
+
+    ! Sort of the eigenvalues
+    call dsort(e_val, key, n)
+
+    ! Eigenvectors
+    W = 0d0
+    do i = 1, n
+      j = key(i)
+      W(j,i) = 1d0
+    enddo
+
+    deallocate(key)
+  else
+    print*,'Diagonalization_hessian, abort'
+    call abort
+  endif
+
+  call wall_time(t2)
+  t3 = t2 - t1
+  print*,'Time in diagonalization_hessian:', t3
+
+  print*,'---End diagonalization_hessian---'
+
+end subroutine

src/mo_optimization/first_diagonal_hessian_list_opt.irp.f

@@ -0,0 +1,372 @@
+subroutine first_diag_hessian_list_opt(tmp_n,m,list,H)!, h_tmpr)
+
+  include 'constants.h' 
+
+  implicit none
+
+  !===========================================================================
+  ! Compute the diagonal hessian of energy with respects to orbital rotations
+  !===========================================================================
+
+  !===========
+  ! Variables 
+  !===========
+ 
+  ! in
+  integer, intent(in)           :: tmp_n, m, list(m) 
+  ! tmp_n        : integer, tmp_n = m*(m-1)/2
+ 
+  ! out
+  double precision, intent(out) :: H(tmp_n)!, h_tmpr(m,m,m,m)
+  ! H        : n by n double precision matrix containing the 2D hessian
+  
+  ! internal
+  double precision, allocatable :: hessian(:,:,:,:), tmp(:,:),h_tmpr(:,:,:,:)
+  integer                       :: p,q, tmp_p,tmp_q
+  integer                       :: r,s,t,u,v,tmp_r,tmp_s,tmp_t,tmp_u,tmp_v
+  integer                       :: pq,rs,tmp_pq,tmp_rs
+  double precision              :: t1,t2,t3
+  ! hessian  : mo_num 4D double precision matrix containing the hessian before the permutations
+  ! h_tmpr   : mo_num 4D double precision matrix containing the hessian after the permutations
+  ! p,q,r,s  : integer, indexes of the 4D hessian matrix
+  ! t,u,v    : integer, indexes to compute hessian elements
+  ! pq,rs    : integer, indexes for the conversion from 4D to 2D hessian matrix
+  ! t1,t2,t3 : double precision, t3 = t2 - t1, time to compute the hessian 
+  
+  ! Function
+  double precision :: get_two_e_integral
+  ! get_two_e_integral : double precision function, two e integrals
+ 
+  ! Provided :
+  ! mo_one_e_integrals : mono e- integrals
+  ! get_two_e_integral : two e- integrals
+  ! one_e_dm_mo_alpha, one_e_dm_mo_beta : one body density matrix
+  ! two_e_dm_mo : two body density matrix
+
+  print*,'---first_diag_hess_list---'
+
+  !============
+  ! Allocation
+  !============
+  
+  allocate(hessian(m,m,m,m),tmp(tmp_n,tmp_n),h_tmpr(mo_num,mo_num,mo_num,mo_num))
+
+  !=============
+  ! Calculation
+  !=============
+
+  ! From Anderson et. al. (2014) 
+  ! The Journal of Chemical Physics 141, 244104 (2014); doi: 10.1063/1.4904384
+
+  ! LaTeX formula :
+
+  !\begin{align*}
+  !H_{pq,rs} &= \dfrac{\partial^2 E(x)}{\partial x_{pq}^2} \\
+  !&= \mathcal{P}_{pq} \mathcal{P}_{rs} [ \frac{1}{2} \sum_u [\delta_{qr}(h_p^u \gamma_u^s + h_u^s \gamma_p^u) 
+  !+ \delta_{ps}(h_r^u \gamma_u^q + h_u^q \gamma_u^r)]
+  !-(h_p^s \gamma_r^q + h_r^q \gamma_p^s) \\
+  !&+ \frac{1}{2} \sum_{tuv} [\delta_{qr}(v_{pt}^{uv} \Gamma_{uv}^{st} +v_{uv}^{st} \Gamma_{pt}^{uv}) 
+  !+ \delta_{ps}(v_{uv}^{qt} \Gamma_{rt}^{uv} + v_{rt}^{uv}\Gamma_{uv}^{qt})] \\
+  !&+ \sum_{uv} (v_{pr}^{uv} \Gamma_{uv}^{qs} + v_{uv}^{qs}  \Gamma_{ps}^{uv}) \\
+  !&- \sum_{tu} (v_{pu}^{st} \Gamma_{rt}^{qu}+v_{pu}^{tr} \Gamma_{tr}^{qu}+v_{rt}^{qu}\Gamma_{pu}^{st} + v_{tr}^{qu}\Gamma_{pu}^{ts}) 
+  !\end{align*} 
+
+  !================
+  ! Initialization
+  !================
+  hessian = 0d0
+
+  CALL wall_time(t1)
+
+  !========================
+  ! First line, first term
+  !========================
+  do tmp_p = 1, m
+    p = list(tmp_p)
+    do tmp_q = 1, m
+      q = list(tmp_q)
+      do tmp_r = 1, m
+        r = list(tmp_r)
+        do tmp_s = 1, m
+          s = list(tmp_s)
+
+          ! Permutations 
+          if (((p==r) .and. (q==s)) .or. ((q==r) .and. (p==s)) &
+             .or. ((p==s) .and. (q==r))) then
+           
+            if (q==r) then
+              do u = 1, mo_num
+
+                hessian(tmp_p,tmp_q,tmp_r,tmp_s) = hessian(tmp_p,tmp_q,tmp_r,tmp_s) + 0.5d0 * ( &
+                    mo_one_e_integrals(u,p) * one_e_dm_mo(u,s) &
+                  + mo_one_e_integrals(s,u) * one_e_dm_mo(p,u))
+
+              enddo
+            endif
+          endif
+
+        enddo
+      enddo
+    enddo
+  enddo
+
+  !=========================
+  ! First line, second term
+  !=========================
+  do tmp_p = 1, m
+    p = list(tmp_p)
+    do tmp_q = 1, m
+      q = list(tmp_q)
+      do tmp_r = 1, m
+        r = list(tmp_r)
+        do tmp_s = 1, m
+          s = list(tmp_s)
+
+           ! Permutations 
+           if (((p==r) .and. (q==s)) .or. ((q==r) .and. (p==s)) &
+            .or. ((p==s) .and. (q==r))) then
+
+             if (p==s) then
+               do u = 1, mo_num
+
+                    hessian(tmp_p,tmp_q,tmp_r,tmp_s) = hessian(tmp_p,tmp_q,tmp_r,tmp_s) + 0.5d0 * ( &
+                      mo_one_e_integrals(u,r) * one_e_dm_mo(u,q) &
+                    + mo_one_e_integrals(q,u) * one_e_dm_mo(r,u))
+               enddo
+             endif
+           endif
+
+        enddo
+      enddo
+    enddo
+  enddo
+
+  !========================
+  ! First line, third term
+  !========================
+  do tmp_p = 1, m
+    p = list(tmp_p)
+    do tmp_q = 1, m
+      q = list(tmp_q)
+      do tmp_r = 1, m
+        r = list(tmp_r)
+        do tmp_s = 1, m
+          s = list(tmp_s)
+         
+          ! Permutations 
+          if (((p==r) .and. (q==s)) .or. ((q==r) .and. (p==s)) &
+             .or. ((p==s) .and. (q==r))) then
+
+            hessian(tmp_p,tmp_q,tmp_r,tmp_s) = hessian(tmp_p,tmp_q,tmp_r,tmp_s) &
+            - mo_one_e_integrals(s,p) * one_e_dm_mo(r,q) &
+            - mo_one_e_integrals(q,r) * one_e_dm_mo(p,s)
+
+          endif
+
+        enddo
+      enddo
+    enddo
+  enddo
+
+  !=========================
+  ! Second line, first term
+  !=========================
+  do tmp_p = 1, m
+    p = list(tmp_p)
+    do tmp_q = 1, m
+      q = list(tmp_q)
+      do tmp_r = 1, m
+        r = list(tmp_r)
+        do tmp_s = 1, m
+          s = list(tmp_s)
+
+          ! Permutations 
+          if (((p==r) .and. (q==s)) .or. ((q==r) .and. (p==s)) &
+             .or. ((p==s) .and. (q==r))) then
+
+              if (q==r) then
+                do t = 1, mo_num
+                  do u = 1, mo_num
+                    do v = 1, mo_num
+
+                      hessian(tmp_p,tmp_q,tmp_r,tmp_s) = hessian(tmp_p,tmp_q,tmp_r,tmp_s) + 0.5d0 * (  &
+                        get_two_e_integral(u,v,p,t,mo_integrals_map) * two_e_dm_mo(u,v,s,t) &
+                      + get_two_e_integral(s,t,u,v,mo_integrals_map) * two_e_dm_mo(p,t,u,v))
+
+                    enddo
+                  enddo
+                enddo
+              endif
+            endif
+
+        enddo
+      enddo
+    enddo
+  enddo
+
+  !==========================
+  ! Second line, second term
+  !==========================
+  do tmp_p = 1, m
+    p = list(tmp_p)
+    do tmp_q = 1, m
+      q = list(tmp_q)
+      do tmp_r = 1, m
+        r = list(tmp_r)
+        do tmp_s = 1, m
+          s = list(tmp_s)
+
+           ! Permutations 
+           if (((p==r) .and. (q==s)) .or. ((q==r) .and. (p==s)) &
+              .or. ((p==s) .and. (q==r))) then
+
+             if (p==s) then
+               do t = 1, mo_num
+                 do u = 1, mo_num
+                   do v = 1, mo_num
+
+                     hessian(tmp_p,tmp_q,tmp_r,tmp_s) = hessian(tmp_p,tmp_q,tmp_r,tmp_s) + 0.5d0 * ( &
+                       get_two_e_integral(q,t,u,v,mo_integrals_map) * two_e_dm_mo(r,t,u,v) &
+                     + get_two_e_integral(u,v,r,t,mo_integrals_map) * two_e_dm_mo(u,v,q,t))
+
+                   enddo
+                 enddo
+               enddo
+             endif
+           endif
+
+        enddo
+      enddo
+    enddo
+  enddo
+
+  !========================
+  ! Third line, first term
+  !========================
+  do tmp_p = 1, m
+    p = list(tmp_p)
+    do tmp_q = 1, m
+      q = list(tmp_q)
+      do tmp_r = 1, m
+        r = list(tmp_r)
+        do tmp_s = 1, m
+          s = list(tmp_s)
+
+           ! Permutations 
+           if (((p==r) .and. (q==s)) .or. ((q==r) .and. (p==s)) &
+                .or. ((p==s) .and. (q==r))) then
+
+            do u = 1, mo_num
+              do v = 1, mo_num
+
+                hessian(tmp_p,tmp_q,tmp_r,tmp_s) = hessian(tmp_p,tmp_q,tmp_r,tmp_s) &
+                 + get_two_e_integral(u,v,p,r,mo_integrals_map) * two_e_dm_mo(u,v,q,s) &
+                 + get_two_e_integral(q,s,u,v,mo_integrals_map) * two_e_dm_mo(p,r,u,v)
+
+              enddo
+            enddo
+          endif
+
+        enddo
+      enddo
+    enddo
+  enddo
+
+  !=========================
+  ! Third line, second term
+  !=========================
+  do tmp_p = 1, m
+    p = list(tmp_p)
+    do tmp_q = 1, m
+      q = list(tmp_q)
+      do tmp_r = 1, m
+        r = list(tmp_r)
+        do tmp_s = 1, m
+          s = list(tmp_s)
+
+          ! Permutations 
+          if (((p==r) .and. (q==s)) .or. ((q==r) .and. (p==s)) &
+           .or. ((p==s) .and. (q==r))) then
+
+            do t = 1, mo_num
+              do u = 1, mo_num
+
+                hessian(tmp_p,tmp_q,tmp_r,tmp_s) = hessian(tmp_p,tmp_q,tmp_r,tmp_s) &
+                 - get_two_e_integral(s,t,p,u,mo_integrals_map) * two_e_dm_mo(r,t,q,u) &
+                 - get_two_e_integral(t,s,p,u,mo_integrals_map) * two_e_dm_mo(t,r,q,u) &
+                 - get_two_e_integral(q,u,r,t,mo_integrals_map) * two_e_dm_mo(p,u,s,t) &
+                 - get_two_e_integral(q,u,t,r,mo_integrals_map) * two_e_dm_mo(p,u,t,s)
+
+              enddo
+            enddo
+
+          endif     
+  
+        enddo
+      enddo
+    enddo
+  enddo
+
+    CALL wall_time(t2)
+    t2 = t2 - t1
+    print*, 'Time to compute the hessian :', t2
+
+  !==============
+  ! Permutations
+  !==============
+ 
+  ! Convert the hessian mo_num * mo_num * mo_num * mo_num matrix in a
+  ! 2D n * n matrix (n = mo_num*(mo_num-1)/2)
+  ! H(pq,rs) : p<q and r<s
+
+  do tmp_r = 1, m
+    do tmp_s = 1, m
+      do tmp_q = 1, m
+        do tmp_p = 1, m
+
+          h_tmpr(tmp_p,tmp_q,tmp_r,tmp_s) = hessian(tmp_p,tmp_q,tmp_r,tmp_s) - hessian(tmp_q,tmp_p,tmp_r,tmp_s) &
+                                          - hessian(tmp_p,tmp_q,tmp_s,tmp_r) + hessian(tmp_q,tmp_p,tmp_s,tmp_r)
+
+        enddo
+      enddo
+    enddo
+  enddo
+
+  !========================
+  ! 4D matrix -> 2D matrix
+  !========================
+  
+  ! Convert the hessian mo_num * mo_num * mo_num * mo_num matrix in a
+  ! 2D n * n matrix (n = mo_num*(mo_num-1)/2)
+  ! H(pq,rs) : p<q and r<s
+
+  ! 4D mo_num matrix to 2D n matrix
+  do tmp_rs = 1, tmp_n
+    call vec_to_mat_index(tmp_rs,tmp_r,tmp_s)
+    do tmp_pq = 1, tmp_n
+      call vec_to_mat_index(tmp_pq,tmp_p,tmp_q)
+      tmp(tmp_pq,tmp_rs) = h_tmpr(tmp_p,tmp_q,tmp_r,tmp_s)   
+    enddo
+  enddo
+
+  do p = 1, tmp_n
+    H(p) = tmp(p,p)
+  enddo
+
+  ! Display
+  if (debug) then 
+    print*,'2D diag Hessian matrix'
+    do tmp_pq = 1, tmp_n
+      write(*,'(100(F10.5))') tmp(tmp_pq,:)
+    enddo 
+  endif
+
+  !==============
+  ! Deallocation
+  !==============
+
+  deallocate(hessian,h_tmpr,tmp)
+
+  print*,'---End first_diag_hess_list---'
+
+end subroutine

src/mo_optimization/first_diagonal_hessian_opt.irp.f

@@ -0,0 +1,344 @@
+subroutine first_diag_hessian_opt(n,H, h_tmpr)
+
+  include 'constants.h' 
+
+  implicit none
+
+  !===========================================================================
+  ! Compute the diagonal hessian of energy with respects to orbital rotations
+  !===========================================================================
+
+  !===========
+  ! Variables 
+  !===========
+ 
+  ! in
+  integer, intent(in)           :: n 
+  ! n        : integer, n = mo_num*(mo_num-1)/2
+ 
+  ! out
+  double precision, intent(out) :: H(n,n), h_tmpr(mo_num,mo_num,mo_num,mo_num)
+  ! H        : n by n double precision matrix containing the 2D hessian
+  
+  ! internal
+  double precision, allocatable :: hessian(:,:,:,:)
+  integer                       :: p,q
+  integer                       :: r,s,t,u,v
+  integer                       :: pq,rs
+  double precision              :: t1,t2,t3
+  ! hessian  : mo_num 4D double precision matrix containing the hessian before the permutations
+  ! h_tmpr   : mo_num 4D double precision matrix containing the hessian after the permutations
+  ! p,q,r,s  : integer, indexes of the 4D hessian matrix
+  ! t,u,v    : integer, indexes to compute hessian elements
+  ! pq,rs    : integer, indexes for the conversion from 4D to 2D hessian matrix
+  ! t1,t2,t3 : double precision, t3 = t2 - t1, time to compute the hessian 
+  
+  ! Function
+  double precision :: get_two_e_integral
+  ! get_two_e_integral : double precision function, two e integrals
+ 
+  ! Provided :
+  ! mo_one_e_integrals : mono e- integrals
+  ! get_two_e_integral : two e- integrals
+  ! one_e_dm_mo_alpha, one_e_dm_mo_beta : one body density matrix
+  ! two_e_dm_mo : two body density matrix
+
+  !============
+  ! Allocation
+  !============
+
+  allocate(hessian(mo_num,mo_num,mo_num,mo_num))!,h_tmpr(mo_num,mo_num,mo_num,mo_num))
+
+  !=============
+  ! Calculation
+  !=============
+
+  if (debug) then
+          print*,'Enter in first_diag_hessien'
+  endif
+
+  ! From Anderson et. al. (2014) 
+  ! The Journal of Chemical Physics 141, 244104 (2014); doi: 10.1063/1.4904384
+
+  ! LaTeX formula :
+
+  !\begin{align*}
+  !H_{pq,rs} &= \dfrac{\partial^2 E(x)}{\partial x_{pq}^2} \\
+  !&= \mathcal{P}_{pq} \mathcal{P}_{rs} [ \frac{1}{2} \sum_u [\delta_{qr}(h_p^u \gamma_u^s + h_u^s \gamma_p^u) 
+  !+ \delta_{ps}(h_r^u \gamma_u^q + h_u^q \gamma_u^r)]
+  !-(h_p^s \gamma_r^q + h_r^q \gamma_p^s) \\
+  !&+ \frac{1}{2} \sum_{tuv} [\delta_{qr}(v_{pt}^{uv} \Gamma_{uv}^{st} +v_{uv}^{st} \Gamma_{pt}^{uv}) 
+  !+ \delta_{ps}(v_{uv}^{qt} \Gamma_{rt}^{uv} + v_{rt}^{uv}\Gamma_{uv}^{qt})] \\
+  !&+ \sum_{uv} (v_{pr}^{uv} \Gamma_{uv}^{qs} + v_{uv}^{qs}  \Gamma_{ps}^{uv}) \\
+  !&- \sum_{tu} (v_{pu}^{st} \Gamma_{rt}^{qu}+v_{pu}^{tr} \Gamma_{tr}^{qu}+v_{rt}^{qu}\Gamma_{pu}^{st} + v_{tr}^{qu}\Gamma_{pu}^{ts}) 
+  !\end{align*} 
+
+  !================
+  ! Initialization
+  !================
+  hessian = 0d0
+
+  CALL wall_time(t1)
+
+  !========================
+  ! First line, first term
+  !========================
+  do p = 1, mo_num
+    do q = 1, mo_num
+      do r = 1, mo_num
+        do s = 1, mo_num
+
+          ! Permutations 
+          if (((p==r) .and. (q==s)) .or. ((q==r) .and. (p==s)) &
+             .or. ((p==s) .and. (q==r))) then
+           
+            if (q==r) then
+              do u = 1, mo_num
+
+                hessian(p,q,r,s) = hessian(p,q,r,s) + 0.5d0 * ( &
+                    mo_one_e_integrals(u,p) * one_e_dm_mo(u,s) &
+                  + mo_one_e_integrals(s,u) * one_e_dm_mo(p,u))
+
+              enddo
+            endif
+          endif
+
+        enddo
+      enddo
+    enddo
+  enddo
+
+  !=========================
+  ! First line, second term
+  !=========================
+  do p = 1, mo_num
+    do q = 1, mo_num
+      do r = 1, mo_num
+        do s = 1, mo_num
+
+           ! Permutations 
+           if (((p==r) .and. (q==s)) .or. ((q==r) .and. (p==s)) &
+            .or. ((p==s) .and. (q==r))) then
+
+             if (p==s) then
+               do u = 1, mo_num
+
+                    hessian(p,q,r,s) = hessian(p,q,r,s) + 0.5d0 * ( &
+                      mo_one_e_integrals(u,r) * one_e_dm_mo(u,q) &
+                    + mo_one_e_integrals(q,u) * one_e_dm_mo(r,u))
+               enddo
+             endif
+           endif
+
+        enddo
+      enddo
+    enddo
+  enddo
+
+  !========================
+  ! First line, third term
+  !========================
+  do p = 1, mo_num
+    do q = 1, mo_num
+      do r = 1, mo_num
+        do s = 1, mo_num
+         
+          ! Permutations 
+          if (((p==r) .and. (q==s)) .or. ((q==r) .and. (p==s)) &
+             .or. ((p==s) .and. (q==r))) then
+
+            hessian(p,q,r,s) = hessian(p,q,r,s) &
+            - mo_one_e_integrals(s,p) * one_e_dm_mo(r,q) &
+            - mo_one_e_integrals(q,r) * one_e_dm_mo(p,s)
+
+          endif
+
+        enddo
+      enddo
+    enddo
+  enddo
+
+  !=========================
+  ! Second line, first term
+  !=========================
+  do p = 1, mo_num
+    do q = 1, mo_num
+      do r = 1, mo_num
+        do s = 1, mo_num
+
+          ! Permutations 
+          if (((p==r) .and. (q==s)) .or. ((q==r) .and. (p==s)) &
+             .or. ((p==s) .and. (q==r))) then
+
+              if (q==r) then
+                do t = 1, mo_num
+                  do u = 1, mo_num
+                    do v = 1, mo_num
+
+                      hessian(p,q,r,s) = hessian(p,q,r,s) + 0.5d0 * (  &
+                        get_two_e_integral(u,v,p,t,mo_integrals_map) * two_e_dm_mo(u,v,s,t) &
+                      + get_two_e_integral(s,t,u,v,mo_integrals_map) * two_e_dm_mo(p,t,u,v))
+
+                    enddo
+                  enddo
+                enddo
+              endif
+            endif
+
+        enddo
+      enddo
+    enddo
+  enddo
+
+  !==========================
+  ! Second line, second term
+  !==========================
+  do p = 1, mo_num
+    do q = 1, mo_num
+      do r = 1, mo_num
+        do s = 1, mo_num
+
+           ! Permutations 
+           if (((p==r) .and. (q==s)) .or. ((q==r) .and. (p==s)) &
+              .or. ((p==s) .and. (q==r))) then
+
+             if (p==s) then
+               do t = 1, mo_num
+                 do u = 1, mo_num
+                   do v = 1, mo_num
+
+                     hessian(p,q,r,s) = hessian(p,q,r,s) + 0.5d0 * ( &
+                       get_two_e_integral(q,t,u,v,mo_integrals_map) * two_e_dm_mo(r,t,u,v) &
+                     + get_two_e_integral(u,v,r,t,mo_integrals_map) * two_e_dm_mo(u,v,q,t))
+
+                   enddo
+                 enddo
+               enddo
+             endif
+           endif
+
+        enddo
+      enddo
+    enddo
+  enddo
+
+  !========================
+  ! Third line, first term
+  !========================
+  do p = 1, mo_num
+    do q = 1, mo_num
+      do r = 1, mo_num
+        do s = 1, mo_num
+
+
+           ! Permutations 
+           if (((p==r) .and. (q==s)) .or. ((q==r) .and. (p==s)) &
+                .or. ((p==s) .and. (q==r))) then
+
+            do u = 1, mo_num
+              do v = 1, mo_num
+
+                hessian(p,q,r,s) = hessian(p,q,r,s) &
+                 + get_two_e_integral(u,v,p,r,mo_integrals_map) * two_e_dm_mo(u,v,q,s) &
+                 + get_two_e_integral(q,s,u,v,mo_integrals_map) * two_e_dm_mo(p,r,u,v)
+
+              enddo
+            enddo
+          endif
+
+        enddo
+      enddo
+    enddo
+  enddo
+
+  !=========================
+  ! Third line, second term
+  !=========================
+  do p = 1, mo_num
+    do q = 1, mo_num
+      do r = 1, mo_num
+        do s = 1, mo_num
+
+          ! Permutations 
+          if (((p==r) .and. (q==s)) .or. ((q==r) .and. (p==s)) &
+           .or. ((p==s) .and. (q==r))) then
+
+            do t = 1, mo_num
+              do u = 1, mo_num
+
+                hessian(p,q,r,s) = hessian(p,q,r,s) &
+                 - get_two_e_integral(s,t,p,u,mo_integrals_map) * two_e_dm_mo(r,t,q,u) &
+                 - get_two_e_integral(t,s,p,u,mo_integrals_map) * two_e_dm_mo(t,r,q,u) &
+                 - get_two_e_integral(q,u,r,t,mo_integrals_map) * two_e_dm_mo(p,u,s,t) &
+                 - get_two_e_integral(q,u,t,r,mo_integrals_map) * two_e_dm_mo(p,u,t,s)
+
+              enddo
+            enddo
+
+          endif     
+  
+        enddo
+      enddo
+    enddo
+  enddo
+
+    CALL wall_time(t2)
+    t2 = t2 - t1
+    print*, 'Time to compute the hessian :', t2
+
+  !==============
+  ! Permutations
+  !==============
+ 
+  ! Convert the hessian mo_num * mo_num * mo_num * mo_num matrix in a
+  ! 2D n * n matrix (n = mo_num*(mo_num-1)/2)
+  ! H(pq,rs) : p<q and r<s
+
+  do r = 1, mo_num
+    do s = 1, mo_num
+      do q = 1, mo_num
+        do p = 1, mo_num
+
+          h_tmpr(p,q,r,s) = (hessian(p,q,r,s) - hessian(q,p,r,s) - hessian(p,q,s,r) + hessian(q,p,s,r))
+
+        enddo
+      enddo
+    enddo
+  enddo
+
+  !========================
+  ! 4D matrix -> 2D matrix
+  !========================
+  
+  ! Convert the hessian mo_num * mo_num * mo_num * mo_num matrix in a
+  ! 2D n * n matrix (n = mo_num*(mo_num-1)/2)
+  ! H(pq,rs) : p<q and r<s
+
+  ! 4D mo_num matrix to 2D n matrix
+  do rs = 1, n
+    call vec_to_mat_index(rs,r,s)
+    do pq = 1, n
+      call vec_to_mat_index(pq,p,q)
+      H(pq,rs) = h_tmpr(p,q,r,s)   
+    enddo
+  enddo
+
+  ! Display
+  if (debug) then 
+    print*,'2D diag Hessian matrix'
+    do pq = 1, n
+      write(*,'(100(F10.5))') H(pq,:)
+    enddo 
+  endif
+
+  !==============
+  ! Deallocation
+  !==============
+
+  deallocate(hessian)
+
+  if (debug) then
+    print*,'Leave first_diag_hessien'
+  endif
+
+end subroutine

src/mo_optimization/first_gradient_list_opt.irp.f

@@ -0,0 +1,125 @@
+! First gradient
+
+subroutine first_gradient_list_opt(tmp_n,m,list,v_grad)
+
+  include 'constants.h'
+
+  implicit none
+
+  !===================================================================
+  ! Compute the gradient of energy with respects to orbital rotations
+  !===================================================================
+
+  ! Check if read_wf = true, else :
+  ! qp set determinant read_wf true
+
+  ! in
+  integer, intent(in) :: tmp_n,m,list(m)
+  ! n : integer, n = m*(m-1)/2
+  ! m = list_size
+  
+  ! out
+  double precision, intent(out) :: v_grad(tmp_n)
+  ! v_grad : double precision vector of length n containeing the gradient
+
+  ! internal
+  double precision, allocatable :: grad(:,:),A(:,:)
+  double precision :: norm
+  integer :: i,p,q,r,s,t,tmp_i,tmp_p,tmp_q,tmp_r,tmp_s,tmp_t
+  ! grad : double precision matrix containing the gradient before the permutation
+  ! A : double precision matrix containing the gradient after the permutation
+  ! norm : double precision number, the norm of the vector gradient
+  ! i,p,q,r,s,t : integer, indexes 
+  ! istate : integer, the electronic state
+
+  ! Function
+  double precision :: get_two_e_integral, norm2
+  ! get_two_e_integral :  double precision function that gives the two e integrals
+  ! norm2 : double precision function that gives the norm of a vector
+ 
+  ! Provided :
+  ! mo_one_e_integrals : mono e- integrals
+  ! get_two_e_integral : two e- integrals
+  ! one_e_dm_mo : one body density matrix (state average)
+  ! two_e_dm_mo : two body density matrix (state average)
+
+   print*,'---first_gradient_list---'
+
+  !============
+  ! Allocation
+  !============
+
+  allocate(grad(m,m),A(m,m))
+
+  !=============
+  ! Calculation
+  !=============
+
+  v_grad = 0d0
+  grad = 0d0
+
+  do tmp_p = 1, m
+    p = list(tmp_p)
+    do tmp_q = 1, m
+      q = list(tmp_q)
+      !grad(tmp_p,tmp_q) = 0d0
+      do r = 1, mo_num
+        grad(tmp_p,tmp_q) = grad(tmp_p,tmp_q) + mo_one_e_integrals(p,r) * one_e_dm_mo(r,q) &
+                               - mo_one_e_integrals(r,q) * one_e_dm_mo(p,r)
+
+      enddo
+
+      do r = 1, mo_num
+        do s = 1, mo_num
+          do t = 1, mo_num
+
+            grad(tmp_p,tmp_q) = grad(tmp_p,tmp_q) &
+                + get_two_e_integral(p,t,r,s,mo_integrals_map) * two_e_dm_mo(r,s,q,t) &
+                - get_two_e_integral(r,s,q,t,mo_integrals_map) * two_e_dm_mo(p,t,r,s)
+          enddo
+        enddo
+      enddo
+    enddo
+  enddo
+
+  ! Conversion mo_num*mo_num matrix to mo_num(mo_num-1)/2 vector
+  do tmp_i = 1, tmp_n
+    call vec_to_mat_index(tmp_i,tmp_p,tmp_q)
+    v_grad(tmp_i)=(grad(tmp_p,tmp_q) - grad(tmp_q,tmp_p))
+  enddo  
+
+  ! Display, vector containing the gradient elements 
+  if (debug) then  
+    print*,'Vector containing the gradient :'
+    write(*,'(100(F10.5))') v_grad(1:tmp_n)
+  endif  
+
+  ! Norm of the vector
+  norm = norm2(v_grad)
+  print*, 'Norm : ', norm
+
+  ! Matrix gradient
+  A = 0d0
+  do tmp_q = 1, m
+    do tmp_p = 1, m
+      A(tmp_p,tmp_q) = grad(tmp_p,tmp_q) - grad(tmp_q,tmp_p)
+    enddo
+  enddo
+
+  ! Display, matrix containting the gradient elements
+  if (debug) then
+    print*,'Matrix containing the gradient :'
+    do tmp_i = 1, m
+      write(*,'(100(E12.5))') A(tmp_i,1:m)
+    enddo
+  endif
+
+  !==============
+  ! Deallocation
+  !==============
+
+  deallocate(grad,A)
+
+  print*,'---End first_gradient_list---'
+
+end subroutine

src/mo_optimization/first_gradient_opt.irp.f

@@ -0,0 +1,128 @@
+! First gradient
+
+subroutine first_gradient_opt(n,v_grad)
+
+  include 'constants.h'
+
+  implicit none
+
+  !===================================================================
+  ! Compute the gradient of energy with respects to orbital rotations
+  !===================================================================
+
+  ! Check if read_wf = true, else :
+  ! qp set determinant read_wf true
+
+  END_DOC
+
+  ! in
+  integer, intent(in) :: n
+  ! n : integer, n = mo_num*(mo_num-1)/2
+  
+  ! out
+  double precision, intent(out) :: v_grad(n)
+  ! v_grad : double precision vector of length n containeing the gradient
+
+  ! internal
+  double precision, allocatable :: grad(:,:),A(:,:)
+  double precision :: norm
+  integer :: i,p,q,r,s,t
+  integer :: istate
+  ! grad : double precision matrix containing the gradient before the permutation
+  ! A : double precision matrix containing the gradient after the permutation
+  ! norm : double precision number, the norm of the vector gradient
+  ! i,p,q,r,s,t : integer, indexes 
+  ! istate : integer, the electronic state
+
+  ! Function
+  double precision :: get_two_e_integral, norm2
+  ! get_two_e_integral :  double precision function that gives the two e integrals
+  ! norm2 : double precision function that gives the norm of a vector
+ 
+  ! Provided :
+  ! mo_one_e_integrals : mono e- integrals
+  ! get_two_e_integral : two e- integrals
+  ! one_e_dm_mo : one body density matrix (state average)
+  ! two_e_dm_mo : two body density matrix (state average)
+
+  !============
+  ! Allocation
+  !============
+
+  allocate(grad(mo_num,mo_num),A(mo_num,mo_num))
+
+  !=============
+  ! Calculation
+  !=============
+
+  if (debug) then
+    print*,'---first_gradient---'
+  endif
+
+  v_grad = 0d0
+
+  do p = 1, mo_num
+    do q = 1, mo_num
+      grad(p,q) = 0d0
+      do r = 1, mo_num
+        grad(p,q) = grad(p,q) + mo_one_e_integrals(p,r) * one_e_dm_mo(r,q) &
+                               - mo_one_e_integrals(r,q) * one_e_dm_mo(p,r)
+
+      enddo
+
+      do r = 1, mo_num
+        do s = 1, mo_num
+          do t= 1, mo_num
+
+            grad(p,q) = grad(p,q) &
+                + get_two_e_integral(p,t,r,s,mo_integrals_map) * two_e_dm_mo(r,s,q,t) &
+                - get_two_e_integral(r,s,q,t,mo_integrals_map) * two_e_dm_mo(p,t,r,s)
+          enddo
+        enddo
+      enddo
+    enddo
+  enddo
+
+  ! Conversion mo_num*mo_num matrix to mo_num(mo_num-1)/2 vector
+  do i=1,n
+    call vec_to_mat_index(i,p,q)
+    v_grad(i)=(grad(p,q) - grad(q,p))
+  enddo  
+
+  ! Display, vector containing the gradient elements 
+  if (debug) then  
+    print*,'Vector containing the gradient :'
+    write(*,'(100(F10.5))') v_grad(1:n)
+  endif  
+
+  ! Norm of the vector
+  norm = norm2(v_grad)
+  print*, 'Norm : ', norm
+
+  ! Matrix gradient
+  A = 0d0
+  do q=1,mo_num
+    do p=1,mo_num
+      A(p,q) = grad(p,q) - grad(q,p)
+    enddo
+  enddo
+
+  ! Display, matrix containting the gradient elements
+  if (debug) then    
+    print*,'Matrix containing the gradient :'
+    do i = 1, mo_num
+      write(*,'(100(E12.5))') A(i,1:mo_num)
+    enddo
+  endif
+
+  !==============
+  ! Deallocation
+  !==============
+
+  deallocate(grad,A)
+
+  if (debug) then
+    print*,'---End first_gradient---'
+  endif
+
+end subroutine

src/mo_optimization/first_hessian_list_opt.irp.f

@@ -0,0 +1,365 @@
+subroutine first_hessian_list_opt(tmp_n,m,list,H,h_tmpr)
+
+  include 'constants.h' 
+
+  implicit none
+
+  !==================================================================
+  ! Compute the hessian of energy with respects to orbital rotations
+  !==================================================================
+
+  !===========
+  ! Variables  
+  !===========
+
+  ! in
+  integer, intent(in)           :: tmp_n, m, list(m)
+  !tmp_n         : integer, tmp_n = m*(m-1)/2
+  
+  ! out
+  double precision, intent(out) :: H(tmp_n,tmp_n),h_tmpr(m,m,m,m)
+  ! H        : n by n double precision matrix containing the 2D hessian
+ 
+  ! internal
+  double precision, allocatable :: hessian(:,:,:,:)
+  integer                       :: p,q, tmp_p,tmp_q
+  integer                       :: r,s,t,u,v,tmp_r,tmp_s,tmp_t,tmp_u,tmp_v
+  integer                       :: pq,rs,tmp_pq,tmp_rs
+  double precision              :: t1,t2,t3,t4,t5,t6
+  ! hessian  : mo_num 4D double precision matrix containing the hessian before the permutations
+  ! h_tmpr   : mo_num 4D double precision matrix containing the hessian after the permutations
+  ! p,q,r,s  : integer, indexes of the 4D hessian matrix
+  ! t,u,v    : integer, indexes to compute hessian elements
+  ! pq,rs    : integer, indexes for the conversion from 4D to 2D hessian matrix
+  ! t1,t2,t3 : double precision, t3 = t2 - t1, time to compute the hessian 
+
+  ! Funtion 
+  double precision              :: get_two_e_integral
+  ! get_two_e_integral :  double precision function, two e integrals 
+
+  ! Provided :
+  ! mo_one_e_integrals : mono e- integrals
+  ! get_two_e_integral : two e- integrals
+  ! one_e_dm_mo_alpha, one_e_dm_mo_beta : one body density matrix
+  ! two_e_dm_mo : two body density matrix
+
+  !============
+  ! Allocation
+  !============
+
+  allocate(hessian(m,m,m,m))
+
+  !=============
+  ! Calculation
+  !=============
+
+  print*,'---first_hess_list---'
+
+  ! From Anderson et. al. (2014) 
+  ! The Journal of Chemical Physics 141, 244104 (2014); doi: 10.1063/1.4904384
+
+  CALL wall_time(t1)
+
+  ! Initialization
+  hessian = 0d0
+
+  !========================
+  ! First line, first term
+  !========================
+
+  CALL wall_time(t4)
+
+  do tmp_p = 1, m
+    p = list(tmp_p)
+    do tmp_q = 1, m
+      q = list(tmp_q)
+      do tmp_r = 1, m
+        r = list(tmp_r)
+        do tmp_s = 1, m
+          s = list(tmp_s)
+
+            if (q==r) then
+              do u = 1, mo_num
+
+                hessian(tmp_p,tmp_q,tmp_r,tmp_s) = hessian(tmp_p,tmp_q,tmp_r,tmp_s) + 0.5d0 * (  &
+                  mo_one_e_integrals(u,p) * one_e_dm_mo(u,s) &
+                + mo_one_e_integrals(s,u) * one_e_dm_mo(p,u))
+
+              enddo
+            endif
+
+        enddo
+      enddo
+    enddo
+  enddo
+
+  CALL wall_time(t5)
+  t6 = t5-t4
+  print*,'l1 1 :', t6
+
+  !=========================
+  ! First line, second term
+  !=========================
+
+  CALL wall_time(t4)
+
+  do tmp_p = 1, m
+    p = list(tmp_p)
+    do tmp_q = 1, m
+      q = list(tmp_q)
+      do tmp_r = 1, m
+        r = list(tmp_r)
+        do tmp_s = 1, m
+          s = list(tmp_s)
+
+          if (p==s) then
+            do u = 1, mo_num
+
+                  hessian(tmp_p,tmp_q,tmp_r,tmp_s) = hessian(tmp_p,tmp_q,tmp_r,tmp_s) + 0.5d0 * ( &
+                    mo_one_e_integrals(u,r) * one_e_dm_mo(u,q) &
+                  + mo_one_e_integrals(q,u) * one_e_dm_mo(r,u))
+            enddo
+          endif
+
+        enddo
+      enddo
+    enddo
+  enddo
+  
+  CALL wall_time(t5)
+  t6 = t5-t4
+  print*,'l1 2 :', t6
+
+  !========================
+  ! First line, third term
+  !========================
+
+  CALL wall_time(t4)
+
+  do tmp_p = 1, m
+    p = list(tmp_p)
+    do tmp_q = 1, m
+      q = list(tmp_q)
+      do tmp_r = 1, m
+        r = list(tmp_r)
+        do tmp_s = 1, m
+          s = list(tmp_s)
+
+          hessian(tmp_p,tmp_q,tmp_r,tmp_s) = hessian(tmp_p,tmp_q,tmp_r,tmp_s) &
+          - mo_one_e_integrals(s,p) * one_e_dm_mo(r,q)&
+          - mo_one_e_integrals(q,r) * one_e_dm_mo(p,s)
+
+        enddo
+      enddo
+    enddo
+  enddo
+
+  CALL wall_time(t5)
+  t6 = t5-t4
+  print*,'l1 3 :', t6
+
+
+  !=========================
+  ! Second line, first term
+  !=========================
+
+  CALL wall_time(t4)
+
+  do tmp_p = 1, m
+    p = list(tmp_p)
+    do tmp_q = 1, m
+      q = list(tmp_q)
+      do tmp_r = 1, m
+        r = list(tmp_r)
+        do tmp_s = 1, m
+          s = list(tmp_s)
+
+           if (q==r) then
+             do t = 1, mo_num
+               do u = 1, mo_num
+                 do v = 1, mo_num
+
+                   hessian(tmp_p,tmp_q,tmp_r,tmp_s) = hessian(tmp_p,tmp_q,tmp_r,tmp_s) + 0.5d0 * (  &
+                     get_two_e_integral(u,v,p,t,mo_integrals_map) * two_e_dm_mo(u,v,s,t) &
+                   + get_two_e_integral(s,t,u,v,mo_integrals_map) * two_e_dm_mo(p,t,u,v))
+
+                 enddo
+               enddo
+             enddo
+           endif
+
+        enddo
+      enddo
+    enddo
+  enddo
+
+  CALL wall_time(t5)
+  t6 = t5-t4
+  print*,'l2 1 :', t6
+
+  !==========================
+  ! Second line, second term
+  !==========================
+
+  CALL wall_time(t4)
+
+  do tmp_p = 1, m
+    p = list(tmp_p)
+    do tmp_q = 1, m
+      q = list(tmp_q)
+      do tmp_r = 1, m
+        r = list(tmp_r)
+        do tmp_s = 1, m
+          s = list(tmp_s)
+
+          if (p==s) then
+            do t = 1, mo_num
+              do u = 1, mo_num
+                do v = 1, mo_num
+
+                  hessian(tmp_p,tmp_q,tmp_r,tmp_s) = hessian(tmp_p,tmp_q,tmp_r,tmp_s) + 0.5d0 * ( &
+                    get_two_e_integral(q,t,u,v,mo_integrals_map) * two_e_dm_mo(r,t,u,v) &
+                  + get_two_e_integral(u,v,r,t,mo_integrals_map) * two_e_dm_mo(u,v,q,t))
+
+                enddo
+              enddo
+            enddo
+          endif
+
+        enddo
+      enddo
+    enddo
+  enddo
+
+  CALL wall_time(t5)
+  t6 = t5-t4
+  print*,'l2 2 :', t6
+
+  !========================
+  ! Third line, first term
+  !========================
+
+  CALL wall_time(t4)
+
+  do tmp_p = 1, m
+    p = list(tmp_p)
+    do tmp_q = 1, m
+      q = list(tmp_q)
+      do tmp_r = 1, m
+        r = list(tmp_r)
+        do tmp_s = 1, m
+          s = list(tmp_s)
+
+          do u = 1, mo_num
+            do v = 1, mo_num
+
+              hessian(tmp_p,tmp_q,tmp_r,tmp_s) = hessian(tmp_p,tmp_q,tmp_r,tmp_s) &
+               + get_two_e_integral(u,v,p,r,mo_integrals_map) * two_e_dm_mo(u,v,q,s) &
+               + get_two_e_integral(q,s,u,v,mo_integrals_map) * two_e_dm_mo(p,r,u,v)
+
+            enddo
+          enddo
+
+        enddo
+      enddo
+    enddo
+  enddo
+ 
+  CALL wall_time(t5)
+  t6 = t5-t4
+  print*,'l3 1 :', t6
+
+  !=========================
+  ! Third line, second term
+  !=========================
+
+  CALL wall_time(t4)
+
+  do tmp_p = 1, m
+    p = list(tmp_p)
+    do tmp_q = 1, m
+      q = list(tmp_q)
+      do tmp_r = 1, m
+        r = list(tmp_r)
+        do tmp_s = 1, m
+          s = list(tmp_s)
+
+          do t = 1, mo_num
+            do u = 1, mo_num
+
+              hessian(tmp_p,tmp_q,tmp_r,tmp_s) = hessian(tmp_p,tmp_q,tmp_r,tmp_s) &
+               - get_two_e_integral(s,t,p,u,mo_integrals_map) * two_e_dm_mo(r,t,q,u) &
+               - get_two_e_integral(t,s,p,u,mo_integrals_map) * two_e_dm_mo(t,r,q,u) &
+               - get_two_e_integral(q,u,r,t,mo_integrals_map) * two_e_dm_mo(p,u,s,t) &
+               - get_two_e_integral(q,u,t,r,mo_integrals_map) * two_e_dm_mo(p,u,t,s)
+
+            enddo
+          enddo
+
+        enddo
+      enddo
+    enddo
+  enddo
+
+  CALL wall_time(t5)
+  t6 = t5-t4
+  print*,'l3 2 :', t6
+
+  CALL wall_time(t2)
+  t3 = t2 -t1
+  print*,'Time to compute the hessian : ', t3
+
+  !==============
+  ! Permutations 
+  !==============
+
+  ! Hessian(p,q,r,s) = P_pq P_rs [ ...]
+  ! => Hessian(p,q,r,s) = (p,q,r,s) - (q,p,r,s) - (p,q,s,r) + (q,p,s,r) 
+
+  do tmp_s = 1, m
+    do tmp_r = 1, m
+      do tmp_q = 1, m
+        do tmp_p = 1, m
+
+          h_tmpr(tmp_p,tmp_q,tmp_r,tmp_s) = (hessian(tmp_p,tmp_q,tmp_r,tmp_s) - hessian(tmp_q,tmp_p,tmp_r,tmp_s) &
+                                           - hessian(tmp_p,tmp_q,tmp_s,tmp_r) + hessian(tmp_q,tmp_p,tmp_s,tmp_r))
+
+        enddo
+      enddo
+    enddo
+  enddo
+
+  !========================
+  ! 4D matrix to 2D matrix
+  !========================
+
+  ! Convert the hessian mo_num * mo_num * mo_num * mo_num matrix in a
+  ! 2D n * n matrix (n = mo_num*(mo_num-1)/2)
+  ! H(pq,rs) : p<q and r<s
+
+  ! 4D mo_num matrix to 2D n matrix
+  do tmp_pq = 1, tmp_n
+    call vec_to_mat_index(tmp_pq,tmp_p,tmp_q)
+    do tmp_rs = 1, tmp_n
+      call vec_to_mat_index(tmp_rs,tmp_r,tmp_s)
+      H(tmp_pq,tmp_rs) = h_tmpr(tmp_p,tmp_q,tmp_r,tmp_s)   
+    enddo
+  enddo
+
+  ! Display
+  if (debug) then 
+    print*,'2D Hessian matrix'
+    do tmp_pq = 1, tmp_n
+      write(*,'(100(F10.5))') H(tmp_pq,:)
+    enddo 
+  endif
+
+  !==============
+  ! Deallocation
+  !==============
+
+  deallocate(hessian)
+
+  print*,'---End first_hess_list---'
+
+end subroutine

src/mo_optimization/first_hessian_opt.irp.f

@@ -0,0 +1,360 @@
+subroutine first_hessian_opt(n,H,h_tmpr)
+
+  include 'constants.h' 
+
+  implicit none
+
+  !==================================================================
+  ! Compute the hessian of energy with respects to orbital rotations
+  !==================================================================
+
+  !===========
+  ! Variables  
+  !===========
+
+  ! in
+  integer, intent(in)           :: n 
+  !n         : integer, n = mo_num*(mo_num-1)/2
+  
+  ! out
+  double precision, intent(out) :: H(n,n),h_tmpr(mo_num,mo_num,mo_num,mo_num)
+  ! H        : n by n double precision matrix containing the 2D hessian
+ 
+  ! internal
+  double precision, allocatable :: hessian(:,:,:,:)
+  integer                       :: p,q
+  integer                       :: r,s,t,u,v
+  integer                       :: pq,rs
+  double precision              :: t1,t2,t3,t4,t5,t6
+  ! hessian  : mo_num 4D double precision matrix containing the hessian before the permutations
+  ! h_tmpr   : mo_num 4D double precision matrix containing the hessian after the permutations
+  ! p,q,r,s  : integer, indexes of the 4D hessian matrix
+  ! t,u,v    : integer, indexes to compute hessian elements
+  ! pq,rs    : integer, indexes for the conversion from 4D to 2D hessian matrix
+  ! t1,t2,t3 : double precision, t3 = t2 - t1, time to compute the hessian 
+
+  ! Funtion 
+  double precision              :: get_two_e_integral
+  ! get_two_e_integral :  double precision function, two e integrals 
+
+  ! Provided :
+  ! mo_one_e_integrals : mono e- integrals
+  ! get_two_e_integral : two e- integrals
+  ! one_e_dm_mo_alpha, one_e_dm_mo_beta : one body density matrix
+  ! two_e_dm_mo : two body density matrix
+
+  !============
+  ! Allocation
+  !============
+
+  allocate(hessian(mo_num,mo_num,mo_num,mo_num))
+
+  !=============
+  ! Calculation
+  !=============
+
+  if (debug) then
+    print*,'Enter in first_hess'
+  endif
+
+  ! From Anderson et. al. (2014) 
+  ! The Journal of Chemical Physics 141, 244104 (2014); doi: 10.1063/1.4904384
+
+  CALL wall_time(t1)
+
+  ! Initialization
+  hessian = 0d0
+
+  !========================
+  ! First line, first term
+  !========================
+
+  CALL wall_time(t4)
+
+  do p = 1, mo_num
+    do q = 1, mo_num
+      do r = 1, mo_num
+        do s = 1, mo_num
+
+            if (q==r) then
+              do u = 1, mo_num
+
+                hessian(p,q,r,s) = hessian(p,q,r,s) + 0.5d0 * (  &
+                  mo_one_e_integrals(u,p) * one_e_dm_mo(u,s) &
+                + mo_one_e_integrals(s,u) * one_e_dm_mo(p,u))
+
+              enddo
+            endif
+
+        enddo
+      enddo
+    enddo
+  enddo
+
+  CALL wall_time(t5)
+  t6 = t5-t4
+  print*,'l1 1 :', t6
+
+  !=========================
+  ! First line, second term
+  !=========================
+
+  CALL wall_time(t4)
+
+  do p = 1, mo_num
+    do q = 1, mo_num
+      do r = 1, mo_num
+        do s = 1, mo_num
+
+          if (p==s) then
+            do u = 1, mo_num
+
+                  hessian(p,q,r,s) = hessian(p,q,r,s) + 0.5d0 * ( &
+                    mo_one_e_integrals(u,r) * one_e_dm_mo(u,q) &
+                  + mo_one_e_integrals(q,u) * one_e_dm_mo(r,u))
+            enddo
+          endif
+
+        enddo
+      enddo
+    enddo
+  enddo
+  
+  CALL wall_time(t5)
+  t6 = t5-t4
+  print*,'l1 2 :', t6
+
+  !========================
+  ! First line, third term
+  !========================
+
+  CALL wall_time(t4)
+
+  do p = 1, mo_num
+    do q = 1, mo_num
+      do r = 1, mo_num
+        do s = 1, mo_num
+
+          hessian(p,q,r,s) = hessian(p,q,r,s) &
+          - mo_one_e_integrals(s,p) * one_e_dm_mo(r,q)&
+          - mo_one_e_integrals(q,r) * one_e_dm_mo(p,s)
+
+        enddo
+      enddo
+    enddo
+  enddo
+
+  CALL wall_time(t5)
+  t6 = t5-t4
+  print*,'l1 3 :', t6
+
+
+  !=========================
+  ! Second line, first term
+  !=========================
+
+  CALL wall_time(t4)
+
+  do s = 1, mo_num
+    do r = 1, mo_num
+      do q = 1, mo_num
+        do p = 1, mo_num
+
+!  do p = 1, mo_num
+!    do q = 1, mo_num
+!      do r = 1, mo_num
+!        do s = 1, mo_num
+
+           if (q==r) then
+             do t = 1, mo_num
+               do u = 1, mo_num
+                 do v = 1, mo_num
+
+                   hessian(p,q,r,s) = hessian(p,q,r,s) + 0.5d0 * (  &
+                     get_two_e_integral(u,v,p,t,mo_integrals_map) * two_e_dm_mo(u,v,s,t) &
+                   + get_two_e_integral(s,t,u,v,mo_integrals_map) * two_e_dm_mo(p,t,u,v))
+
+                 enddo
+               enddo
+             enddo
+           endif
+
+        enddo
+      enddo
+    enddo
+  enddo
+
+  CALL wall_time(t5)
+  t6 = t5-t4
+  print*,'l2 1 :', t6
+
+  !==========================
+  ! Second line, second term
+  !==========================
+
+  CALL wall_time(t4)
+
+  do s = 1, mo_num
+    do r = 1, mo_num
+      do q = 1, mo_num
+        do p = 1, mo_num
+
+!  do p = 1, mo_num
+!    do q = 1, mo_num
+!      do r = 1, mo_num
+!        do s = 1, mo_num
+
+          if (p==s) then
+            do t = 1, mo_num
+              do u = 1, mo_num
+                do v = 1, mo_num
+
+                  hessian(p,q,r,s) = hessian(p,q,r,s) + 0.5d0 * ( &
+                    get_two_e_integral(q,t,u,v,mo_integrals_map) * two_e_dm_mo(r,t,u,v) &
+                  + get_two_e_integral(u,v,r,t,mo_integrals_map) * two_e_dm_mo(u,v,q,t))
+
+                enddo
+              enddo
+            enddo
+          endif
+
+        enddo
+      enddo
+    enddo
+  enddo
+
+  CALL wall_time(t5)
+  t6 = t5-t4
+  print*,'l2 2 :', t6
+
+  !========================
+  ! Third line, first term
+  !========================
+
+  CALL wall_time(t4)
+
+      do s = 1, mo_num
+        do r = 1, mo_num
+          do q = 1, mo_num
+            do p = 1, mo_num
+
+!  do p = 1, mo_num
+!    do q = 1, mo_num
+!      do r = 1, mo_num
+!        do s = 1, mo_num
+
+          do u = 1, mo_num
+            do v = 1, mo_num
+
+              hessian(p,q,r,s) = hessian(p,q,r,s) &
+               + get_two_e_integral(u,v,p,r,mo_integrals_map) * two_e_dm_mo(u,v,q,s) &
+               + get_two_e_integral(q,s,u,v,mo_integrals_map) * two_e_dm_mo(p,r,u,v)
+
+            enddo
+          enddo
+
+        enddo
+      enddo
+    enddo
+  enddo
+ 
+  CALL wall_time(t5)
+  t6 = t5-t4
+  print*,'l3 1 :', t6
+
+  !=========================
+  ! Third line, second term
+  !=========================
+
+  CALL wall_time(t4)
+
+      do s = 1, mo_num
+        do r = 1, mo_num
+          do q = 1, mo_num
+            do p = 1, mo_num
+
+!  do p = 1, mo_num
+!    do q = 1, mo_num
+!      do r = 1, mo_num
+!        do s = 1, mo_num
+
+          do t = 1, mo_num
+            do u = 1, mo_num
+
+              hessian(p,q,r,s) = hessian(p,q,r,s) &
+               - get_two_e_integral(s,t,p,u,mo_integrals_map) * two_e_dm_mo(r,t,q,u) &
+               - get_two_e_integral(t,s,p,u,mo_integrals_map) * two_e_dm_mo(t,r,q,u) &
+               - get_two_e_integral(q,u,r,t,mo_integrals_map) * two_e_dm_mo(p,u,s,t) &
+               - get_two_e_integral(q,u,t,r,mo_integrals_map) * two_e_dm_mo(p,u,t,s)
+
+            enddo
+          enddo
+
+        enddo
+      enddo
+    enddo
+  enddo
+
+  CALL wall_time(t5)
+  t6 = t5-t4
+  print*,'l3 2 :', t6
+
+  CALL wall_time(t2)
+  t3 = t2 -t1
+  print*,'Time to compute the hessian : ', t3
+
+  !==============
+  ! Permutations 
+  !==============
+
+  ! Hessian(p,q,r,s) = P_pq P_rs [ ...]
+  ! => Hessian(p,q,r,s) = (p,q,r,s) - (q,p,r,s) - (p,q,s,r) + (q,p,s,r) 
+
+  do s = 1, mo_num
+    do r = 1, mo_num
+      do q = 1, mo_num
+        do p = 1, mo_num
+
+          h_tmpr(p,q,r,s) = (hessian(p,q,r,s) - hessian(q,p,r,s) - hessian(p,q,s,r) + hessian(q,p,s,r))
+
+        enddo
+      enddo
+    enddo
+  enddo
+
+  !========================
+  ! 4D matrix to 2D matrix
+  !========================
+
+  ! Convert the hessian mo_num * mo_num * mo_num * mo_num matrix in a
+  ! 2D n * n matrix (n = mo_num*(mo_num-1)/2)
+  ! H(pq,rs) : p<q and r<s
+
+  ! 4D mo_num matrix to 2D n matrix
+  do pq = 1, n
+    call vec_to_mat_index(pq,p,q)
+    do rs = 1, n
+      call vec_to_mat_index(rs,r,s)
+      H(pq,rs) = h_tmpr(p,q,r,s)   
+    enddo
+  enddo
+
+  ! Display
+  if (debug) then 
+    print*,'2D Hessian matrix'
+    do pq = 1, n
+      write(*,'(100(F10.5))') H(pq,:)
+    enddo 
+  endif
+
+  !==============
+  ! Deallocation
+  !==============
+
+  deallocate(hessian)
+
+  if (debug) then
+    print*,'Leave first_hess'
+  endif
+
+end subroutine

src/mo_optimization/gradient_list_opt.irp.f

@@ -0,0 +1,381 @@
+! Gradient
+
+! The gradient of the CI energy with respects to the orbital rotation
+! is:
+! (C-c C-x C-l)
+! $$
+! G(p,q) = \mathcal{P}_{pq} \left[ \sum_r (h_p^r \gamma_r^q - h_r^q \gamma_p^r) +
+! \sum_{rst}(v_{pt}^{rs} \Gamma_{rs}^{qt} - v_{rs}^{qt} \Gamma_{pt}^{rs})
+! \right]
+! $$
+
+
+! $$
+! \mathcal{P}_{pq}= 1 - (p \leftrightarrow q)
+! $$
+
+! $$
+! G(p,q) = \left[
+! \sum_r (h_p^r \gamma_r^q - h_r^q \gamma_p^r) +
+! \sum_{rst}(v_{pt}^{rs} \Gamma_{rs}^{qt} - v_{rs}^{qt} \Gamma_{pt}^{rs})
+! \right] - 
+! \left[
+! \sum_r (h_q^r \gamma_r^p - h_r^p \gamma_q^r) +
+! \sum_{rst}(v_{qt}^{rs} \Gamma_{rs}^{pt} - v_{rs}^{pt}
+! \Gamma_{qt}^{rs})
+! \right]
+! $$
+
+! Where p,q,r,s,t are general spatial orbitals
+! mo_num : the number of molecular orbitals
+! $$h$$ : One electron integrals
+! $$\gamma$$ : One body density matrix (state average in our case)
+! $$v$$ : Two electron integrals
+! $$\Gamma$$ : Two body density matrice (state average in our case)
+
+! The gradient is a mo_num by mo_num matrix, p,q,r,s,t take all the
+! values between 1 and mo_num (1 and mo_num include).
+
+! To do that we compute $$G(p,q)$$ for all the pairs (p,q).
+
+! Source :
+! Seniority-based coupled cluster theory
+! J. Chem. Phys. 141, 244104 (2014); https://doi.org/10.1063/1.4904384
+! Thomas M. Henderson, Ireneusz W. Bulik, Tamar Stein, and Gustavo
+! E. Scuseria
+
+! *Compute the gradient of energy with respects to orbital rotations*
+
+! Provided:
+! | mo_num                                   | integer          | number of MOs             |
+! | mo_one_e_integrals(mo_num,mo_num)        | double precision | mono_electronic integrals |
+! | one_e_dm_mo(mo_num,mo_num)               | double precision | one e- density matrix     |
+! | two_e_dm_mo(mo_num,mo_num,mo_num,mo_num) | double precision | two e- density matrix     |
+
+! Input:
+! | n | integer | mo_num*(mo_num-1)/2 |
+
+! Output:
+! | v_grad(n) | double precision | the gradient                    |
+! | max_elem  | double precision | maximum element of the gradient |
+
+! Internal:
+! | grad(mo_num,mo_num)                | double precison   | gradient before the tranformation in a vector             |
+! | A((mo_num,mo_num)                  | doubre precision  | gradient after the permutations                           |
+! | norm                               | double precision  | norm of the gradient                                      |
+! | p, q                               | integer           | indexes of the element in the matrix grad                 |
+! | i                                  | integer           | index for the tranformation in a vector                   |
+! | r, s, t                            | integer           | indexes dor the sums                                      |
+! | t1, t2, t3                         | double precision  | t3 = t2 - t1, time to compute the gradient                |
+! | t4, t5, t6                         | double precission | t6 = t5 - t4, time to compute each element                |
+! | tmp_bi_int_3(mo_num,mo_num,mo_num) | double precision  | 3 indexes temporary array for the bi-electronic integrals |
+! | tmp_2rdm_3(mo_num,mo_num,mo_num)   | double precision  | 3 indexes temporary array for the two e- density matrix   |
+! | tmp_accu(mo_num,mo_num)            | double precision  | temporary array                                           |
+
+! Function:
+! | get_two_e_integral | double precision | bi-electronic integrals |
+! | dnrm2              | double precision | (Lapack) norm           |
+
+
+subroutine gradient_list_opt(n,m,list,v_grad,max_elem,norm)
+  use omp_lib
+  include 'constants.h'
+
+  implicit none
+  
+  ! Variables
+  
+  ! in
+  integer, intent(in) :: n,m,list(m)
+  
+  ! out
+  double precision, intent(out) :: v_grad(n), max_elem, norm
+
+  ! internal
+  double precision, allocatable :: grad(:,:),A(:,:)
+  integer                       :: i,p,q,r,s,t, tmp_p, tmp_q, tmp_i
+  double precision              :: t1,t2,t3,t4,t5,t6
+
+  double precision, allocatable :: tmp_accu(:,:), tmp_mo_one_e_integrals(:,:),tmp_one_e_dm_mo(:,:)
+  double precision, allocatable :: tmp_bi_int_3(:,:,:), tmp_2rdm_3(:,:,:)
+
+  ! Functions
+  double precision :: get_two_e_integral, dnrm2
+
+  
+  print*,''
+  print*,'---gradient---'
+
+  ! Allocation of shared arrays
+  allocate(grad(m,m),A(m,m)) 
+  allocate(tmp_mo_one_e_integrals(m,mo_num),tmp_one_e_dm_mo(mo_num,m))
+
+
+  ! Initialization omp
+  call omp_set_max_active_levels(1)
+
+  !$OMP PARALLEL                                                 &
+      !$OMP PRIVATE(                                             &
+      !$OMP   p,q,r,s,t,tmp_p,tmp_q,                             &
+      !$OMP   tmp_accu,tmp_bi_int_3, tmp_2rdm_3)                &
+      !$OMP SHARED(grad, one_e_dm_mo,m,list,mo_num,mo_one_e_integrals, &
+      !$OMP mo_integrals_map,tmp_one_e_dm_mo, tmp_mo_one_e_integrals,t4,t5,t6)                           &
+      !$OMP DEFAULT(SHARED)
+ 
+  ! Allocation of private arrays
+  allocate(tmp_accu(m,m))
+  allocate(tmp_bi_int_3(mo_num,mo_num,m))
+  allocate(tmp_2rdm_3(mo_num,mo_num,m))
+
+! Initialization
+
+!$OMP DO
+do tmp_q = 1, m
+  do tmp_p = 1, m
+    grad(tmp_p,tmp_q) = 0d0
+  enddo
+enddo
+!$OMP END DO
+
+! Term 1
+  
+! Without optimization the term 1 is :
+
+! do p = 1, mo_num
+!   do q = 1, mo_num
+!      do r = 1, mo_num
+!        grad(p,q) = grad(p,q) &
+!                + mo_one_e_integrals(p,r) * one_e_dm_mo(r,q) &
+!                - mo_one_e_integrals(r,q) * one_e_dm_mo(p,r)
+!     enddo
+!   enddo
+! enddo
+   
+! Since the matrix multiplication A.B is defined like :
+! \begin{equation}
+! c_{ij} = \sum_k a_{ik}.b_{kj}
+! \end{equation}
+! The previous equation can be rewritten as a matrix multplication  
+  
+
+!****************
+  ! Opt first term
+  !****************
+
+  !$OMP DO
+  do r = 1, mo_num
+    do tmp_p = 1, m
+      p = list(tmp_p)
+      tmp_mo_one_e_integrals(tmp_p,r) = mo_one_e_integrals(p,r)
+    enddo
+  enddo
+  !$OMP END DO
+
+  !$OMP DO
+  do tmp_q = 1, m
+    q = list(tmp_q) 
+    do r = 1, mo_num
+      tmp_one_e_dm_mo(r,tmp_q) = one_e_dm_mo(r,q)
+    enddo
+  enddo
+  !$OMP END DO
+
+  call dgemm('N','N',m,m,mo_num,1d0,&
+  tmp_mo_one_e_integrals, size(tmp_mo_one_e_integrals,1),&
+  tmp_one_e_dm_mo,size(tmp_one_e_dm_mo,1),0d0,tmp_accu,size(tmp_accu,1))
+
+  !$OMP DO
+  do tmp_q = 1, m
+    do tmp_p = 1, m
+
+      grad(tmp_p,tmp_q) = grad(tmp_p,tmp_q) + (tmp_accu(tmp_p,tmp_q) - tmp_accu(tmp_q,tmp_p))
+
+    enddo
+  enddo 
+  !$OMP END DO
+
+  !$OMP MASTER
+  CALL wall_TIME(t4)
+  !$OMP END MASTER
+
+!  call dgemm('N','N',mo_num,mo_num,mo_num,1d0,mo_one_e_integrals,&
+!  mo_num,one_e_dm_mo,mo_num,0d0,tmp_accu,mo_num)
+!  
+!  !$OMP DO
+!  do q = 1, mo_num
+!    do p = 1, mo_num
+!
+!      grad(p,q) = grad(p,q) + (tmp_accu(p,q) - tmp_accu(q,p))
+!
+!    enddo
+!  enddo 
+!  !$OMP END DO
+  
+  !$OMP MASTER
+  CALL wall_TIME(t5)
+  t6 = t5-t4
+  print*,'Gradient, first term (s) :', t6 
+  !$OMP END MASTER
+
+! Term 2
+ 
+! Without optimization the second term is : 
+
+! do p = 1, mo_num
+!   do q = 1, mo_num 
+!     do r = 1, mo_num
+!       do s = 1, mo_num
+!         do t= 1, mo_num
+
+!         grad(p,q) = grad(p,q) &
+!                 + get_two_e_integral(p,t,r,s,mo_integrals_map) * two_e_dm_mo(r,s,q,t) &
+!                 - get_two_e_integral(r,s,q,t,mo_integrals_map) * two_e_dm_mo(p,t,r,s)
+!        enddo
+!       enddo
+!     enddo
+!   enddo
+! enddo
+
+! Using the bielectronic integral properties :
+! get_two_e_integral(p,t,r,s,mo_integrals_map) = get_two_e_integral(r,s,p,t,mo_integrals_map)
+
+! Using the two body matrix properties :
+! two_e_dm_mo(p,t,r,s) = two_e_dm_mo(r,s,p,t)
+
+! t is one the right, we can put it on the external loop and create 3
+! indexes temporary array 
+! r,s can be seen as one index
+
+! By doing so, a matrix multiplication appears 
+
+
+!*****************
+! Opt second term  
+!*****************
+
+!$OMP MASTER
+CALL wall_TIME(t4)
+!$OMP END MASTER 
+
+!$OMP DO
+do t = 1, mo_num
+
+  do tmp_p = 1, m
+    p = list(tmp_p)
+    do s = 1, mo_num
+      do r = 1, mo_num
+
+        tmp_bi_int_3(r,s,tmp_p) = get_two_e_integral(r,s,p,t,mo_integrals_map)
+
+      enddo
+    enddo
+  enddo
+
+  do tmp_q = 1, m
+    q = list(tmp_q)
+    do s = 1, mo_num
+      do r = 1, mo_num
+
+         tmp_2rdm_3(r,s,tmp_q) = two_e_dm_mo(r,s,q,t)
+
+      enddo
+    enddo
+  enddo
+
+  call dgemm('T','N',m,m,mo_num*mo_num,1d0,tmp_bi_int_3,&
+    mo_num*mo_num,tmp_2rdm_3,mo_num*mo_num,0d0,tmp_accu,size(tmp_accu,1))
+
+  !$OMP CRITICAL   
+  do tmp_q = 1, m
+    do tmp_p = 1, m
+
+      grad(tmp_p,tmp_q) = grad(tmp_p,tmp_q) + tmp_accu(tmp_p,tmp_q) - tmp_accu(tmp_q,tmp_p)
+
+    enddo
+  enddo
+  !$OMP END CRITICAL
+
+enddo
+!$OMP END DO
+
+!$OMP MASTER
+CALL wall_TIME(t5)
+t6 = t5-t4
+print*,'Gradient second term (s) : ', t6
+!$OMP END MASTER
+
+! Deallocation of private arrays
+
+deallocate(tmp_bi_int_3,tmp_2rdm_3,tmp_accu)
+
+!$OMP END PARALLEL
+
+call omp_set_max_active_levels(4)
+
+! Permutation, 2D matrix -> vector, transformation
+! In addition there is a permutation in the gradient formula :
+! \begin{equation}
+! P_{pq} = 1 - (p <-> q) 
+! \end{equation}
+
+! We need a vector to use the gradient. Here the gradient is a
+! antisymetric matrix so we can transform it in a vector of length
+! mo_num*(mo_num-1)/2.
+
+! Here we do these two things at the same time.
+
+
+do i=1,n
+  call vec_to_mat_index(i,p,q)
+  v_grad(i)=(grad(p,q) - grad(q,p))
+enddo  
+
+! Debug, diplay the vector containing the gradient elements 
+if (debug) then  
+  print*,'Vector containing the gradient :'
+  write(*,'(100(F10.5))') v_grad(1:n)
+endif
+
+! Norm of the gradient
+! The norm can be useful.
+
+norm = dnrm2(n,v_grad,1)
+print*, 'Gradient norm : ', norm
+
+! Maximum element in the gradient
+! The maximum element in the gradient is very important for the
+! convergence criterion of the Newton method.
+
+
+! Max element of the gradient
+max_elem = 0d0
+do i = 1, n
+  if (DABS(v_grad(i)) > DABS(max_elem)) then
+    max_elem = v_grad(i)
+  endif
+enddo
+
+print*,'Max element in the gradient :', max_elem  
+
+! Debug, display the matrix containting the gradient elements
+if (debug) then
+  ! Matrix gradient
+  A = 0d0
+  do q=1,m
+    do p=1,m
+      A(p,q) = grad(p,q) - grad(q,p)
+    enddo
+  enddo
+  print*,'Matrix containing the gradient :'
+  do i = 1, m
+    write(*,'(100(F10.5))') A(i,1:m)
+  enddo
+endif
+
+! Deallocation of shared arrays and end
+
+deallocate(grad,A, tmp_mo_one_e_integrals,tmp_one_e_dm_mo)
+
+print*,'---End gradient---'
+
+end subroutine

src/mo_optimization/gradient_opt.irp.f

@@ -0,0 +1,346 @@
+! Gradient
+
+! The gradient of the CI energy with respects to the orbital rotation
+! is:
+! (C-c C-x C-l)
+! $$
+! G(p,q) = \mathcal{P}_{pq} \left[ \sum_r (h_p^r \gamma_r^q - h_r^q \gamma_p^r) +
+! \sum_{rst}(v_{pt}^{rs} \Gamma_{rs}^{qt} - v_{rs}^{qt} \Gamma_{pt}^{rs})
+! \right]
+! $$
+
+
+! $$
+! \mathcal{P}_{pq}= 1 - (p \leftrightarrow q)
+! $$
+
+! $$
+! G(p,q) = \left[
+! \sum_r (h_p^r \gamma_r^q - h_r^q \gamma_p^r) +
+! \sum_{rst}(v_{pt}^{rs} \Gamma_{rs}^{qt} - v_{rs}^{qt} \Gamma_{pt}^{rs})
+! \right] - 
+! \left[
+! \sum_r (h_q^r \gamma_r^p - h_r^p \gamma_q^r) +
+! \sum_{rst}(v_{qt}^{rs} \Gamma_{rs}^{pt} - v_{rs}^{pt}
+! \Gamma_{qt}^{rs})
+! \right]
+! $$
+
+! Where p,q,r,s,t are general spatial orbitals
+! mo_num : the number of molecular orbitals
+! $$h$$ : One electron integrals
+! $$\gamma$$ : One body density matrix (state average in our case)
+! $$v$$ : Two electron integrals
+! $$\Gamma$$ : Two body density matrice (state average in our case)
+
+! The gradient is a mo_num by mo_num matrix, p,q,r,s,t take all the
+! values between 1 and mo_num (1 and mo_num include).
+
+! To do that we compute $$G(p,q)$$ for all the pairs (p,q).
+
+! Source :
+! Seniority-based coupled cluster theory
+! J. Chem. Phys. 141, 244104 (2014); https://doi.org/10.1063/1.4904384
+! Thomas M. Henderson, Ireneusz W. Bulik, Tamar Stein, and Gustavo
+! E. Scuseria
+
+! *Compute the gradient of energy with respects to orbital rotations*
+
+! Provided:
+! | mo_num                                   | integer          | number of MOs             |
+! | mo_one_e_integrals(mo_num,mo_num)        | double precision | mono_electronic integrals |
+! | one_e_dm_mo(mo_num,mo_num)               | double precision | one e- density matrix     |
+! | two_e_dm_mo(mo_num,mo_num,mo_num,mo_num) | double precision | two e- density matrix     |
+
+! Input:
+! | n | integer | mo_num*(mo_num-1)/2 |
+
+! Output:
+! | v_grad(n) | double precision | the gradient                    |
+! | max_elem  | double precision | maximum element of the gradient |
+
+! Internal:
+! | grad(mo_num,mo_num)                | double precison   | gradient before the tranformation in a vector             |
+! | A((mo_num,mo_num)                  | doubre precision  | gradient after the permutations                           |
+! | norm                               | double precision  | norm of the gradient                                      |
+! | p, q                               | integer           | indexes of the element in the matrix grad                 |
+! | i                                  | integer           | index for the tranformation in a vector                   |
+! | r, s, t                            | integer           | indexes dor the sums                                      |
+! | t1, t2, t3                         | double precision  | t3 = t2 - t1, time to compute the gradient                |
+! | t4, t5, t6                         | double precission | t6 = t5 - t4, time to compute each element                |
+! | tmp_bi_int_3(mo_num,mo_num,mo_num) | double precision  | 3 indexes temporary array for the bi-electronic integrals |
+! | tmp_2rdm_3(mo_num,mo_num,mo_num)   | double precision  | 3 indexes temporary array for the two e- density matrix   |
+! | tmp_accu(mo_num,mo_num)            | double precision  | temporary array                                           |
+
+! Function:
+! | get_two_e_integral | double precision | bi-electronic integrals |
+! | dnrm2              | double precision | (Lapack) norm           |
+
+
+subroutine gradient_opt(n,v_grad,max_elem)
+  use omp_lib
+  include 'constants.h'
+
+  implicit none
+  
+  ! Variables
+  
+  ! in
+  integer, intent(in) :: n
+  
+  ! out
+  double precision, intent(out) :: v_grad(n), max_elem
+
+  ! internal
+  double precision, allocatable :: grad(:,:),A(:,:)
+  double precision              :: norm
+  integer                       :: i,p,q,r,s,t
+  double precision              :: t1,t2,t3,t4,t5,t6
+
+  double precision, allocatable :: tmp_accu(:,:)
+  double precision, allocatable :: tmp_bi_int_3(:,:,:), tmp_2rdm_3(:,:,:)
+
+  ! Functions
+  double precision :: get_two_e_integral, dnrm2
+
+  
+  print*,''
+  print*,'---gradient---'
+
+  ! Allocation of shared arrays
+  allocate(grad(mo_num,mo_num),A(mo_num,mo_num)) 
+
+  ! Initialization omp
+  call omp_set_max_active_levels(1)
+
+  !$OMP PARALLEL                                                 &
+      !$OMP PRIVATE(                                             &
+      !$OMP   p,q,r,s,t,                                         &
+      !$OMP   tmp_accu, tmp_bi_int_3, tmp_2rdm_3)                &
+      !$OMP SHARED(grad, one_e_dm_mo, mo_num,mo_one_e_integrals, &
+      !$OMP mo_integrals_map,t4,t5,t6)                           &
+      !$OMP DEFAULT(SHARED)
+ 
+  ! Allocation of private arrays
+  allocate(tmp_accu(mo_num,mo_num))
+  allocate(tmp_bi_int_3(mo_num,mo_num,mo_num))
+  allocate(tmp_2rdm_3(mo_num,mo_num,mo_num))
+
+! Initialization
+
+!$OMP DO
+do q = 1, mo_num
+  do p = 1,mo_num
+    grad(p,q) = 0d0
+  enddo
+enddo
+!$OMP END DO
+
+! Term 1
+  
+! Without optimization the term 1 is :
+
+! do p = 1, mo_num
+!   do q = 1, mo_num
+!      do r = 1, mo_num
+!        grad(p,q) = grad(p,q) &
+!                + mo_one_e_integrals(p,r) * one_e_dm_mo(r,q) &
+!                - mo_one_e_integrals(r,q) * one_e_dm_mo(p,r)
+!     enddo
+!   enddo
+! enddo
+   
+! Since the matrix multiplication A.B is defined like :
+! \begin{equation}
+! c_{ij} = \sum_k a_{ik}.b_{kj}
+! \end{equation}
+! The previous equation can be rewritten as a matrix multplication  
+  
+
+!****************
+! Opt first term
+!****************
+
+!$OMP MASTER
+CALL wall_TIME(t4)
+!$OMP END MASTER
+
+call dgemm('N','N',mo_num,mo_num,mo_num,1d0,mo_one_e_integrals,&
+mo_num,one_e_dm_mo,mo_num,0d0,tmp_accu,mo_num)
+
+!$OMP DO
+do q = 1, mo_num
+  do p = 1, mo_num
+
+    grad(p,q) = grad(p,q) + (tmp_accu(p,q) - tmp_accu(q,p))
+
+  enddo
+enddo 
+!$OMP END DO
+
+!$OMP MASTER
+CALL wall_TIME(t5)
+t6 = t5-t4
+print*,'Gradient, first term (s) :', t6 
+!$OMP END MASTER
+
+! Term 2
+ 
+! Without optimization the second term is : 
+
+! do p = 1, mo_num
+!   do q = 1, mo_num 
+!     do r = 1, mo_num
+!       do s = 1, mo_num
+!         do t= 1, mo_num
+
+!         grad(p,q) = grad(p,q) &
+!                 + get_two_e_integral(p,t,r,s,mo_integrals_map) * two_e_dm_mo(r,s,q,t) &
+!                 - get_two_e_integral(r,s,q,t,mo_integrals_map) * two_e_dm_mo(p,t,r,s)
+!        enddo
+!       enddo
+!     enddo
+!   enddo
+! enddo
+
+! Using the bielectronic integral properties :
+! get_two_e_integral(p,t,r,s,mo_integrals_map) = get_two_e_integral(r,s,p,t,mo_integrals_map)
+
+! Using the two body matrix properties :
+! two_e_dm_mo(p,t,r,s) = two_e_dm_mo(r,s,p,t)
+
+! t is one the right, we can put it on the external loop and create 3
+! indexes temporary array 
+! r,s can be seen as one index
+
+! By doing so, a matrix multiplication appears 
+
+
+!*****************
+! Opt second term  
+!*****************
+
+!$OMP MASTER
+CALL wall_TIME(t4)
+!$OMP END MASTER 
+
+!$OMP DO
+do t = 1, mo_num
+
+  do p = 1, mo_num
+    do s = 1, mo_num
+      do r = 1, mo_num
+
+        tmp_bi_int_3(r,s,p) = get_two_e_integral(r,s,p,t,mo_integrals_map)
+
+      enddo
+    enddo
+  enddo
+
+  do q = 1, mo_num
+    do s = 1, mo_num
+      do r = 1, mo_num
+
+         tmp_2rdm_3(r,s,q) = two_e_dm_mo(r,s,q,t)
+
+      enddo
+    enddo
+  enddo
+
+  call dgemm('T','N',mo_num,mo_num,mo_num*mo_num,1d0,tmp_bi_int_3,&
+    mo_num*mo_num,tmp_2rdm_3,mo_num*mo_num,0d0,tmp_accu,mo_num)
+
+  !$OMP CRITICAL   
+  do q = 1, mo_num
+    do p = 1, mo_num
+
+      grad(p,q) = grad(p,q) + tmp_accu(p,q) - tmp_accu(q,p)
+
+    enddo
+  enddo
+  !$OMP END CRITICAL
+
+enddo
+!$OMP END DO
+
+!$OMP MASTER
+CALL wall_TIME(t5)
+t6 = t5-t4
+print*,'Gradient second term (s) : ', t6
+!$OMP END MASTER
+
+! Deallocation of private arrays
+
+deallocate(tmp_bi_int_3,tmp_2rdm_3,tmp_accu)
+
+!$OMP END PARALLEL
+
+call omp_set_max_active_levels(4)
+
+! Permutation, 2D matrix -> vector, transformation
+! In addition there is a permutation in the gradient formula :
+! \begin{equation}
+! P_{pq} = 1 - (p <-> q) 
+! \end{equation}
+
+! We need a vector to use the gradient. Here the gradient is a
+! antisymetric matrix so we can transform it in a vector of length
+! mo_num*(mo_num-1)/2.
+
+! Here we do these two things at the same time.
+
+
+do i=1,n
+  call vec_to_mat_index(i,p,q)
+  v_grad(i)=(grad(p,q) - grad(q,p))
+enddo  
+
+! Debug, diplay the vector containing the gradient elements 
+if (debug) then  
+  print*,'Vector containing the gradient :'
+  write(*,'(100(F10.5))') v_grad(1:n)
+endif
+
+! Norm of the gradient
+! The norm can be useful.
+
+norm = dnrm2(n,v_grad,1)
+print*, 'Gradient norm : ', norm
+
+! Maximum element in the gradient
+! The maximum element in the gradient is very important for the
+! convergence criterion of the Newton method.
+
+
+! Max element of the gradient
+max_elem = 0d0
+do i = 1, n
+  if (ABS(v_grad(i)) > ABS(max_elem)) then
+    max_elem = v_grad(i)
+  endif
+enddo
+
+print*,'Max element in the gradient :', max_elem  
+
+! Debug, display the matrix containting the gradient elements
+if (debug) then
+  ! Matrix gradient
+  A = 0d0
+  do q=1,mo_num
+    do p=1,mo_num
+      A(p,q) = grad(p,q) - grad(q,p)
+    enddo
+  enddo
+  print*,'Matrix containing the gradient :'
+  do i = 1, mo_num
+    write(*,'(100(F10.5))') A(i,1:mo_num)
+  enddo
+endif
+
+! Deallocation of shared arrays and end
+
+deallocate(grad,A)
+
+print*,'---End gradient---'
+
+end subroutine

src/mo_optimization/my_providers.irp.f

@@ -0,0 +1,141 @@
+! Dimensions of MOs
+
+
+BEGIN_PROVIDER [ integer, n_mo_dim ]
+  implicit none
+  BEGIN_DOC
+  ! Number of different pairs (i,j) of MOs we can build,
+  ! with i>j
+  END_DOC
+
+  n_mo_dim = mo_num*(mo_num-1)/2
+
+END_PROVIDER
+
+BEGIN_PROVIDER [ integer, n_mo_dim_core ]
+  implicit none 
+  BEGIN_DOC
+  ! Number of different pairs (i,j) of core MOs we can build,
+  ! with i>j
+  END_DOC
+
+  n_mo_dim_core = dim_list_core_orb*(dim_list_core_orb-1)/2
+
+END_PROVIDER
+
+BEGIN_PROVIDER [ integer, n_mo_dim_act ]
+  implicit none
+  BEGIN_DOC
+  ! Number of different pairs (i,j) of active MOs we can build,
+  ! with i>j
+  END_DOC
+
+  n_mo_dim_act = dim_list_act_orb*(dim_list_act_orb-1)/2
+
+END_PROVIDER
+
+BEGIN_PROVIDER [ integer, n_mo_dim_inact ]
+  implicit none 
+  BEGIN_DOC
+  ! Number of different pairs (i,j) of inactive MOs we can build,
+  ! with i>j
+  END_DOC
+
+  n_mo_dim_inact = dim_list_inact_orb*(dim_list_inact_orb-1)/2
+
+END_PROVIDER
+
+BEGIN_PROVIDER [ integer, n_mo_dim_virt ]
+  implicit none 
+  BEGIN_DOC
+  ! Number of different pairs (i,j) of virtual MOs we can build,
+  ! with i>j
+  END_DOC
+
+  n_mo_dim_virt = dim_list_virt_orb*(dim_list_virt_orb-1)/2
+
+END_PROVIDER
+
+! Energies/criterions
+
+BEGIN_PROVIDER [ double precision, my_st_av_energy ]
+  implicit none
+  BEGIN_DOC
+  ! State average CI energy
+  END_DOC
+
+  !call update_st_av_ci_energy(my_st_av_energy)
+  call state_average_energy(my_st_av_energy)
+
+END_PROVIDER
+
+! With all the MOs
+
+BEGIN_PROVIDER [ double precision, my_gradient_opt, (n_mo_dim) ]
+&BEGIN_PROVIDER [ double precision, my_CC1_opt ]
+  implicit none
+  BEGIN_DOC
+  ! - Gradient of the energy with respect to the MO rotations, for all the MOs.
+  ! - Maximal element of the gradient in absolute value 
+  END_DOC
+
+  double precision :: norm_grad
+
+  PROVIDE mo_two_e_integrals_in_map
+
+  call gradient_opt(n_mo_dim, my_gradient_opt, my_CC1_opt, norm_grad)
+
+END_PROVIDER
+
+BEGIN_PROVIDER [ double precision, my_hessian_opt, (n_mo_dim, n_mo_dim) ]
+  implicit none
+  BEGIN_DOC
+  ! - Gradient of the energy with respect to the MO rotations, for all the MOs.
+  ! - Maximal element of the gradient in absolute value 
+  END_DOC
+
+  double precision, allocatable :: h_f(:,:,:,:)
+
+  PROVIDE mo_two_e_integrals_in_map
+
+  allocate(h_f(mo_num, mo_num, mo_num, mo_num))
+
+  call hessian_list_opt(n_mo_dim, my_hessian_opt, h_f)
+
+END_PROVIDER
+
+! With the list of active MOs
+! Can be generalized to any mo_class by changing the list/dimension
+
+BEGIN_PROVIDER [ double precision, my_gradient_list_opt, (n_mo_dim_act) ]
+&BEGIN_PROVIDER [ double precision, my_CC2_opt ]
+  implicit none
+  BEGIN_DOC
+  ! - Gradient of the energy with respect to the MO rotations, only for the active MOs !
+  ! - Maximal element of the gradient in absolute value 
+  END_DOC
+
+  double precision :: norm_grad
+
+  PROVIDE mo_two_e_integrals_in_map !one_e_dm_mo two_e_dm_mo mo_one_e_integrals 
+
+  call gradient_list_opt(n_mo_dim_act, dim_list_act_orb, list_act, my_gradient_list_opt, my_CC2_opt, norm_grad)
+
+END_PROVIDER
+
+BEGIN_PROVIDER [ double precision, my_hessian_list_opt, (n_mo_dim_act, n_mo_dim_act) ]
+  implicit none
+  BEGIN_DOC
+  ! - Gradient of the energy with respect to the MO rotations, only for the active MOs !
+  ! - Maximal element of the gradient in absolute value 
+  END_DOC
+
+  double precision, allocatable :: h_f(:,:,:,:)
+
+  PROVIDE mo_two_e_integrals_in_map
+
+  allocate(h_f(dim_list_act_orb, dim_list_act_orb, dim_list_act_orb, dim_list_act_orb))
+
+  call hessian_list_opt(n_mo_dim_act, dim_list_act_orb, list_act, my_hessian_list_opt, h_f)
+
+END_PROVIDER

src/mo_optimization/optimization.irp.f

@@ -0,0 +1,86 @@
+program optimization
+  
+  read_wf = .true. ! must be True for the orbital optimization !!!
+  TOUCH read_wf 
+  call run_optimization
+
+end
+
+subroutine run_optimization
+
+  implicit none
+
+  double precision :: e_cipsi, e_opt, delta_e
+  integer :: nb_iter,i
+  logical :: not_converged
+  character (len=100) :: filename
+
+  PROVIDE psi_det psi_coef mo_two_e_integrals_in_map
+
+  not_converged = .True.
+  nb_iter = 0
+
+  ! To start from the wf
+  N_det_max = max(n_det,5)
+  TOUCH N_det_max
+
+  open(unit=10, file=trim(ezfio_filename)//'/mo_optimization/result_opt')
+  write(10,*) "   Ndet        E_cipsi         E_opt          Delta_e"
+  call state_average_energy(e_cipsi)
+  write(10,'(I10, 3F15.7)') n_det, e_cipsi, e_cipsi, 0d0
+  close(10)
+
+  do while (not_converged)
+      print*,''
+      print*,'======================'
+      print*,' Cipsi step:', nb_iter
+      print*,'======================'
+      print*,'' 
+      print*,'********** cipsi step **********'
+      ! cispi calculation
+      call run_stochastic_cipsi
+
+      ! State average energy after the cipsi step
+      call state_average_energy(e_cipsi)
+
+      print*,''
+      print*,'********** optimization step **********'
+      ! orbital optimization
+      call run_orb_opt_trust_v2
+
+      ! State average energy after the orbital optimization
+      call state_average_energy(e_opt)
+
+      print*,''
+      print*,'********** diff step **********'
+      ! Gain in energy
+      delta_e = e_opt - e_cipsi
+      print*, 'Gain in energy during the orbital optimization:', delta_e
+
+      open(unit=10, file=trim(ezfio_filename)//'/mo_optimization/result_opt', position='append')
+      write(10,'(I10, 3F15.7)') n_det, e_cipsi, e_opt, delta_e
+      close(10)
+
+      ! Exit
+      if (delta_e > 1d-12) then
+          print*, 'WARNING, something wrong happened'
+          print*, 'The gain (delta_e) in energy during the optimization process'
+          print*, 'is > 0, but it must be < 0'
+          print*, 'The program will exit'
+          exit
+      endif
+
+      if (n_det > n_det_max_opt) then
+          print*, 'The number of determinants in the wf > n_det_max_opt'
+          print*, 'The program will exit'
+          exit
+      endif
+      
+      ! To double the number of determinants in the wf
+      N_det_max = int(dble(n_det * 2)*0.9)
+      TOUCH N_det_max
+
+      nb_iter = nb_iter + 1
+  enddo
+
+end

src/mo_optimization/orb_opt.irp.f

@@ -0,0 +1,22 @@
+! Orbital optimization program
+
+! This is an optimization program for molecular orbitals. It produces
+! orbital rotations in order to lower the energy of a truncated wave
+! function.  
+! This program just optimize the orbitals for a fixed number of
+! determinants. This optimization process must be repeated for different
+! number of determinants.
+
+
+
+
+! Main program : orb_opt_trust
+
+
+program orb_opt
+  read_wf = .true. ! must be True for the orbital optimization !!!
+  TOUCH read_wf
+  io_mo_two_e_integrals = 'None'
+  TOUCH io_mo_two_e_integrals
+  call run_orb_opt_trust_v2
+end

src/mo_optimization/org/TANGLE_org_mode.sh

@@ -0,0 +1,7 @@
+#!/bin/sh   
+
+list='ls *.org'
+for element in $list    
+do   
+		emacs --batch $element -f org-babel-tangle
+done

src/mo_optimization/org/TODO.org

@@ -0,0 +1,17 @@
+TODO:
+** TODO Keep under surveillance the performance of rotation matrix
+- is the fix ok ?
+** DONE Provider state_average_weight
+** DONE Diagonal hessian for orbital optimization with a list of MOs
+** DONE Something to force the step cancellation if R.R^T > treshold
+** TODO Iterative method to compute the rotation matrix
+- doesn't work actually
+** DONE Test trust region with polynomial functions
+** DONE Optimization/Localization program using the template
+** DONE Correction OMP hessian shared/private arrays
+** DONE State average energy
+** DONE Correction of Rho
+** TODO Check the PROVIDE/FREE/TOUCH
+** TODO research of lambda without the power 2
+** DONE Clean the OMP sections
+

src/mo_optimization/org/debug_gradient_list_opt.org

@@ -0,0 +1,79 @@
+* Debug the gradient
+
+*Program to check the gradient*
+
+The program compares the result of the first and last code for the
+gradient.
+
+Provided:
+| mo_num | integer | number of MOs |
+
+Internal:
+| n          | integer          | number of orbitals pairs (p,q) p<q |
+| v_grad(n)  | double precision | Original gradient                  |
+| v_grad2(n) | double precision | Gradient                           |
+| i          | integer          | index                              |
+| threshold  | double precision | threshold for the errors           |
+| max_error  | double precision | maximal error in the gradient      |
+| nb_error   | integer          | number of error in the gradient    |
+
+#+BEGIN_SRC f90 :comments org :tangle debug_gradient_list_opt.irp.f
+program debug_gradient_list
+  
+  implicit none
+
+  ! Variables
+
+  double precision, allocatable :: v_grad(:), v_grad2(:)
+  integer                       :: n,m
+  integer                       :: i
+  double precision              :: threshold
+  double precision              :: max_error, max_elem, norm
+  integer                       :: nb_error
+  
+  m = dim_list_act_orb
+  ! Definition of n  
+  n = m*(m-1)/2
+
+  PROVIDE mo_two_e_integrals_in_map ! Vérifier pour suppression
+
+  ! Allocation
+  allocate(v_grad(n), v_grad2(n))
+
+  ! Calculation
+
+  call diagonalize_ci ! Vérifier pour suppression
+
+  ! Gradient  
+  call gradient_list_opt(n,m,list_act,v_grad,max_elem,norm)
+  call first_gradient_list_opt(n,m,list_act,v_grad2)
+  
+  
+  v_grad = v_grad - v_grad2
+  nb_error = 0
+  max_error = 0d0 
+  threshold = 1d-12 
+
+  do i = 1, n
+    if (ABS(v_grad(i)) > threshold) then
+       print*,i,v_grad(i)
+       nb_error = nb_error + 1
+
+       if (ABS(v_grad(i)) > max_error) then
+         max_error = v_grad(i)
+       endif
+
+    endif
+  enddo
+ 
+  print*,''
+  print*,'Check the gradient' 
+  print*,'Threshold:', threshold
+  print*,'Nb error:', nb_error
+  print*,'Max error:', max_error
+
+  ! Deallocation
+  deallocate(v_grad,v_grad2)
+
+end program
+#+END_SRC

src/mo_optimization/org/debug_gradient_opt.org

@@ -0,0 +1,77 @@
+* Debug the gradient
+
+*Program to check the gradient*
+
+The program compares the result of the first and last code for the
+gradient.
+
+Provided:
+| mo_num | integer | number of MOs |
+
+Internal:
+| n          | integer          | number of orbitals pairs (p,q) p<q |
+| v_grad(n)  | double precision | Original gradient                  |
+| v_grad2(n) | double precision | Gradient                           |
+| i          | integer          | index                              |
+| threshold  | double precision | threshold for the errors           |
+| max_error  | double precision | maximal error in the gradient      |
+| nb_error   | integer          | number of error in the gradient    |
+
+#+BEGIN_SRC f90 :comments org :tangle debug_gradient_opt.irp.f
+program debug_gradient
+  
+  implicit none
+
+  ! Variables
+
+  double precision, allocatable :: v_grad(:), v_grad2(:)
+  integer                       :: n
+  integer                       :: i
+  double precision              :: threshold
+  double precision              :: max_error, max_elem
+  integer                       :: nb_error
+  
+  ! Definition of n  
+  n = mo_num*(mo_num-1)/2
+
+  PROVIDE mo_two_e_integrals_in_map ! Vérifier pour suppression
+
+  ! Allocation
+  allocate(v_grad(n), v_grad2(n))
+
+  ! Calculation
+
+  call diagonalize_ci ! Vérifier pour suppression
+
+  ! Gradient  
+  call first_gradient_opt(n,v_grad)
+  call gradient_opt(n,v_grad2,max_elem)
+  
+  v_grad = v_grad - v_grad2
+  nb_error = 0
+  max_error = 0d0 
+  threshold = 1d-12 
+
+  do i = 1, n
+    if (ABS(v_grad(i)) > threshold) then
+       print*,v_grad(i)
+       nb_error = nb_error + 1
+
+       if (ABS(v_grad(i)) > max_error) then
+         max_error = v_grad(i)
+       endif
+
+    endif
+  enddo
+ 
+  print*,''
+  print*,'Check the gradient' 
+  print*,'Threshold :', threshold
+  print*,'Nb error :', nb_error
+  print*,'Max error :', max_error
+
+  ! Deallocation
+  deallocate(v_grad,v_grad2)
+
+end program
+#+END_SRC

src/mo_optimization/org/debug_hessian_list_opt.org

@@ -0,0 +1,148 @@
+* Debug the hessian
+
+*Program to check the hessian matrix*
+
+The program compares the result of the first and last code for the
+hessian. First of all the 4D hessian and after the 2D hessian.
+
+Provided:
+| mo_num                     | integer | number of MOs                        |
+| optimization_method        | string  | Method for the orbital optimization: |
+|                            |         | - 'full' -> full hessian             |
+|                            |         | - 'diag' -> diagonal hessian         |
+| dim_list_act_orb           | integer | number of active MOs                 |
+| list_act(dim_list_act_orb) | integer | list of the actives MOs              |
+|                            |         |                                      |
+
+Internal:
+| m                                 | integer          | number of MOs in the list          |
+|                                   |                  | (active MOs)                       |
+| n                                 | integer          | number of orbitals pairs (p,q) p<q |
+|                                   |                  | n = m*(m-1)/2                      |
+| H(n,n)                            | double precision | Original hessian matrix (2D)       |
+| H2(n,n)                           | double precision | Hessian matrix (2D)                |
+| h_f(mo_num,mo_num,mo_num,mo_num)  | double precision | Original hessian matrix (4D)       |
+| h_f2(mo_num,mo_num,mo_num,mo_num) | double precision | Hessian matrix (4D)                |
+| i,j,p,q,k                         | integer          | indexes                            |
+| threshold                         | double precision | threshold for the errors           |
+| max_error                         | double precision | maximal error in the 4D hessian    |
+| max_error_H                       | double precision | maximal error in the 2D hessian    |
+| nb_error                          | integer          | number of errors in the 4D hessian |
+| nb_error_H                        | integer          | number of errors in the 2D hessian |
+
+#+BEGIN_SRC f90 :comments org :tangle debug_hessian_list_opt.irp.f
+program debug_hessian_list_opt
+
+  implicit none
+
+  ! Variables
+
+  double precision, allocatable :: H(:,:),H2(:,:), h_f(:,:,:,:), h_f2(:,:,:,:)
+  integer                       :: n,m
+  integer                       :: i,j,k,l
+  double precision              :: max_error, max_error_H
+  integer                       :: nb_error, nb_error_H
+  double precision              :: threshold
+  
+  m = dim_list_act_orb !mo_num
+
+  ! Definition of n  
+  n = m*(m-1)/2
+
+  PROVIDE mo_two_e_integrals_in_map ! Vérifier pour suppression
+
+  ! Hessian 
+  if (optimization_method == 'full') then
+    print*,'Use the full hessian matrix'
+    allocate(H(n,n),H2(n,n))  
+    allocate(h_f(m,m,m,m),h_f2(m,m,m,m))
+
+    call hessian_list_opt(n,m,list_act,H,h_f)
+    call first_hessian_list_opt(n,m,list_act,H2,h_f2)
+    !call hessian_opt(n,H2,h_f2)
+
+    ! Difference
+    h_f = h_f - h_f2
+    H = H - H2
+    max_error = 0d0
+    nb_error = 0    
+    threshold = 1d-12
+
+    do l = 1, m
+      do k= 1, m
+        do j = 1, m
+          do i = 1, m
+            if (ABS(h_f(i,j,k,l)) > threshold) then
+              print*,h_f(i,j,k,l)
+              nb_error = nb_error + 1
+              if (ABS(h_f(i,j,k,l)) > ABS(max_error)) then
+                max_error = h_f(i,j,k,l)
+              endif
+            endif
+          enddo
+        enddo
+      enddo
+    enddo
+
+    max_error_H = 0d0
+    nb_error_H = 0
+
+    do j = 1, n
+      do i = 1, n
+        if (ABS(H(i,j)) > threshold) then
+          print*, H(i,j)
+          nb_error_H = nb_error_H + 1
+
+          if (ABS(H(i,j)) > ABS(max_error_H)) then
+            max_error_H = H(i,j)
+          endif
+
+        endif
+      enddo
+    enddo 
+
+    ! Deallocation
+    deallocate(H, H2, h_f, h_f2)
+
+  else
+
+    print*, 'Use the diagonal hessian matrix'
+    allocate(H(n,1),H2(n,1))
+    call diag_hessian_list_opt(n,m,list_act,H)
+    call first_diag_hessian_list_opt(n,m,list_act,H2)
+    
+    H = H - H2
+  
+    max_error_H = 0d0
+    nb_error_H = 0
+ 
+    do i = 1, n
+      if (ABS(H(i,1)) > threshold) then
+        print*, H(i,1)
+        nb_error_H = nb_error_H + 1
+ 
+        if (ABS(H(i,1)) > ABS(max_error_H)) then
+          max_error_H = H(i,1)
+        endif
+ 
+      endif
+    enddo
+   
+ endif
+  
+  print*,''
+  if (optimization_method == 'full') then
+    print*,'Check of the full hessian'
+    print*,'Threshold:', threshold
+    print*,'Nb error:', nb_error
+    print*,'Max error:', max_error
+    print*,''
+  else
+    print*,'Check of the diagonal hessian'
+  endif
+   
+  print*,'Nb error_H:', nb_error_H
+  print*,'Max error_H:', max_error_H
+ 
+end program
+#+END_SRC

src/mo_optimization/org/debug_hessian_opt.org

@@ -0,0 +1,172 @@
+* Debug the hessian
+
+*Program to check the hessian matrix*
+
+The program compares the result of the first and last code for the
+hessian. First of all the 4D hessian and after the 2D hessian.
+
+Provided:
+| mo_num | integer | number of MOs |
+
+Internal:
+| n                                 | integer          | number of orbitals pairs (p,q) p<q |
+| H(n,n)                            | double precision | Original hessian matrix (2D)       |
+| H2(n,n)                           | double precision | Hessian matrix (2D)                |
+| h_f(mo_num,mo_num,mo_num,mo_num)  | double precision | Original hessian matrix (4D)       |
+| h_f2(mo_num,mo_num,mo_num,mo_num) | double precision | Hessian matrix (4D)                |
+| method                            | integer          | - 1: full hessian                  |
+|                                   |                  | - 2: diagonal hessian              |
+| i,j,p,q,k                         | integer          | indexes                            |
+| threshold                         | double precision | threshold for the errors           |
+| max_error                         | double precision | maximal error in the 4D hessian    |
+| max_error_H                       | double precision | maximal error in the 2D hessian    |
+| nb_error                          | integer          | number of errors in the 4D hessian |
+| nb_error_H                        | integer          | number of errors in the 2D hessian |
+
+#+BEGIN_SRC f90 :comments org :tangle debug_hessian_opt.irp.f
+program debug_hessian
+
+  implicit none
+
+  ! Variables
+
+  double precision, allocatable :: H(:,:),H2(:,:), h_f(:,:,:,:), h_f2(:,:,:,:)
+  integer                       :: n
+  integer                       :: i,j,k,l
+  double precision              :: max_error, max_error_H
+  integer                       :: nb_error, nb_error_H
+  double precision              :: threshold
+  
+  ! Definition of n  
+  n = mo_num*(mo_num-1)/2
+
+  PROVIDE mo_two_e_integrals_in_map ! Vérifier pour suppression
+
+  ! Allocation
+  allocate(H(n,n),H2(n,n))  
+  allocate(h_f(mo_num,mo_num,mo_num,mo_num),h_f2(mo_num,mo_num,mo_num,mo_num))
+
+  ! Calculation
+  
+  ! Hessian 
+  if (optimization_method == 'full') then 
+
+    print*,'Use the full hessian matrix'
+    call hessian_opt(n,H,h_f)
+    call first_hessian_opt(n,H2,h_f2)
+
+    ! Difference
+    h_f = h_f - h_f2
+    H = H - H2
+    max_error = 0d0
+    nb_error = 0    
+    threshold = 1d-12
+
+    do l = 1, mo_num
+      do k= 1, mo_num
+        do j = 1, mo_num
+          do i = 1, mo_num
+            if (ABS(h_f(i,j,k,l)) > threshold) then
+              print*,h_f(i,j,k,l)
+              nb_error = nb_error + 1
+              if (ABS(h_f(i,j,k,l)) > ABS(max_error)) then
+                max_error = h_f(i,j,k,l)
+              endif
+            endif
+          enddo
+        enddo
+      enddo
+    enddo
+
+   max_error_H = 0d0
+   nb_error_H = 0
+
+   do j = 1, n
+     do i = 1, n
+       if (ABS(H(i,j)) > threshold) then
+         print*, H(i,j)
+         nb_error_H = nb_error_H + 1
+
+         if (ABS(H(i,j)) > ABS(max_error_H)) then
+           max_error_H = H(i,j)
+         endif
+
+       endif
+     enddo
+   enddo 
+
+  elseif (optimization_method == 'diag') then
+
+    print*, 'Use the diagonal hessian matrix'
+    call diag_hessian_opt(n,H,h_f)
+    call first_diag_hessian_opt(n,H2,h_f2)
+
+    h_f = h_f - h_f2
+    max_error = 0d0
+    nb_error = 0
+    threshold = 1d-12
+
+    do l = 1, mo_num
+      do k = 1, mo_num
+        do j = 1, mo_num
+          do i = 1, mo_num
+
+            if (ABS(h_f(i,j,k,l)) > threshold) then
+
+              print*,h_f(i,j,k,l)
+              nb_error = nb_error + 1
+
+              if (ABS(h_f(i,j,k,l)) > ABS(max_error)) then
+                max_error = h_f(i,j,k,l)
+              endif
+
+            endif
+
+          enddo
+        enddo
+      enddo
+    enddo
+
+    h=H-H2
+  
+    max_error_H = 0d0
+    nb_error_H = 0
+ 
+    do j = 1, n
+      do i = 1, n
+        if (ABS(H(i,j)) > threshold) then
+          print*, H(i,j)
+          nb_error_H = nb_error_H + 1
+ 
+          if (ABS(H(i,j)) > ABS(max_error_H)) then
+            max_error_H = H(i,j)
+          endif
+ 
+        endif
+      enddo
+    enddo
+  
+  else
+    print*,'Unknown optimization_method, please select full, diag'
+    call abort
+  endif
+  
+  print*,''
+  if (optimization_method == 'full') then
+    print*,'Check the full hessian'
+  else
+    print*,'Check the diagonal hessian'
+  endif
+   
+  print*,'Threshold :', threshold
+  print*,'Nb error :', nb_error
+  print*,'Max error :', max_error
+  print*,''
+  print*,'Nb error_H :', nb_error_H
+  print*,'Max error_H :', max_error_H
+ 
+  ! Deallocation
+  deallocate(H,H2,h_f,h_f2)
+
+end program
+#+END_SRC

src/mo_optimization/org/diagonalization_hessian.org

@@ -0,0 +1,138 @@
+* Diagonalization of the hessian
+
+Just a matrix diagonalization using Lapack
+
+Input:
+| n      | integer          | mo_num*(mo_num-1)/2 |
+| H(n,n) | double precision | hessian             |
+
+Output:
+| e_val(n) | double precision | eigenvalues of the hessian  |
+| w(n,n)   | double precision | eigenvectors of the hessian |
+
+Internal:
+| nb_negative_nv | integer          | number of negative eigenvalues                  |
+| lwork          | integer          | for Lapack                                      |
+| work(lwork,n)  | double precision | temporary array for Lapack                      |
+| info           | integer          | if 0 -> ok, else problem in the diagonalization |
+| i,j            | integer          | dummy indexes                                   |
+
+#+BEGIN_SRC f90 :comments org :tangle diagonalization_hessian.irp.f
+subroutine diagonalization_hessian(n,H,e_val,w)
+
+  include 'constants.h'
+
+  implicit none
+
+  ! Variables
+
+  ! in
+  integer, intent(in) :: n
+  double precision, intent(in) :: H(n,n)
+
+  ! out
+  double precision, intent(out) :: e_val(n), w(n,n)
+
+  ! internal
+  double precision, allocatable :: work(:,:)
+  integer, allocatable          :: key(:)
+  integer                       :: info,lwork
+  integer                       :: i,j
+  integer                       :: nb_negative_vp
+  double precision              :: t1,t2,t3,max_elem
+
+  print*,''
+  print*,'---Diagonalization_hessian---'
+
+  call wall_time(t1)
+
+  if (optimization_method == 'full') then
+    ! Allocation
+    ! For Lapack
+    lwork=3*n-1
+
+    allocate(work(lwork,n))
+
+    ! Calculation
+
+    ! Copy the hessian matrix, the eigenvectors will be store in W
+    W=H
+
+    ! Diagonalization of the hessian
+    call dsyev('V','U',n,W,size(W,1),e_val,work,lwork,info)
+
+    if (info /= 0) then
+        print*, 'Error diagonalization : diagonalization_hessian'
+        print*, 'info = ', info
+        call ABORT
+    endif
+
+    if (debug) then
+      print *, 'vp Hess:'
+      write(*,'(100(F10.5))')  real(e_val(:))
+    endif
+
+    ! Number of negative eigenvalues
+    max_elem = 0d0
+    nb_negative_vp = 0
+    do i = 1, n
+      if (e_val(i) < 0d0) then
+        nb_negative_vp = nb_negative_vp + 1
+        if (e_val(i) < max_elem) then
+          max_elem = e_val(i)
+        endif
+        !print*,'e_val < 0 :', e_val(i)
+      endif
+    enddo
+    print*,'Number of negative eigenvalues:', nb_negative_vp
+    print*,'Lowest eigenvalue:',max_elem
+
+    !nb_negative_vp = 0
+    !do i = 1, n
+    !  if (e_val(i) < -thresh_eig) then
+    !    nb_negative_vp = nb_negative_vp + 1
+    !  endif
+    !enddo
+    !print*,'Number of negative eigenvalues <', -thresh_eig,':', nb_negative_vp  
+
+    ! Deallocation
+    deallocate(work)
+
+  elseif (optimization_method == 'diag') then
+    ! Diagonalization of the diagonal hessian by hands
+    allocate(key(n))
+    
+    do i = 1, n
+      e_val(i) = H(i,i)
+    enddo
+
+    ! Key list for dsort
+    do i = 1, n 
+      key(i) = i
+    enddo
+
+    ! Sort of the eigenvalues
+    call dsort(e_val, key, n)
+
+    ! Eigenvectors
+    W = 0d0
+    do i = 1, n
+      j = key(i)
+      W(j,i) = 1d0
+    enddo
+
+    deallocate(key)
+  else
+    print*,'Diagonalization_hessian, abort'
+    call abort
+  endif
+
+  call wall_time(t2)
+  t3 = t2 - t1
+  print*,'Time in diagonalization_hessian:', t3
+
+  print*,'---End diagonalization_hessian---'
+
+end subroutine
+#+END_SRC
+

src/mo_optimization/org/first_diagonal_hessian_list_opt.org

@@ -0,0 +1,376 @@
+* First diagonal hessian
+
+#+BEGIN_SRC f90 :comments :tangle first_diagonal_hessian_list_opt.irp.f
+subroutine first_diag_hessian_list_opt(tmp_n,m,list,H)!, h_tmpr)
+
+  include 'constants.h' 
+
+  implicit none
+
+  !===========================================================================
+  ! Compute the diagonal hessian of energy with respects to orbital rotations
+  !===========================================================================
+
+  !===========
+  ! Variables 
+  !===========
+ 
+  ! in
+  integer, intent(in)           :: tmp_n, m, list(m) 
+  ! tmp_n        : integer, tmp_n = m*(m-1)/2
+ 
+  ! out
+  double precision, intent(out) :: H(tmp_n)!, h_tmpr(m,m,m,m)
+  ! H        : n by n double precision matrix containing the 2D hessian
+  
+  ! internal
+  double precision, allocatable :: hessian(:,:,:,:), tmp(:,:),h_tmpr(:,:,:,:)
+  integer                       :: p,q, tmp_p,tmp_q
+  integer                       :: r,s,t,u,v,tmp_r,tmp_s,tmp_t,tmp_u,tmp_v
+  integer                       :: pq,rs,tmp_pq,tmp_rs
+  double precision              :: t1,t2,t3
+  ! hessian  : mo_num 4D double precision matrix containing the hessian before the permutations
+  ! h_tmpr   : mo_num 4D double precision matrix containing the hessian after the permutations
+  ! p,q,r,s  : integer, indexes of the 4D hessian matrix
+  ! t,u,v    : integer, indexes to compute hessian elements
+  ! pq,rs    : integer, indexes for the conversion from 4D to 2D hessian matrix
+  ! t1,t2,t3 : double precision, t3 = t2 - t1, time to compute the hessian 
+  
+  ! Function
+  double precision :: get_two_e_integral
+  ! get_two_e_integral : double precision function, two e integrals
+ 
+  ! Provided :
+  ! mo_one_e_integrals : mono e- integrals
+  ! get_two_e_integral : two e- integrals
+  ! one_e_dm_mo_alpha, one_e_dm_mo_beta : one body density matrix
+  ! two_e_dm_mo : two body density matrix
+
+  print*,'---first_diag_hess_list---'
+
+  !============
+  ! Allocation
+  !============
+  
+  allocate(hessian(m,m,m,m),tmp(tmp_n,tmp_n),h_tmpr(mo_num,mo_num,mo_num,mo_num))
+
+  !=============
+  ! Calculation
+  !=============
+
+  ! From Anderson et. al. (2014) 
+  ! The Journal of Chemical Physics 141, 244104 (2014); doi: 10.1063/1.4904384
+
+  ! LaTeX formula :
+
+  !\begin{align*}
+  !H_{pq,rs} &= \dfrac{\partial^2 E(x)}{\partial x_{pq}^2} \\
+  !&= \mathcal{P}_{pq} \mathcal{P}_{rs} [ \frac{1}{2} \sum_u [\delta_{qr}(h_p^u \gamma_u^s + h_u^s \gamma_p^u) 
+  !+ \delta_{ps}(h_r^u \gamma_u^q + h_u^q \gamma_u^r)]
+  !-(h_p^s \gamma_r^q + h_r^q \gamma_p^s) \\
+  !&+ \frac{1}{2} \sum_{tuv} [\delta_{qr}(v_{pt}^{uv} \Gamma_{uv}^{st} +v_{uv}^{st} \Gamma_{pt}^{uv}) 
+  !+ \delta_{ps}(v_{uv}^{qt} \Gamma_{rt}^{uv} + v_{rt}^{uv}\Gamma_{uv}^{qt})] \\
+  !&+ \sum_{uv} (v_{pr}^{uv} \Gamma_{uv}^{qs} + v_{uv}^{qs}  \Gamma_{ps}^{uv}) \\
+  !&- \sum_{tu} (v_{pu}^{st} \Gamma_{rt}^{qu}+v_{pu}^{tr} \Gamma_{tr}^{qu}+v_{rt}^{qu}\Gamma_{pu}^{st} + v_{tr}^{qu}\Gamma_{pu}^{ts}) 
+  !\end{align*} 
+
+  !================
+  ! Initialization
+  !================
+  hessian = 0d0
+
+  CALL wall_time(t1)
+
+  !========================
+  ! First line, first term
+  !========================
+  do tmp_p = 1, m
+    p = list(tmp_p)
+    do tmp_q = 1, m
+      q = list(tmp_q)
+      do tmp_r = 1, m
+        r = list(tmp_r)
+        do tmp_s = 1, m
+          s = list(tmp_s)
+
+          ! Permutations 
+          if (((p==r) .and. (q==s)) .or. ((q==r) .and. (p==s)) &
+             .or. ((p==s) .and. (q==r))) then
+           
+            if (q==r) then
+              do u = 1, mo_num
+
+                hessian(tmp_p,tmp_q,tmp_r,tmp_s) = hessian(tmp_p,tmp_q,tmp_r,tmp_s) + 0.5d0 * ( &
+                    mo_one_e_integrals(u,p) * one_e_dm_mo(u,s) &
+                  + mo_one_e_integrals(s,u) * one_e_dm_mo(p,u))
+
+              enddo
+            endif
+          endif
+
+        enddo
+      enddo
+    enddo
+  enddo
+
+  !=========================
+  ! First line, second term
+  !=========================
+  do tmp_p = 1, m
+    p = list(tmp_p)
+    do tmp_q = 1, m
+      q = list(tmp_q)
+      do tmp_r = 1, m
+        r = list(tmp_r)
+        do tmp_s = 1, m
+          s = list(tmp_s)
+
+           ! Permutations 
+           if (((p==r) .and. (q==s)) .or. ((q==r) .and. (p==s)) &
+            .or. ((p==s) .and. (q==r))) then
+
+             if (p==s) then
+               do u = 1, mo_num
+
+                    hessian(tmp_p,tmp_q,tmp_r,tmp_s) = hessian(tmp_p,tmp_q,tmp_r,tmp_s) + 0.5d0 * ( &
+                      mo_one_e_integrals(u,r) * one_e_dm_mo(u,q) &
+                    + mo_one_e_integrals(q,u) * one_e_dm_mo(r,u))
+               enddo
+             endif
+           endif
+
+        enddo
+      enddo
+    enddo
+  enddo
+
+  !========================
+  ! First line, third term
+  !========================
+  do tmp_p = 1, m
+    p = list(tmp_p)
+    do tmp_q = 1, m
+      q = list(tmp_q)
+      do tmp_r = 1, m
+        r = list(tmp_r)
+        do tmp_s = 1, m
+          s = list(tmp_s)
+         
+          ! Permutations 
+          if (((p==r) .and. (q==s)) .or. ((q==r) .and. (p==s)) &
+             .or. ((p==s) .and. (q==r))) then
+
+            hessian(tmp_p,tmp_q,tmp_r,tmp_s) = hessian(tmp_p,tmp_q,tmp_r,tmp_s) &
+            - mo_one_e_integrals(s,p) * one_e_dm_mo(r,q) &
+            - mo_one_e_integrals(q,r) * one_e_dm_mo(p,s)
+
+          endif
+
+        enddo
+      enddo
+    enddo
+  enddo
+
+  !=========================
+  ! Second line, first term
+  !=========================
+  do tmp_p = 1, m
+    p = list(tmp_p)
+    do tmp_q = 1, m
+      q = list(tmp_q)
+      do tmp_r = 1, m
+        r = list(tmp_r)
+        do tmp_s = 1, m
+          s = list(tmp_s)
+
+          ! Permutations 
+          if (((p==r) .and. (q==s)) .or. ((q==r) .and. (p==s)) &
+             .or. ((p==s) .and. (q==r))) then
+
+              if (q==r) then
+                do t = 1, mo_num
+                  do u = 1, mo_num
+                    do v = 1, mo_num
+
+                      hessian(tmp_p,tmp_q,tmp_r,tmp_s) = hessian(tmp_p,tmp_q,tmp_r,tmp_s) + 0.5d0 * (  &
+                        get_two_e_integral(u,v,p,t,mo_integrals_map) * two_e_dm_mo(u,v,s,t) &
+                      + get_two_e_integral(s,t,u,v,mo_integrals_map) * two_e_dm_mo(p,t,u,v))
+
+                    enddo
+                  enddo
+                enddo
+              endif
+            endif
+
+        enddo
+      enddo
+    enddo
+  enddo
+
+  !==========================
+  ! Second line, second term
+  !==========================
+  do tmp_p = 1, m
+    p = list(tmp_p)
+    do tmp_q = 1, m
+      q = list(tmp_q)
+      do tmp_r = 1, m
+        r = list(tmp_r)
+        do tmp_s = 1, m
+          s = list(tmp_s)
+
+           ! Permutations 
+           if (((p==r) .and. (q==s)) .or. ((q==r) .and. (p==s)) &
+              .or. ((p==s) .and. (q==r))) then
+
+             if (p==s) then
+               do t = 1, mo_num
+                 do u = 1, mo_num
+                   do v = 1, mo_num
+
+                     hessian(tmp_p,tmp_q,tmp_r,tmp_s) = hessian(tmp_p,tmp_q,tmp_r,tmp_s) + 0.5d0 * ( &
+                       get_two_e_integral(q,t,u,v,mo_integrals_map) * two_e_dm_mo(r,t,u,v) &
+                     + get_two_e_integral(u,v,r,t,mo_integrals_map) * two_e_dm_mo(u,v,q,t))
+
+                   enddo
+                 enddo
+               enddo
+             endif
+           endif
+
+        enddo
+      enddo
+    enddo
+  enddo
+
+  !========================
+  ! Third line, first term
+  !========================
+  do tmp_p = 1, m
+    p = list(tmp_p)
+    do tmp_q = 1, m
+      q = list(tmp_q)
+      do tmp_r = 1, m
+        r = list(tmp_r)
+        do tmp_s = 1, m
+          s = list(tmp_s)
+
+           ! Permutations 
+           if (((p==r) .and. (q==s)) .or. ((q==r) .and. (p==s)) &
+                .or. ((p==s) .and. (q==r))) then
+
+            do u = 1, mo_num
+              do v = 1, mo_num
+
+                hessian(tmp_p,tmp_q,tmp_r,tmp_s) = hessian(tmp_p,tmp_q,tmp_r,tmp_s) &
+                 + get_two_e_integral(u,v,p,r,mo_integrals_map) * two_e_dm_mo(u,v,q,s) &
+                 + get_two_e_integral(q,s,u,v,mo_integrals_map) * two_e_dm_mo(p,r,u,v)
+
+              enddo
+            enddo
+          endif
+
+        enddo
+      enddo
+    enddo
+  enddo
+
+  !=========================
+  ! Third line, second term
+  !=========================
+  do tmp_p = 1, m
+    p = list(tmp_p)
+    do tmp_q = 1, m
+      q = list(tmp_q)
+      do tmp_r = 1, m
+        r = list(tmp_r)
+        do tmp_s = 1, m
+          s = list(tmp_s)
+
+          ! Permutations 
+          if (((p==r) .and. (q==s)) .or. ((q==r) .and. (p==s)) &
+           .or. ((p==s) .and. (q==r))) then
+
+            do t = 1, mo_num
+              do u = 1, mo_num
+
+                hessian(tmp_p,tmp_q,tmp_r,tmp_s) = hessian(tmp_p,tmp_q,tmp_r,tmp_s) &
+                 - get_two_e_integral(s,t,p,u,mo_integrals_map) * two_e_dm_mo(r,t,q,u) &
+                 - get_two_e_integral(t,s,p,u,mo_integrals_map) * two_e_dm_mo(t,r,q,u) &
+                 - get_two_e_integral(q,u,r,t,mo_integrals_map) * two_e_dm_mo(p,u,s,t) &
+                 - get_two_e_integral(q,u,t,r,mo_integrals_map) * two_e_dm_mo(p,u,t,s)
+
+              enddo
+            enddo
+
+          endif     
+  
+        enddo
+      enddo
+    enddo
+  enddo
+
+    CALL wall_time(t2)
+    t2 = t2 - t1
+    print*, 'Time to compute the hessian :', t2
+
+  !==============
+  ! Permutations
+  !==============
+ 
+  ! Convert the hessian mo_num * mo_num * mo_num * mo_num matrix in a
+  ! 2D n * n matrix (n = mo_num*(mo_num-1)/2)
+  ! H(pq,rs) : p<q and r<s
+
+  do tmp_r = 1, m
+    do tmp_s = 1, m
+      do tmp_q = 1, m
+        do tmp_p = 1, m
+
+          h_tmpr(tmp_p,tmp_q,tmp_r,tmp_s) = hessian(tmp_p,tmp_q,tmp_r,tmp_s) - hessian(tmp_q,tmp_p,tmp_r,tmp_s) &
+                                          - hessian(tmp_p,tmp_q,tmp_s,tmp_r) + hessian(tmp_q,tmp_p,tmp_s,tmp_r)
+
+        enddo
+      enddo
+    enddo
+  enddo
+
+  !========================
+  ! 4D matrix -> 2D matrix
+  !========================
+  
+  ! Convert the hessian mo_num * mo_num * mo_num * mo_num matrix in a
+  ! 2D n * n matrix (n = mo_num*(mo_num-1)/2)
+  ! H(pq,rs) : p<q and r<s
+
+  ! 4D mo_num matrix to 2D n matrix
+  do tmp_rs = 1, tmp_n
+    call vec_to_mat_index(tmp_rs,tmp_r,tmp_s)
+    do tmp_pq = 1, tmp_n
+      call vec_to_mat_index(tmp_pq,tmp_p,tmp_q)
+      tmp(tmp_pq,tmp_rs) = h_tmpr(tmp_p,tmp_q,tmp_r,tmp_s)   
+    enddo
+  enddo
+
+  do p = 1, tmp_n
+    H(p) = tmp(p,p)
+  enddo
+
+  ! Display
+  if (debug) then 
+    print*,'2D diag Hessian matrix'
+    do tmp_pq = 1, tmp_n
+      write(*,'(100(F10.5))') tmp(tmp_pq,:)
+    enddo 
+  endif
+
+  !==============
+  ! Deallocation
+  !==============
+
+  deallocate(hessian,h_tmpr,tmp)
+
+  print*,'---End first_diag_hess_list---'
+
+end subroutine
+#+END_SRC

src/mo_optimization/org/first_diagonal_hessian_opt.org

@@ -0,0 +1,348 @@
+* First diagonal hessian
+
+#+BEGIN_SRC f90 :comments :tangle first_diagonal_hessian_opt.irp.f
+subroutine first_diag_hessian_opt(n,H, h_tmpr)
+
+  include 'constants.h' 
+
+  implicit none
+
+  !===========================================================================
+  ! Compute the diagonal hessian of energy with respects to orbital rotations
+  !===========================================================================
+
+  !===========
+  ! Variables 
+  !===========
+ 
+  ! in
+  integer, intent(in)           :: n 
+  ! n        : integer, n = mo_num*(mo_num-1)/2
+ 
+  ! out
+  double precision, intent(out) :: H(n,n), h_tmpr(mo_num,mo_num,mo_num,mo_num)
+  ! H        : n by n double precision matrix containing the 2D hessian
+  
+  ! internal
+  double precision, allocatable :: hessian(:,:,:,:)
+  integer                       :: p,q
+  integer                       :: r,s,t,u,v
+  integer                       :: pq,rs
+  double precision              :: t1,t2,t3
+  ! hessian  : mo_num 4D double precision matrix containing the hessian before the permutations
+  ! h_tmpr   : mo_num 4D double precision matrix containing the hessian after the permutations
+  ! p,q,r,s  : integer, indexes of the 4D hessian matrix
+  ! t,u,v    : integer, indexes to compute hessian elements
+  ! pq,rs    : integer, indexes for the conversion from 4D to 2D hessian matrix
+  ! t1,t2,t3 : double precision, t3 = t2 - t1, time to compute the hessian 
+  
+  ! Function
+  double precision :: get_two_e_integral
+  ! get_two_e_integral : double precision function, two e integrals
+ 
+  ! Provided :
+  ! mo_one_e_integrals : mono e- integrals
+  ! get_two_e_integral : two e- integrals
+  ! one_e_dm_mo_alpha, one_e_dm_mo_beta : one body density matrix
+  ! two_e_dm_mo : two body density matrix
+
+  !============
+  ! Allocation
+  !============
+
+  allocate(hessian(mo_num,mo_num,mo_num,mo_num))!,h_tmpr(mo_num,mo_num,mo_num,mo_num))
+
+  !=============
+  ! Calculation
+  !=============
+
+  if (debug) then
+          print*,'Enter in first_diag_hessien'
+  endif
+
+  ! From Anderson et. al. (2014) 
+  ! The Journal of Chemical Physics 141, 244104 (2014); doi: 10.1063/1.4904384
+
+  ! LaTeX formula :
+
+  !\begin{align*}
+  !H_{pq,rs} &= \dfrac{\partial^2 E(x)}{\partial x_{pq}^2} \\
+  !&= \mathcal{P}_{pq} \mathcal{P}_{rs} [ \frac{1}{2} \sum_u [\delta_{qr}(h_p^u \gamma_u^s + h_u^s \gamma_p^u) 
+  !+ \delta_{ps}(h_r^u \gamma_u^q + h_u^q \gamma_u^r)]
+  !-(h_p^s \gamma_r^q + h_r^q \gamma_p^s) \\
+  !&+ \frac{1}{2} \sum_{tuv} [\delta_{qr}(v_{pt}^{uv} \Gamma_{uv}^{st} +v_{uv}^{st} \Gamma_{pt}^{uv}) 
+  !+ \delta_{ps}(v_{uv}^{qt} \Gamma_{rt}^{uv} + v_{rt}^{uv}\Gamma_{uv}^{qt})] \\
+  !&+ \sum_{uv} (v_{pr}^{uv} \Gamma_{uv}^{qs} + v_{uv}^{qs}  \Gamma_{ps}^{uv}) \\
+  !&- \sum_{tu} (v_{pu}^{st} \Gamma_{rt}^{qu}+v_{pu}^{tr} \Gamma_{tr}^{qu}+v_{rt}^{qu}\Gamma_{pu}^{st} + v_{tr}^{qu}\Gamma_{pu}^{ts}) 
+  !\end{align*} 
+
+  !================
+  ! Initialization
+  !================
+  hessian = 0d0
+
+  CALL wall_time(t1)
+
+  !========================
+  ! First line, first term
+  !========================
+  do p = 1, mo_num
+    do q = 1, mo_num
+      do r = 1, mo_num
+        do s = 1, mo_num
+
+          ! Permutations 
+          if (((p==r) .and. (q==s)) .or. ((q==r) .and. (p==s)) &
+             .or. ((p==s) .and. (q==r))) then
+           
+            if (q==r) then
+              do u = 1, mo_num
+
+                hessian(p,q,r,s) = hessian(p,q,r,s) + 0.5d0 * ( &
+                    mo_one_e_integrals(u,p) * one_e_dm_mo(u,s) &
+                  + mo_one_e_integrals(s,u) * one_e_dm_mo(p,u))
+
+              enddo
+            endif
+          endif
+
+        enddo
+      enddo
+    enddo
+  enddo
+
+  !=========================
+  ! First line, second term
+  !=========================
+  do p = 1, mo_num
+    do q = 1, mo_num
+      do r = 1, mo_num
+        do s = 1, mo_num
+
+           ! Permutations 
+           if (((p==r) .and. (q==s)) .or. ((q==r) .and. (p==s)) &
+            .or. ((p==s) .and. (q==r))) then
+
+             if (p==s) then
+               do u = 1, mo_num
+
+                    hessian(p,q,r,s) = hessian(p,q,r,s) + 0.5d0 * ( &
+                      mo_one_e_integrals(u,r) * one_e_dm_mo(u,q) &
+                    + mo_one_e_integrals(q,u) * one_e_dm_mo(r,u))
+               enddo
+             endif
+           endif
+
+        enddo
+      enddo
+    enddo
+  enddo
+
+  !========================
+  ! First line, third term
+  !========================
+  do p = 1, mo_num
+    do q = 1, mo_num
+      do r = 1, mo_num
+        do s = 1, mo_num
+         
+          ! Permutations 
+          if (((p==r) .and. (q==s)) .or. ((q==r) .and. (p==s)) &
+             .or. ((p==s) .and. (q==r))) then
+
+            hessian(p,q,r,s) = hessian(p,q,r,s) &
+            - mo_one_e_integrals(s,p) * one_e_dm_mo(r,q) &
+            - mo_one_e_integrals(q,r) * one_e_dm_mo(p,s)
+
+          endif
+
+        enddo
+      enddo
+    enddo
+  enddo
+
+  !=========================
+  ! Second line, first term
+  !=========================
+  do p = 1, mo_num
+    do q = 1, mo_num
+      do r = 1, mo_num
+        do s = 1, mo_num
+
+          ! Permutations 
+          if (((p==r) .and. (q==s)) .or. ((q==r) .and. (p==s)) &
+             .or. ((p==s) .and. (q==r))) then
+
+              if (q==r) then
+                do t = 1, mo_num
+                  do u = 1, mo_num
+                    do v = 1, mo_num
+
+                      hessian(p,q,r,s) = hessian(p,q,r,s) + 0.5d0 * (  &
+                        get_two_e_integral(u,v,p,t,mo_integrals_map) * two_e_dm_mo(u,v,s,t) &
+                      + get_two_e_integral(s,t,u,v,mo_integrals_map) * two_e_dm_mo(p,t,u,v))
+
+                    enddo
+                  enddo
+                enddo
+              endif
+            endif
+
+        enddo
+      enddo
+    enddo
+  enddo
+
+  !==========================
+  ! Second line, second term
+  !==========================
+  do p = 1, mo_num
+    do q = 1, mo_num
+      do r = 1, mo_num
+        do s = 1, mo_num
+
+           ! Permutations 
+           if (((p==r) .and. (q==s)) .or. ((q==r) .and. (p==s)) &
+              .or. ((p==s) .and. (q==r))) then
+
+             if (p==s) then
+               do t = 1, mo_num
+                 do u = 1, mo_num
+                   do v = 1, mo_num
+
+                     hessian(p,q,r,s) = hessian(p,q,r,s) + 0.5d0 * ( &
+                       get_two_e_integral(q,t,u,v,mo_integrals_map) * two_e_dm_mo(r,t,u,v) &
+                     + get_two_e_integral(u,v,r,t,mo_integrals_map) * two_e_dm_mo(u,v,q,t))
+
+                   enddo
+                 enddo
+               enddo
+             endif
+           endif
+
+        enddo
+      enddo
+    enddo
+  enddo
+
+  !========================
+  ! Third line, first term
+  !========================
+  do p = 1, mo_num
+    do q = 1, mo_num
+      do r = 1, mo_num
+        do s = 1, mo_num
+
+
+           ! Permutations 
+           if (((p==r) .and. (q==s)) .or. ((q==r) .and. (p==s)) &
+                .or. ((p==s) .and. (q==r))) then
+
+            do u = 1, mo_num
+              do v = 1, mo_num
+
+                hessian(p,q,r,s) = hessian(p,q,r,s) &
+                 + get_two_e_integral(u,v,p,r,mo_integrals_map) * two_e_dm_mo(u,v,q,s) &
+                 + get_two_e_integral(q,s,u,v,mo_integrals_map) * two_e_dm_mo(p,r,u,v)
+
+              enddo
+            enddo
+          endif
+
+        enddo
+      enddo
+    enddo
+  enddo
+
+  !=========================
+  ! Third line, second term
+  !=========================
+  do p = 1, mo_num
+    do q = 1, mo_num
+      do r = 1, mo_num
+        do s = 1, mo_num
+
+          ! Permutations 
+          if (((p==r) .and. (q==s)) .or. ((q==r) .and. (p==s)) &
+           .or. ((p==s) .and. (q==r))) then
+
+            do t = 1, mo_num
+              do u = 1, mo_num
+
+                hessian(p,q,r,s) = hessian(p,q,r,s) &
+                 - get_two_e_integral(s,t,p,u,mo_integrals_map) * two_e_dm_mo(r,t,q,u) &
+                 - get_two_e_integral(t,s,p,u,mo_integrals_map) * two_e_dm_mo(t,r,q,u) &
+                 - get_two_e_integral(q,u,r,t,mo_integrals_map) * two_e_dm_mo(p,u,s,t) &
+                 - get_two_e_integral(q,u,t,r,mo_integrals_map) * two_e_dm_mo(p,u,t,s)
+
+              enddo
+            enddo
+
+          endif     
+  
+        enddo
+      enddo
+    enddo
+  enddo
+
+    CALL wall_time(t2)
+    t2 = t2 - t1
+    print*, 'Time to compute the hessian :', t2
+
+  !==============
+  ! Permutations
+  !==============
+ 
+  ! Convert the hessian mo_num * mo_num * mo_num * mo_num matrix in a
+  ! 2D n * n matrix (n = mo_num*(mo_num-1)/2)
+  ! H(pq,rs) : p<q and r<s
+
+  do r = 1, mo_num
+    do s = 1, mo_num
+      do q = 1, mo_num
+        do p = 1, mo_num
+
+          h_tmpr(p,q,r,s) = (hessian(p,q,r,s) - hessian(q,p,r,s) - hessian(p,q,s,r) + hessian(q,p,s,r))
+
+        enddo
+      enddo
+    enddo
+  enddo
+
+  !========================
+  ! 4D matrix -> 2D matrix
+  !========================
+  
+  ! Convert the hessian mo_num * mo_num * mo_num * mo_num matrix in a
+  ! 2D n * n matrix (n = mo_num*(mo_num-1)/2)
+  ! H(pq,rs) : p<q and r<s
+
+  ! 4D mo_num matrix to 2D n matrix
+  do rs = 1, n
+    call vec_to_mat_index(rs,r,s)
+    do pq = 1, n
+      call vec_to_mat_index(pq,p,q)
+      H(pq,rs) = h_tmpr(p,q,r,s)   
+    enddo
+  enddo
+
+  ! Display
+  if (debug) then 
+    print*,'2D diag Hessian matrix'
+    do pq = 1, n
+      write(*,'(100(F10.5))') H(pq,:)
+    enddo 
+  endif
+
+  !==============
+  ! Deallocation
+  !==============
+
+  deallocate(hessian)
+
+  if (debug) then
+    print*,'Leave first_diag_hessien'
+  endif
+
+end subroutine
+#+END_SRC

src/mo_optimization/org/first_gradient_list_opt.org

@@ -0,0 +1,127 @@
+* First gradient
+#+BEGIN_SRC f90 :comments org :tangle first_gradient_list_opt.irp.f
+subroutine first_gradient_list_opt(tmp_n,m,list,v_grad)
+
+  include 'constants.h'
+
+  implicit none
+
+  !===================================================================
+  ! Compute the gradient of energy with respects to orbital rotations
+  !===================================================================
+
+  ! Check if read_wf = true, else :
+  ! qp set determinant read_wf true
+
+  ! in
+  integer, intent(in) :: tmp_n,m,list(m)
+  ! n : integer, n = m*(m-1)/2
+  ! m = list_size
+  
+  ! out
+  double precision, intent(out) :: v_grad(tmp_n)
+  ! v_grad : double precision vector of length n containeing the gradient
+
+  ! internal
+  double precision, allocatable :: grad(:,:),A(:,:)
+  double precision :: norm
+  integer :: i,p,q,r,s,t,tmp_i,tmp_p,tmp_q,tmp_r,tmp_s,tmp_t
+  ! grad : double precision matrix containing the gradient before the permutation
+  ! A : double precision matrix containing the gradient after the permutation
+  ! norm : double precision number, the norm of the vector gradient
+  ! i,p,q,r,s,t : integer, indexes 
+  ! istate : integer, the electronic state
+
+  ! Function
+  double precision :: get_two_e_integral, norm2
+  ! get_two_e_integral :  double precision function that gives the two e integrals
+  ! norm2 : double precision function that gives the norm of a vector
+ 
+  ! Provided :
+  ! mo_one_e_integrals : mono e- integrals
+  ! get_two_e_integral : two e- integrals
+  ! one_e_dm_mo : one body density matrix (state average)
+  ! two_e_dm_mo : two body density matrix (state average)
+
+   print*,'---first_gradient_list---'
+
+  !============
+  ! Allocation
+  !============
+
+  allocate(grad(m,m),A(m,m))
+
+  !=============
+  ! Calculation
+  !=============
+
+  v_grad = 0d0
+  grad = 0d0
+
+  do tmp_p = 1, m
+    p = list(tmp_p)
+    do tmp_q = 1, m
+      q = list(tmp_q)
+      !grad(tmp_p,tmp_q) = 0d0
+      do r = 1, mo_num
+        grad(tmp_p,tmp_q) = grad(tmp_p,tmp_q) + mo_one_e_integrals(p,r) * one_e_dm_mo(r,q) &
+                               - mo_one_e_integrals(r,q) * one_e_dm_mo(p,r)
+
+      enddo
+
+      do r = 1, mo_num
+        do s = 1, mo_num
+          do t = 1, mo_num
+
+            grad(tmp_p,tmp_q) = grad(tmp_p,tmp_q) &
+                + get_two_e_integral(p,t,r,s,mo_integrals_map) * two_e_dm_mo(r,s,q,t) &
+                - get_two_e_integral(r,s,q,t,mo_integrals_map) * two_e_dm_mo(p,t,r,s)
+          enddo
+        enddo
+      enddo
+    enddo
+  enddo
+
+  ! Conversion mo_num*mo_num matrix to mo_num(mo_num-1)/2 vector
+  do tmp_i = 1, tmp_n
+    call vec_to_mat_index(tmp_i,tmp_p,tmp_q)
+    v_grad(tmp_i)=(grad(tmp_p,tmp_q) - grad(tmp_q,tmp_p))
+  enddo  
+
+  ! Display, vector containing the gradient elements 
+  if (debug) then  
+    print*,'Vector containing the gradient :'
+    write(*,'(100(F10.5))') v_grad(1:tmp_n)
+  endif  
+
+  ! Norm of the vector
+  norm = norm2(v_grad)
+  print*, 'Norm : ', norm
+
+  ! Matrix gradient
+  A = 0d0
+  do tmp_q = 1, m
+    do tmp_p = 1, m
+      A(tmp_p,tmp_q) = grad(tmp_p,tmp_q) - grad(tmp_q,tmp_p)
+    enddo
+  enddo
+
+  ! Display, matrix containting the gradient elements
+  if (debug) then
+    print*,'Matrix containing the gradient :'
+    do tmp_i = 1, m
+      write(*,'(100(E12.5))') A(tmp_i,1:m)
+    enddo
+  endif
+
+  !==============
+  ! Deallocation
+  !==============
+
+  deallocate(grad,A)
+
+  print*,'---End first_gradient_list---'
+
+end subroutine
+
+#+END_SRC

src/mo_optimization/org/first_gradient_opt.org

@@ -0,0 +1,130 @@
+* First gradient
+#+BEGIN_SRC f90 :comments org :tangle first_gradient_opt.irp.f
+subroutine first_gradient_opt(n,v_grad)
+
+  include 'constants.h'
+
+  implicit none
+
+  !===================================================================
+  ! Compute the gradient of energy with respects to orbital rotations
+  !===================================================================
+
+  ! Check if read_wf = true, else :
+  ! qp set determinant read_wf true
+
+  END_DOC
+
+  ! in
+  integer, intent(in) :: n
+  ! n : integer, n = mo_num*(mo_num-1)/2
+  
+  ! out
+  double precision, intent(out) :: v_grad(n)
+  ! v_grad : double precision vector of length n containeing the gradient
+
+  ! internal
+  double precision, allocatable :: grad(:,:),A(:,:)
+  double precision :: norm
+  integer :: i,p,q,r,s,t
+  integer :: istate
+  ! grad : double precision matrix containing the gradient before the permutation
+  ! A : double precision matrix containing the gradient after the permutation
+  ! norm : double precision number, the norm of the vector gradient
+  ! i,p,q,r,s,t : integer, indexes 
+  ! istate : integer, the electronic state
+
+  ! Function
+  double precision :: get_two_e_integral, norm2
+  ! get_two_e_integral :  double precision function that gives the two e integrals
+  ! norm2 : double precision function that gives the norm of a vector
+ 
+  ! Provided :
+  ! mo_one_e_integrals : mono e- integrals
+  ! get_two_e_integral : two e- integrals
+  ! one_e_dm_mo : one body density matrix (state average)
+  ! two_e_dm_mo : two body density matrix (state average)
+
+  !============
+  ! Allocation
+  !============
+
+  allocate(grad(mo_num,mo_num),A(mo_num,mo_num))
+
+  !=============
+  ! Calculation
+  !=============
+
+  if (debug) then
+    print*,'---first_gradient---'
+  endif
+
+  v_grad = 0d0
+
+  do p = 1, mo_num
+    do q = 1, mo_num
+      grad(p,q) = 0d0
+      do r = 1, mo_num
+        grad(p,q) = grad(p,q) + mo_one_e_integrals(p,r) * one_e_dm_mo(r,q) &
+                               - mo_one_e_integrals(r,q) * one_e_dm_mo(p,r)
+
+      enddo
+
+      do r = 1, mo_num
+        do s = 1, mo_num
+          do t= 1, mo_num
+
+            grad(p,q) = grad(p,q) &
+                + get_two_e_integral(p,t,r,s,mo_integrals_map) * two_e_dm_mo(r,s,q,t) &
+                - get_two_e_integral(r,s,q,t,mo_integrals_map) * two_e_dm_mo(p,t,r,s)
+          enddo
+        enddo
+      enddo
+    enddo
+  enddo
+
+  ! Conversion mo_num*mo_num matrix to mo_num(mo_num-1)/2 vector
+  do i=1,n
+    call vec_to_mat_index(i,p,q)
+    v_grad(i)=(grad(p,q) - grad(q,p))
+  enddo  
+
+  ! Display, vector containing the gradient elements 
+  if (debug) then  
+    print*,'Vector containing the gradient :'
+    write(*,'(100(F10.5))') v_grad(1:n)
+  endif  
+
+  ! Norm of the vector
+  norm = norm2(v_grad)
+  print*, 'Norm : ', norm
+
+  ! Matrix gradient
+  A = 0d0
+  do q=1,mo_num
+    do p=1,mo_num
+      A(p,q) = grad(p,q) - grad(q,p)
+    enddo
+  enddo
+
+  ! Display, matrix containting the gradient elements
+  if (debug) then    
+    print*,'Matrix containing the gradient :'
+    do i = 1, mo_num
+      write(*,'(100(E12.5))') A(i,1:mo_num)
+    enddo
+  endif
+
+  !==============
+  ! Deallocation
+  !==============
+
+  deallocate(grad,A)
+
+  if (debug) then
+    print*,'---End first_gradient---'
+  endif
+
+end subroutine
+
+#+END_SRC

src/mo_optimization/org/first_hessian_list_opt.org

@@ -0,0 +1,370 @@
+* First hessian
+
+#+BEGIN_SRC f90 :comments :tangle first_hessian_list_opt.irp.f
+subroutine first_hessian_list_opt(tmp_n,m,list,H,h_tmpr)
+
+  include 'constants.h' 
+
+  implicit none
+
+  !==================================================================
+  ! Compute the hessian of energy with respects to orbital rotations
+  !==================================================================
+
+  !===========
+  ! Variables  
+  !===========
+
+  ! in
+  integer, intent(in)           :: tmp_n, m, list(m)
+  !tmp_n         : integer, tmp_n = m*(m-1)/2
+  
+  ! out
+  double precision, intent(out) :: H(tmp_n,tmp_n),h_tmpr(m,m,m,m)
+  ! H        : n by n double precision matrix containing the 2D hessian
+ 
+  ! internal
+  double precision, allocatable :: hessian(:,:,:,:)
+  integer                       :: p,q, tmp_p,tmp_q
+  integer                       :: r,s,t,u,v,tmp_r,tmp_s,tmp_t,tmp_u,tmp_v
+  integer                       :: pq,rs,tmp_pq,tmp_rs
+  double precision              :: t1,t2,t3,t4,t5,t6
+  ! hessian  : mo_num 4D double precision matrix containing the hessian before the permutations
+  ! h_tmpr   : mo_num 4D double precision matrix containing the hessian after the permutations
+  ! p,q,r,s  : integer, indexes of the 4D hessian matrix
+  ! t,u,v    : integer, indexes to compute hessian elements
+  ! pq,rs    : integer, indexes for the conversion from 4D to 2D hessian matrix
+  ! t1,t2,t3 : double precision, t3 = t2 - t1, time to compute the hessian 
+
+  ! Funtion 
+  double precision              :: get_two_e_integral
+  ! get_two_e_integral :  double precision function, two e integrals 
+
+  ! Provided :
+  ! mo_one_e_integrals : mono e- integrals
+  ! get_two_e_integral : two e- integrals
+  ! one_e_dm_mo_alpha, one_e_dm_mo_beta : one body density matrix
+  ! two_e_dm_mo : two body density matrix
+
+  !============
+  ! Allocation
+  !============
+
+  allocate(hessian(m,m,m,m))
+
+  !=============
+  ! Calculation
+  !=============
+
+  print*,'---first_hess_list---'
+
+  ! From Anderson et. al. (2014) 
+  ! The Journal of Chemical Physics 141, 244104 (2014); doi: 10.1063/1.4904384
+
+  CALL wall_time(t1)
+
+  ! Initialization
+  hessian = 0d0
+
+  !========================
+  ! First line, first term
+  !========================
+
+  CALL wall_time(t4)
+
+  do tmp_p = 1, m
+    p = list(tmp_p)
+    do tmp_q = 1, m
+      q = list(tmp_q)
+      do tmp_r = 1, m
+        r = list(tmp_r)
+        do tmp_s = 1, m
+          s = list(tmp_s)
+
+            if (q==r) then
+              do u = 1, mo_num
+
+                hessian(tmp_p,tmp_q,tmp_r,tmp_s) = hessian(tmp_p,tmp_q,tmp_r,tmp_s) + 0.5d0 * (  &
+                  mo_one_e_integrals(u,p) * one_e_dm_mo(u,s) &
+                + mo_one_e_integrals(s,u) * one_e_dm_mo(p,u))
+
+              enddo
+            endif
+
+        enddo
+      enddo
+    enddo
+  enddo
+
+  CALL wall_time(t5)
+  t6 = t5-t4
+  print*,'l1 1 :', t6
+
+  !=========================
+  ! First line, second term
+  !=========================
+
+  CALL wall_time(t4)
+
+  do tmp_p = 1, m
+    p = list(tmp_p)
+    do tmp_q = 1, m
+      q = list(tmp_q)
+      do tmp_r = 1, m
+        r = list(tmp_r)
+        do tmp_s = 1, m
+          s = list(tmp_s)
+
+          if (p==s) then
+            do u = 1, mo_num
+
+                  hessian(tmp_p,tmp_q,tmp_r,tmp_s) = hessian(tmp_p,tmp_q,tmp_r,tmp_s) + 0.5d0 * ( &
+                    mo_one_e_integrals(u,r) * one_e_dm_mo(u,q) &
+                  + mo_one_e_integrals(q,u) * one_e_dm_mo(r,u))
+            enddo
+          endif
+
+        enddo
+      enddo
+    enddo
+  enddo
+  
+  CALL wall_time(t5)
+  t6 = t5-t4
+  print*,'l1 2 :', t6
+
+  !========================
+  ! First line, third term
+  !========================
+
+  CALL wall_time(t4)
+
+  do tmp_p = 1, m
+    p = list(tmp_p)
+    do tmp_q = 1, m
+      q = list(tmp_q)
+      do tmp_r = 1, m
+        r = list(tmp_r)
+        do tmp_s = 1, m
+          s = list(tmp_s)
+
+          hessian(tmp_p,tmp_q,tmp_r,tmp_s) = hessian(tmp_p,tmp_q,tmp_r,tmp_s) &
+          - mo_one_e_integrals(s,p) * one_e_dm_mo(r,q)&
+          - mo_one_e_integrals(q,r) * one_e_dm_mo(p,s)
+
+        enddo
+      enddo
+    enddo
+  enddo
+
+  CALL wall_time(t5)
+  t6 = t5-t4
+  print*,'l1 3 :', t6
+
+
+  !=========================
+  ! Second line, first term
+  !=========================
+
+  CALL wall_time(t4)
+
+  do tmp_p = 1, m
+    p = list(tmp_p)
+    do tmp_q = 1, m
+      q = list(tmp_q)
+      do tmp_r = 1, m
+        r = list(tmp_r)
+        do tmp_s = 1, m
+          s = list(tmp_s)
+
+           if (q==r) then
+             do t = 1, mo_num
+               do u = 1, mo_num
+                 do v = 1, mo_num
+
+                   hessian(tmp_p,tmp_q,tmp_r,tmp_s) = hessian(tmp_p,tmp_q,tmp_r,tmp_s) + 0.5d0 * (  &
+                     get_two_e_integral(u,v,p,t,mo_integrals_map) * two_e_dm_mo(u,v,s,t) &
+                   + get_two_e_integral(s,t,u,v,mo_integrals_map) * two_e_dm_mo(p,t,u,v))
+
+                 enddo
+               enddo
+             enddo
+           endif
+
+        enddo
+      enddo
+    enddo
+  enddo
+
+  CALL wall_time(t5)
+  t6 = t5-t4
+  print*,'l2 1 :', t6
+
+  !==========================
+  ! Second line, second term
+  !==========================
+
+  CALL wall_time(t4)
+
+  do tmp_p = 1, m
+    p = list(tmp_p)
+    do tmp_q = 1, m
+      q = list(tmp_q)
+      do tmp_r = 1, m
+        r = list(tmp_r)
+        do tmp_s = 1, m
+          s = list(tmp_s)
+
+          if (p==s) then
+            do t = 1, mo_num
+              do u = 1, mo_num
+                do v = 1, mo_num
+
+                  hessian(tmp_p,tmp_q,tmp_r,tmp_s) = hessian(tmp_p,tmp_q,tmp_r,tmp_s) + 0.5d0 * ( &
+                    get_two_e_integral(q,t,u,v,mo_integrals_map) * two_e_dm_mo(r,t,u,v) &
+                  + get_two_e_integral(u,v,r,t,mo_integrals_map) * two_e_dm_mo(u,v,q,t))
+
+                enddo
+              enddo
+            enddo
+          endif
+
+        enddo
+      enddo
+    enddo
+  enddo
+
+  CALL wall_time(t5)
+  t6 = t5-t4
+  print*,'l2 2 :', t6
+
+  !========================
+  ! Third line, first term
+  !========================
+
+  CALL wall_time(t4)
+
+  do tmp_p = 1, m
+    p = list(tmp_p)
+    do tmp_q = 1, m
+      q = list(tmp_q)
+      do tmp_r = 1, m
+        r = list(tmp_r)
+        do tmp_s = 1, m
+          s = list(tmp_s)
+
+          do u = 1, mo_num
+            do v = 1, mo_num
+
+              hessian(tmp_p,tmp_q,tmp_r,tmp_s) = hessian(tmp_p,tmp_q,tmp_r,tmp_s) &
+               + get_two_e_integral(u,v,p,r,mo_integrals_map) * two_e_dm_mo(u,v,q,s) &
+               + get_two_e_integral(q,s,u,v,mo_integrals_map) * two_e_dm_mo(p,r,u,v)
+
+            enddo
+          enddo
+
+        enddo
+      enddo
+    enddo
+  enddo
+ 
+  CALL wall_time(t5)
+  t6 = t5-t4
+  print*,'l3 1 :', t6
+
+  !=========================
+  ! Third line, second term
+  !=========================
+
+  CALL wall_time(t4)
+
+  do tmp_p = 1, m
+    p = list(tmp_p)
+    do tmp_q = 1, m
+      q = list(tmp_q)
+      do tmp_r = 1, m
+        r = list(tmp_r)
+        do tmp_s = 1, m
+          s = list(tmp_s)
+
+          do t = 1, mo_num
+            do u = 1, mo_num
+
+              hessian(tmp_p,tmp_q,tmp_r,tmp_s) = hessian(tmp_p,tmp_q,tmp_r,tmp_s) &
+               - get_two_e_integral(s,t,p,u,mo_integrals_map) * two_e_dm_mo(r,t,q,u) &
+               - get_two_e_integral(t,s,p,u,mo_integrals_map) * two_e_dm_mo(t,r,q,u) &
+               - get_two_e_integral(q,u,r,t,mo_integrals_map) * two_e_dm_mo(p,u,s,t) &
+               - get_two_e_integral(q,u,t,r,mo_integrals_map) * two_e_dm_mo(p,u,t,s)
+
+            enddo
+          enddo
+
+        enddo
+      enddo
+    enddo
+  enddo
+
+  CALL wall_time(t5)
+  t6 = t5-t4
+  print*,'l3 2 :', t6
+
+  CALL wall_time(t2)
+  t3 = t2 -t1
+  print*,'Time to compute the hessian : ', t3
+
+  !==============
+  ! Permutations 
+  !==============
+
+  ! Hessian(p,q,r,s) = P_pq P_rs [ ...]
+  ! => Hessian(p,q,r,s) = (p,q,r,s) - (q,p,r,s) - (p,q,s,r) + (q,p,s,r) 
+
+  do tmp_s = 1, m
+    do tmp_r = 1, m
+      do tmp_q = 1, m
+        do tmp_p = 1, m
+
+          h_tmpr(tmp_p,tmp_q,tmp_r,tmp_s) = (hessian(tmp_p,tmp_q,tmp_r,tmp_s) - hessian(tmp_q,tmp_p,tmp_r,tmp_s) &
+                                           - hessian(tmp_p,tmp_q,tmp_s,tmp_r) + hessian(tmp_q,tmp_p,tmp_s,tmp_r))
+
+        enddo
+      enddo
+    enddo
+  enddo
+
+  !========================
+  ! 4D matrix to 2D matrix
+  !========================
+
+  ! Convert the hessian mo_num * mo_num * mo_num * mo_num matrix in a
+  ! 2D n * n matrix (n = mo_num*(mo_num-1)/2)
+  ! H(pq,rs) : p<q and r<s
+
+  ! 4D mo_num matrix to 2D n matrix
+  do tmp_pq = 1, tmp_n
+    call vec_to_mat_index(tmp_pq,tmp_p,tmp_q)
+    do tmp_rs = 1, tmp_n
+      call vec_to_mat_index(tmp_rs,tmp_r,tmp_s)
+      H(tmp_pq,tmp_rs) = h_tmpr(tmp_p,tmp_q,tmp_r,tmp_s)   
+    enddo
+  enddo
+
+  ! Display
+  if (debug) then 
+    print*,'2D Hessian matrix'
+    do tmp_pq = 1, tmp_n
+      write(*,'(100(F10.5))') H(tmp_pq,:)
+    enddo 
+  endif
+
+  !==============
+  ! Deallocation
+  !==============
+
+  deallocate(hessian)
+
+  print*,'---End first_hess_list---'
+
+end subroutine
+
+#+END_SRC

src/mo_optimization/org/first_hessian_opt.org

@@ -0,0 +1,365 @@
+* First hessian
+
+#+BEGIN_SRC f90 :comments :tangle first_hessian_opt.irp.f
+subroutine first_hessian_opt(n,H,h_tmpr)
+
+  include 'constants.h' 
+
+  implicit none
+
+  !==================================================================
+  ! Compute the hessian of energy with respects to orbital rotations
+  !==================================================================
+
+  !===========
+  ! Variables  
+  !===========
+
+  ! in
+  integer, intent(in)           :: n 
+  !n         : integer, n = mo_num*(mo_num-1)/2
+  
+  ! out
+  double precision, intent(out) :: H(n,n),h_tmpr(mo_num,mo_num,mo_num,mo_num)
+  ! H        : n by n double precision matrix containing the 2D hessian
+ 
+  ! internal
+  double precision, allocatable :: hessian(:,:,:,:)
+  integer                       :: p,q
+  integer                       :: r,s,t,u,v
+  integer                       :: pq,rs
+  double precision              :: t1,t2,t3,t4,t5,t6
+  ! hessian  : mo_num 4D double precision matrix containing the hessian before the permutations
+  ! h_tmpr   : mo_num 4D double precision matrix containing the hessian after the permutations
+  ! p,q,r,s  : integer, indexes of the 4D hessian matrix
+  ! t,u,v    : integer, indexes to compute hessian elements
+  ! pq,rs    : integer, indexes for the conversion from 4D to 2D hessian matrix
+  ! t1,t2,t3 : double precision, t3 = t2 - t1, time to compute the hessian 
+
+  ! Funtion 
+  double precision              :: get_two_e_integral
+  ! get_two_e_integral :  double precision function, two e integrals 
+
+  ! Provided :
+  ! mo_one_e_integrals : mono e- integrals
+  ! get_two_e_integral : two e- integrals
+  ! one_e_dm_mo_alpha, one_e_dm_mo_beta : one body density matrix
+  ! two_e_dm_mo : two body density matrix
+
+  !============
+  ! Allocation
+  !============
+
+  allocate(hessian(mo_num,mo_num,mo_num,mo_num))
+
+  !=============
+  ! Calculation
+  !=============
+
+  if (debug) then
+    print*,'Enter in first_hess'
+  endif
+
+  ! From Anderson et. al. (2014) 
+  ! The Journal of Chemical Physics 141, 244104 (2014); doi: 10.1063/1.4904384
+
+  CALL wall_time(t1)
+
+  ! Initialization
+  hessian = 0d0
+
+  !========================
+  ! First line, first term
+  !========================
+
+  CALL wall_time(t4)
+
+  do p = 1, mo_num
+    do q = 1, mo_num
+      do r = 1, mo_num
+        do s = 1, mo_num
+
+            if (q==r) then
+              do u = 1, mo_num
+
+                hessian(p,q,r,s) = hessian(p,q,r,s) + 0.5d0 * (  &
+                  mo_one_e_integrals(u,p) * one_e_dm_mo(u,s) &
+                + mo_one_e_integrals(s,u) * one_e_dm_mo(p,u))
+
+              enddo
+            endif
+
+        enddo
+      enddo
+    enddo
+  enddo
+
+  CALL wall_time(t5)
+  t6 = t5-t4
+  print*,'l1 1 :', t6
+
+  !=========================
+  ! First line, second term
+  !=========================
+
+  CALL wall_time(t4)
+
+  do p = 1, mo_num
+    do q = 1, mo_num
+      do r = 1, mo_num
+        do s = 1, mo_num
+
+          if (p==s) then
+            do u = 1, mo_num
+
+                  hessian(p,q,r,s) = hessian(p,q,r,s) + 0.5d0 * ( &
+                    mo_one_e_integrals(u,r) * one_e_dm_mo(u,q) &
+                  + mo_one_e_integrals(q,u) * one_e_dm_mo(r,u))
+            enddo
+          endif
+
+        enddo
+      enddo
+    enddo
+  enddo
+  
+  CALL wall_time(t5)
+  t6 = t5-t4
+  print*,'l1 2 :', t6
+
+  !========================
+  ! First line, third term
+  !========================
+
+  CALL wall_time(t4)
+
+  do p = 1, mo_num
+    do q = 1, mo_num
+      do r = 1, mo_num
+        do s = 1, mo_num
+
+          hessian(p,q,r,s) = hessian(p,q,r,s) &
+          - mo_one_e_integrals(s,p) * one_e_dm_mo(r,q)&
+          - mo_one_e_integrals(q,r) * one_e_dm_mo(p,s)
+
+        enddo
+      enddo
+    enddo
+  enddo
+
+  CALL wall_time(t5)
+  t6 = t5-t4
+  print*,'l1 3 :', t6
+
+
+  !=========================
+  ! Second line, first term
+  !=========================
+
+  CALL wall_time(t4)
+
+  do s = 1, mo_num
+    do r = 1, mo_num
+      do q = 1, mo_num
+        do p = 1, mo_num
+
+!  do p = 1, mo_num
+!    do q = 1, mo_num
+!      do r = 1, mo_num
+!        do s = 1, mo_num
+
+           if (q==r) then
+             do t = 1, mo_num
+               do u = 1, mo_num
+                 do v = 1, mo_num
+
+                   hessian(p,q,r,s) = hessian(p,q,r,s) + 0.5d0 * (  &
+                     get_two_e_integral(u,v,p,t,mo_integrals_map) * two_e_dm_mo(u,v,s,t) &
+                   + get_two_e_integral(s,t,u,v,mo_integrals_map) * two_e_dm_mo(p,t,u,v))
+
+                 enddo
+               enddo
+             enddo
+           endif
+
+        enddo
+      enddo
+    enddo
+  enddo
+
+  CALL wall_time(t5)
+  t6 = t5-t4
+  print*,'l2 1 :', t6
+
+  !==========================
+  ! Second line, second term
+  !==========================
+
+  CALL wall_time(t4)
+
+  do s = 1, mo_num
+    do r = 1, mo_num
+      do q = 1, mo_num
+        do p = 1, mo_num
+
+!  do p = 1, mo_num
+!    do q = 1, mo_num
+!      do r = 1, mo_num
+!        do s = 1, mo_num
+
+          if (p==s) then
+            do t = 1, mo_num
+              do u = 1, mo_num
+                do v = 1, mo_num
+
+                  hessian(p,q,r,s) = hessian(p,q,r,s) + 0.5d0 * ( &
+                    get_two_e_integral(q,t,u,v,mo_integrals_map) * two_e_dm_mo(r,t,u,v) &
+                  + get_two_e_integral(u,v,r,t,mo_integrals_map) * two_e_dm_mo(u,v,q,t))
+
+                enddo
+              enddo
+            enddo
+          endif
+
+        enddo
+      enddo
+    enddo
+  enddo
+
+  CALL wall_time(t5)
+  t6 = t5-t4
+  print*,'l2 2 :', t6
+
+  !========================
+  ! Third line, first term
+  !========================
+
+  CALL wall_time(t4)
+
+      do s = 1, mo_num
+        do r = 1, mo_num
+          do q = 1, mo_num
+            do p = 1, mo_num
+
+!  do p = 1, mo_num
+!    do q = 1, mo_num
+!      do r = 1, mo_num
+!        do s = 1, mo_num
+
+          do u = 1, mo_num
+            do v = 1, mo_num
+
+              hessian(p,q,r,s) = hessian(p,q,r,s) &
+               + get_two_e_integral(u,v,p,r,mo_integrals_map) * two_e_dm_mo(u,v,q,s) &
+               + get_two_e_integral(q,s,u,v,mo_integrals_map) * two_e_dm_mo(p,r,u,v)
+
+            enddo
+          enddo
+
+        enddo
+      enddo
+    enddo
+  enddo
+ 
+  CALL wall_time(t5)
+  t6 = t5-t4
+  print*,'l3 1 :', t6
+
+  !=========================
+  ! Third line, second term
+  !=========================
+
+  CALL wall_time(t4)
+
+      do s = 1, mo_num
+        do r = 1, mo_num
+          do q = 1, mo_num
+            do p = 1, mo_num
+
+!  do p = 1, mo_num
+!    do q = 1, mo_num
+!      do r = 1, mo_num
+!        do s = 1, mo_num
+
+          do t = 1, mo_num
+            do u = 1, mo_num
+
+              hessian(p,q,r,s) = hessian(p,q,r,s) &
+               - get_two_e_integral(s,t,p,u,mo_integrals_map) * two_e_dm_mo(r,t,q,u) &
+               - get_two_e_integral(t,s,p,u,mo_integrals_map) * two_e_dm_mo(t,r,q,u) &
+               - get_two_e_integral(q,u,r,t,mo_integrals_map) * two_e_dm_mo(p,u,s,t) &
+               - get_two_e_integral(q,u,t,r,mo_integrals_map) * two_e_dm_mo(p,u,t,s)
+
+            enddo
+          enddo
+
+        enddo
+      enddo
+    enddo
+  enddo
+
+  CALL wall_time(t5)
+  t6 = t5-t4
+  print*,'l3 2 :', t6
+
+  CALL wall_time(t2)
+  t3 = t2 -t1
+  print*,'Time to compute the hessian : ', t3
+
+  !==============
+  ! Permutations 
+  !==============
+
+  ! Hessian(p,q,r,s) = P_pq P_rs [ ...]
+  ! => Hessian(p,q,r,s) = (p,q,r,s) - (q,p,r,s) - (p,q,s,r) + (q,p,s,r) 
+
+  do s = 1, mo_num
+    do r = 1, mo_num
+      do q = 1, mo_num
+        do p = 1, mo_num
+
+          h_tmpr(p,q,r,s) = (hessian(p,q,r,s) - hessian(q,p,r,s) - hessian(p,q,s,r) + hessian(q,p,s,r))
+
+        enddo
+      enddo
+    enddo
+  enddo
+
+  !========================
+  ! 4D matrix to 2D matrix
+  !========================
+
+  ! Convert the hessian mo_num * mo_num * mo_num * mo_num matrix in a
+  ! 2D n * n matrix (n = mo_num*(mo_num-1)/2)
+  ! H(pq,rs) : p<q and r<s
+
+  ! 4D mo_num matrix to 2D n matrix
+  do pq = 1, n
+    call vec_to_mat_index(pq,p,q)
+    do rs = 1, n
+      call vec_to_mat_index(rs,r,s)
+      H(pq,rs) = h_tmpr(p,q,r,s)   
+    enddo
+  enddo
+
+  ! Display
+  if (debug) then 
+    print*,'2D Hessian matrix'
+    do pq = 1, n
+      write(*,'(100(F10.5))') H(pq,:)
+    enddo 
+  endif
+
+  !==============
+  ! Deallocation
+  !==============
+
+  deallocate(hessian)
+
+  if (debug) then
+    print*,'Leave first_hess'
+  endif
+
+end subroutine
+
+#+END_SRC